(declare (module (jimmy emit)))

(import scheme (chicken base)
        (jimmy util)
        (chicken format)
        (chicken irregex)
        (chicken string))

(define-public (emit document)
  (for-each display
            (map format-block document)))

(define-public formats
  ;;; (type line-format block-format [line-in-block-format])
  ;; these default to gemtext
  '((para (line . "~A ")
          (block . "~A~%~%"))
    (verb (line . "~A~%")
          (block . "```~%~A```~%~%"))
    (link (line . "=> ~A ~A~%")
          (block . "~A~%")
          (inline . "~%=> ~A ~A~%")) ;TODO: have 2 args to format
    (list (line . "* ~A~%")
          (block . "~A~%"))
    (quot (line . "~A ")
          (block . "> ~A~%~%"))
    (hdr1 (line . "# ~A~%")
          (block . "~A~%"))
    (hdr2 (line . "## ~A~%")
          (block . "~A~%"))
    (hdr3 (line . "### ~A~%")
          (block . "~A~%"))
    (default
      (line . "~A")
      (block . "~A~%~%"))))

(define (string-join ss #!optional sep)
  (if (string? ss) ss
      (string-intersperse ss (or sep " "))))

(define (char->tag char beg end)
  (lambda (str)
    (irregex-replace/all `(: ($ (or bos space))
                             ,char ($ (+ (~ ,char))) ,char
                             ($ (or space eos)))
                         str
                         1 beg 2 end 3)))

(define-public filters
  `((para
     (line . ,(o (char->tag "*" "<strong>" "</strong>")
                 (char->tag "_" "<em>" "</em>")
                 (char->tag "`" "<code>" "</code>")
                 string-join))
     (block . ,(lambda (ln)
                 (irregex-replace/all '(: bol (* " ")) ln ""))))
    (link
     (line . ,(lambda (ln)
                (let ((ws (cond ((list? ln) ln)
                                ((string? ln) (string-split ln)))))
                  (list (car ws) (string-join (cdr ws)))))))
    (default
      (line . ,list)
      (block . ,identity))))

(define (get-from from type subtype)
  (or (alist-walk from type subtype)
      (if (eq? subtype 'inline)
          (alist-walk from type 'list)
          (lambda _ '("")))))

(define (get-format type subtype) (get-from formats type subtype))
(define (get-filter type subtype) (get-from filters type subtype))

(define (format-line fmt line type)
  (cond
   ;; if LINE is a string, wrap it in a list
   ((string? line)
    (set! line (list line)))
   ;; if it's a list of strings, join them together and filter them
   ((and (list? line)
         (string? (car line)))
    (set! line ((get-filter type 'line) line)))
   ;; if the car of LINE is a symbol, it's an inline thing.
   ((and (list? line)
         (symbol? (car line)))
    (set! line (format-line (get-format (car line) 'inline)
                            ((get-filter (car line) 'line) (cdr line))
                            type)))
   (else (error "Malformed line" line)))
  (apply sprintf fmt line))

(define (format-block block)
  (if (assq (car block) formats)
      (let* ((type (car block))
             (data (cdr block))
             (text (cond
                    ((string? data) data)
                    ((list? data)
                     (apply string-append
                            (map (lambda (ln)
                                   (format-line (get-format type 'line)
                                                ln
                                                type))
                                 data)))
                    (else (error "Malformed block" block)))))
        (sprintf (get-format type 'block)
                 ((get-filter type 'block) text)))
      ""))