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

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

(define-public formats
  ;;; (TYPE (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~%"))
    (meta (line . "")
          (stanza . ""))
    (default
      (line . "~A")
      (stanza . "~A~%~%"))))

(define-public filters
  ;;; (TYPE (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 (line . ,identity)
          (stanza . ,(lambda (lines) (apply string-append lines))))
    (default
      (line . ,identity)
      (stanza . ,(lambda (lines)
                   (irregex-replace/all '(: bol (* space))
                                        (string-join lines) ""))))))

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

(define (format-stanza stanza)
  (let* ((type (car stanza))
         (data (cdr stanza))
         (text (map (lambda (ln)
                      (format-line ln type))
                    data)))
    (sprintf (get-format type 'stanza)
             ((get-filter type 'stanza) text))))

;;; 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) (get-from formats el scope))
(define (get-filter el scope) (get-from filters el scope))

(define (sprintf* fmt lis)
  (let loop ((num (length (irregex-extract "~[aA]" fmt)))
             (lis 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))))))