(declare (module (jimmy emit)))

(import scheme (chicken base)
        (chicken format)
        (chicken io)
        (chicken irregex)
        (chicken port)
        (chicken process)
        (chicken process-context)
        (chicken string)
        (only utf8-srfi-13 string-join)
        (jimmy util))

(define-public (emit doc)
  (for-each display (map format-stanza doc)))

(define-public (emit-string doc)
  (with-output-to-string
    (lambda () (emit doc))))

;;; Change these for different output types

(define-public output-type
  (make-parameter 'gemini))

(define-public formats
  (make-parameter
   ;; (EL (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT))
   '((para (line . "~A")
           (stanza . "~A~%~%"))
     (verb (line . "~A~%")
           (stanza . "```~%~A```~%~%"))
     (link (line . "=> ~A ~A~%")         ; Note: link has 2 format arguments
           (stanza . "~A~%")
           (inline . "~%=> ~A ~A~%"))
     (list (line . "* ~A~%")
           (stanza . "~A~%"))
     (quot (line . "~A")
           (stanza . "> ~A~%~%"))
     (hdr1 (line . "# ~A~%")
           (stanza . "~A~%"))
     (hdr2 (line . "## ~A~%")
           (stanza . "~A~%"))
     (hdr3 (line . "### ~A~%")
           (stanza . "~A~%")))))

(define-public set-formats! formats)

(define-public filters
  (make-parameter
   ;; (EL (line . LINE-FILTER) (stanza . STANZA-FILTER))
   ;; line-filter : (lambda (list-of-strs) ...) -> list-of-strs (for format)
   ;; stanza-filter : (lambda (list-of-strs) ...) -> str
   `((verb
      (stanza . ,(o ensure-newline (cut string-join <> "\n"))))
     (default
       (line . ,identity)
       (stanza . ,flush-lines-left)))))

(define-public set-filters! filters)

;;; Implementation

(define (format-line line el)
  (cond
   ((string? (car line))                ; regular stanza line
    (format/filter el 'line line))
   ((symbol? (car line))                ; inline element
    (format/filter (car line) '(inline . line) (cdr line)))
   (else (error "Malformed line" line))))

(define (format-stanza stanza)
  (let* ((el (caar stanza))
         (text (map (lambda (ln)
                      (format-line ln el))
                    (cdr stanza))))
    (case el
      ((verb) (format-verb stanza))
      (else
       (format/filter el 'stanza text)))))

(define (format-verb stanza)
  (define (emit-verbatim t)
    (printf (get-format 'verb 'stanza)
            ((get-filter 'verb 'stanza) t)))
  (let ((el (car stanza))
        (text (string-join (apply append (cdr stanza)) "\n")))
    (with-output-to-string
      (lambda ()
        (cond
         ((and (pair? (cdr el))
               (equal? (cadr el) "|"))
          ;; special case: pipe to an external process
          (let* ((cmdline (cddr el))
                 (command (find-command (car cmdline)) #;<TODO:JIMMY_PATH>))
            (if command
                (receive (in out pid)
                    (process command (cdr cmdline)
                             (cons `("JIMMY_OUTPUT" . ,(->string (output-type)))
                                   (get-environment-variables)))
                  (display (ensure-newline text) out)
                  (close-output-port out)
                  (display (read-string #f in))
                  (newline))
                (emit-verbatim t))))
         (else (emit-verbatim t)))))))

;;; Utilities

(define (get-from alist el scope)
  (or (alist-walk alist el scope)
      (alist-walk alist 'default scope)
      (and (eq? scope 'inline)
           (alist-walk alist 'default 'line))))

(define (get-format el scope)
  (or (get-from (formats) el scope)
      ""))

(define (get-filter el scope) (get-from (filters) el scope))

(define (format/filter el scope text)
  (define (sprintf* fmt lis)
    (let loop ((num (length (irregex-extract "~[aA]" fmt)))
               (lis (if (list? lis) lis (list lis)))
               (out '()))
      (cond
       ((null? lis)
        (apply sprintf fmt (reverse out)))
       ((= 1 num)
        (loop 0 '() (cons (string-join lis) out)))
       (else
        (loop (- num 1)
              (cdr lis)
              (cons (car lis) out))))))

  (define-values (format-scope filter-scope)
    (if (pair? scope)
        (values (car scope) (cdr scope))
        (values scope scope)))

  (sprintf* (get-format el format-scope)
            ((get-filter el filter-scope) text)))