~aasg/haunted-blog

c6ffdcb0cf3ceaa7be9df961a195f22b08b4931e — Aluísio Augusto Silva Gonçalves 1 year, 2 months ago 1ba35cc
haunt: Add a pandoc-based Markdown reader
2 files changed, 37 insertions(+), 1 deletions(-)

M default.nix
M haunt.scm
M default.nix => default.nix +1 -1
@@ 16,7 16,7 @@
let
  drv = pkgs.runCommand "aasg-blog"
    {
      nativeBuildInputs = [ aasg-pkgs.haunt ];
      nativeBuildInputs = [ aasg-pkgs.haunt pkgs.pandoc ];
      LANG = "C.UTF-8";
    } ''
    cd ${src}

M haunt.scm => haunt.scm +36 -0
@@ 14,7 14,9 @@
             (haunt post)
             (haunt site)
             (ice-9 match)
             (ice-9 popen)
             (ice-9 regex)
             (ice-9 rdelim)
             (ice-9 textual-ports)
             (ice-9 vlist)
             (srfi srfi-1)


@@ 280,6 282,40 @@
                    ((new-tree) (transform-markdown-tree orig-tree)))
        (values metadata new-tree)))))

(define pandoc-reader
  (make-reader
    (make-file-extension-matcher "md")
    (lambda (filename)
      (define (read-pandoc filename)
        (let* ((html-port (open-pipe* OPEN_READ "pandoc" "--read=markdown" "--write=html" "--" filename))
               (html-string (get-string-all html-port)))
          (if (not (eqv? 0 (status:exit-val (close-pipe html-port))))
              (error "pandoc failed for " filename)
              html-string)))
      (define (html-fragment->sxml fragments)
        ; This is taken from haunt/reader.scm, © 2015 David Thompson.
        (define (read-html-fragments port)
          (let loop ()
            (let ((next-char (peek-char port)))
              (cond
                ((eof-object? next-char)
                 '())
                ((char-set-contains? char-set:whitespace next-char)
                 (read-char port)
                 (loop))
                (else
                  (match (xml->sxml port)
                         (('*TOP* sxml) (cons sxml (loop)))))))))
        (call-with-input-string fragments read-html-fragments))
      (let ((metadata (call-with-input-file filename
                                            (lambda (port)
                                              (let ((header (read-line port 'concat)))
                                                (unless (string=? header "---\n")
                                                  (unread-string header port)))
                                              (read-metadata-headers port))))
            (html-fragments (read-pandoc filename)))
        (values metadata (html-fragment->sxml html-fragments))))))

(define (uncollected-pages directory theme)
  (lambda (site posts)
    (let ((post->page (lambda (post)