(define-module (fmt-stack)
  #:export (get-attr
            set-fg set-bg set-style
            get-bg get-fg get-style
            make-fmt-frame empty-fmt-frame
            get-frame
            fmt-frame->ansi-esc)

  #:use-module (monad)
  #:use-module (monad state)

  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9 gnu))

(define-immutable-record-type fmt-frame
  (make-fmt-frame style fg bg)
  fmt-frame?
  (style get-style set-style)
  (fg    get-fg    set-fg)
  (bg    get-bg    set-bg))

(define (empty-fmt-frame)
  (make-fmt-frame #f #f #f))

;; B - blue
;; BL - black
;; C - cyan
;; G - green
;; M - magenta
;; R - red
;; W - white
;; Y - yellow

(define (fmt-frame->ansi-esc frame)
  (string-append
   "\x1b[m"
   (case (get-fg frame)
     ((B) "\x1b[0;34m")
     ((BL) "\x1b[0;30m")
     ((C) "\x1b[0;96m")
     ((G) "\x1b[0;32m")
     ((M) "\x1b[0;35m")
     ((R) "\x1b[0;31m")
     ((W) "\x1b[0;97m")
     ((Y) "\x1b[0;93m")
     (else ""))

   (case (get-bg frame)
     ((B) "\x1b[44m")
     ((BL) "\x1b[40m")
     ((C) "\x1b[106m")
     ((G) "\x1b[42m")
     ((M) "\x1b[45m")
     ((R) "\x1b[41m")
     ((W) "\x1b[107m")
     ((Y) "\x1b[103m")
     (else ""))

   (case (get-style frame)
     ((underline) "\x1b[4m")
     ((italic)    "\x1b[3m")
     ((bold)      "\x1b[1m")
     (else ""))))

(define (get-frame)
  (do stack <- (get)
      (return-state
       (make-fmt-frame
        (get-style (find get-style stack))
        (get-fg    (find get-fg    stack))
        (get-bg    (find get-bg    stack))))
      ))

(define (get-attr)
  (<$> fmt-frame->ansi-esc (get-frame)))