(declare (module (boudin page post))
         (export make-post
                 post-path-transformers
                 post-text-transformers
                 post-template
                 post-writer))

(import (boudin page)
        (boudin page write)
        (boudin site)
        (boudin util)
        (chicken pathname)
        (html-parser)
        (except (schmaltz)
                render-specials
                render-unprintables)
        (schmaltz chicken)
        (srfi 152))

(define (make-post path)
  (let ((sxml ((apply o (post-text-transformers))
               (with-input-from-file path slurp))))
    (make-page sxml
               ((apply o (post-path-transformers)) path)
               (post-template)
               (post-writer)
               (cons (cons "source" path)
                     (*extract-metadata sxml)))))

(define (*extract-metadata sxml)
  (let loop ((tree sxml)
             (acc '()))
    (cond
     ((not (pair? tree))
      (reverse acc))
     ((and (list? (car tree))
           (eq? (caar tree) '*COMMENT*))
      (loop (cdr tree)
            (map (lambda (ln)
                   (let ((kv (string-split ln ":" 'infix 1)))
                     (cons (string-trim-both (car kv))
                           (string-trim (cdr kv)))))
                 (string-split (cadar tree) "\n"))))
     ((list? (car tree))
      (loop (cdr tree)
            (let ((subtree (loop (car tree) '())))
              (if (null? subtree)
                  acc
                  (cons subtree acc)))))
     (else (loop (cdr tree) acc)))))

(define post-text-transformers
  (make-parameter
   (list html->sxml
         wrap-paragraphs
         render-string->string)))

(define post-path-transformers
  (make-parameter
   (list (lambda (path)
           (make-pathname (list (site-output)
                                (pathname-strip-extension path))
                          "index.html")))))

(define post-template
  (make-parameter
   (lambda (pg)
     (let ((title (page-ref pg "title")))
       `(html (@ (lang "en-us"))
              (head ,@(html-head)
                    (title ,(or title "[untitled]")))
              (body ,(if title `(h1 ,title) "")
                    ,@(cdr (page-content pg))))))))

(define post-writer
  (make-parameter
   sxml-display-as-html))