dan
/
haunt
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

reader: Add html-reader. 

* haunt/reader.scm (read-html-post): New procedure.
  (html-reader): New variable.
This commit is contained in:
David Thompson 2015-04-11 10:53:17 -04:00
parent 0b5bdd9f01
commit a45269f523
1 changed files with 23 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
haunt/reader.scm
View File

@ -26,8 +26,12 @@
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 rdelim)
#:use-module (haunt post) #:use-module (haunt post)
#:use-module (haunt utils)
#:export (make-reader #:export (make-reader
reader? reader?
reader-matcher reader-matcher
@ -73,3 +77,22 @@ metadata with DEFAULT-METADATA."
(let ((contents (load file-name))) (let ((contents (load file-name)))
(values (alist-delete 'content contents eq?) (values (alist-delete 'content contents eq?)
(assq-ref contents 'content)))))) (assq-ref contents 'content))))))
(define (read-html-post port)
(let loop ((metadata '()))
(let ((line (read-line port)))
(cond
((eof-object? line)
(error "end of file while reading metadata: " (port-filename port)))
((string=? line "---")
(values metadata `(raw ,(read-string port))))
(else
(match (map string-trim-both (string-split-at line #\:))
((key value)
(loop (cons (cons (string->symbol key) value)
metadata)))
(_ (error "invalid metadata format: " line))))))))
(define html-reader
(make-reader (make-file-extension-matcher "html")
(cut call-with-input-file <> read-html-post)))