post: Add read-metadata-headers procedure.
* haunt/post.scm (read-metadata-headers): New procedure. * haunt/reader.scm (read-html-post): Reimplement using 'read-metadata-headers'. * tests/post.scm (%tzoffset): New variable. ("read-metadata-headers"): New test.
This commit is contained in:
parent
e505a66a1b
commit
dfad89079b
|
@ -23,6 +23,8 @@
|
|||
;;; Code:
|
||||
|
||||
(define-module (haunt post)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:use-module (srfi srfi-19)
|
||||
|
@ -40,7 +42,8 @@
|
|||
posts/group-by-tag
|
||||
|
||||
register-metdata-parser!
|
||||
parse-metadata))
|
||||
parse-metadata
|
||||
read-metadata-headers))
|
||||
|
||||
(define-record-type <post>
|
||||
(make-post file-name metadata sxml)
|
||||
|
@ -107,6 +110,20 @@ specified."
|
|||
(define (parse-metadata key value)
|
||||
((metadata-parser key) value))
|
||||
|
||||
(define (read-metadata-headers 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 "---")
|
||||
metadata)
|
||||
(else
|
||||
(match (map string-trim-both (string-split-at line #\:))
|
||||
(((= string->symbol key) value)
|
||||
(loop (alist-cons key (parse-metadata key value) metadata)))
|
||||
(_ (error "invalid metadata format: " line))))))))
|
||||
|
||||
(register-metadata-parser!
|
||||
'tags
|
||||
(lambda (str)
|
||||
|
|
|
@ -30,7 +30,6 @@
|
|||
#:use-module (ice-9 ftw)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (sxml simple)
|
||||
#:use-module (haunt post)
|
||||
#:use-module (haunt utils)
|
||||
|
@ -105,20 +104,9 @@ post."
|
|||
(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
|
||||
(match (xml->sxml port)
|
||||
(('*TOP* sxml) sxml))))
|
||||
(else
|
||||
(match (map string-trim-both (string-split-at line #\:))
|
||||
(((= string->symbol key) value)
|
||||
(loop (alist-cons key (parse-metadata key value) metadata)))
|
||||
(_ (error "invalid metadata format: " line))))))))
|
||||
(values (read-metadata-headers port)
|
||||
(match (xml->sxml port)
|
||||
(('*TOP* sxml) sxml))))
|
||||
|
||||
(define html-reader
|
||||
(make-reader (make-file-extension-matcher "html")
|
||||
|
|
|
@ -26,6 +26,8 @@
|
|||
(define (make-date* year month day)
|
||||
(make-date 0 0 0 0 day month year 0))
|
||||
|
||||
(define %tzoffset (date-zone-offset (current-date)))
|
||||
|
||||
(test-equal "post-ref"
|
||||
'(hello test)
|
||||
(post-ref (make-post "foo.skr" '((tags hello test)) '()) 'tags))
|
||||
|
@ -62,9 +64,20 @@
|
|||
(parse-metadata 'tags "foo, bar, baz"))
|
||||
|
||||
(test-equal "parse-metadata, date"
|
||||
(make-date 0 0 30 22 15 10 2015 (date-zone-offset (current-date)))
|
||||
(make-date 0 0 30 22 15 10 2015 %tzoffset)
|
||||
(parse-metadata 'date "2015-10-15 22:30"))
|
||||
|
||||
(test-equal "read-metadata-headers"
|
||||
`((tags "foo" "bar" "baz")
|
||||
(date . ,(make-date 0 0 30 22 15 10 2015 %tzoffset))
|
||||
(title . "Hello, World!"))
|
||||
(pk 'meta (call-with-input-string "title: Hello, World!
|
||||
date: 2015-10-15 22:30
|
||||
tags: foo, bar, baz
|
||||
---
|
||||
"
|
||||
read-metadata-headers)))
|
||||
|
||||
(test-end)
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue