~aasg/haunted-blog

ref: fef67bdcac88c14b6ac6affe93e290c1a4fb6ee2 haunted-blog/scm/aasg/sxml/from-pandoc.scm -rw-r--r-- 1.1 KiB
fef67bdc — Aluísio Augusto Silva Gonçalves Render post tags and relayout post lists 10 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
(define-module (aasg sxml from-pandoc)
               #:use-module (ice-9 match)
               #:use-module (ice-9 popen)
               #:use-module (ice-9 textual-ports)
               #:use-module (ice-9 vlist)
               #:use-module (srfi srfi-1)
               #:use-module (sxml simple)
               #:export (pandoc-md->sxml))

(define (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)))

; 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)))))))))

(define (pandoc-md->sxml filename)
  (call-with-input-string (pandoc filename) read-html-fragments))