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:
|
;;; Code:
|
||||||
|
|
||||||
(define-module (haunt post)
|
(define-module (haunt post)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (ice-9 rdelim)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-9)
|
#:use-module (srfi srfi-9)
|
||||||
#:use-module (srfi srfi-19)
|
#:use-module (srfi srfi-19)
|
||||||
|
@ -40,7 +42,8 @@
|
||||||
posts/group-by-tag
|
posts/group-by-tag
|
||||||
|
|
||||||
register-metdata-parser!
|
register-metdata-parser!
|
||||||
parse-metadata))
|
parse-metadata
|
||||||
|
read-metadata-headers))
|
||||||
|
|
||||||
(define-record-type <post>
|
(define-record-type <post>
|
||||||
(make-post file-name metadata sxml)
|
(make-post file-name metadata sxml)
|
||||||
|
@ -107,6 +110,20 @@ specified."
|
||||||
(define (parse-metadata key value)
|
(define (parse-metadata key value)
|
||||||
((metadata-parser 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!
|
(register-metadata-parser!
|
||||||
'tags
|
'tags
|
||||||
(lambda (str)
|
(lambda (str)
|
||||||
|
|
|
@ -30,7 +30,6 @@
|
||||||
#:use-module (ice-9 ftw)
|
#:use-module (ice-9 ftw)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 regex)
|
#:use-module (ice-9 regex)
|
||||||
#:use-module (ice-9 rdelim)
|
|
||||||
#:use-module (sxml simple)
|
#:use-module (sxml simple)
|
||||||
#:use-module (haunt post)
|
#:use-module (haunt post)
|
||||||
#:use-module (haunt utils)
|
#:use-module (haunt utils)
|
||||||
|
@ -105,20 +104,9 @@ post."
|
||||||
(assq-ref contents 'content))))))
|
(assq-ref contents 'content))))))
|
||||||
|
|
||||||
(define (read-html-post port)
|
(define (read-html-post port)
|
||||||
(let loop ((metadata '()))
|
(values (read-metadata-headers port)
|
||||||
(let ((line (read-line port)))
|
(match (xml->sxml port)
|
||||||
(cond
|
(('*TOP* sxml) sxml))))
|
||||||
((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))))))))
|
|
||||||
|
|
||||||
(define html-reader
|
(define html-reader
|
||||||
(make-reader (make-file-extension-matcher "html")
|
(make-reader (make-file-extension-matcher "html")
|
||||||
|
|
|
@ -26,6 +26,8 @@
|
||||||
(define (make-date* year month day)
|
(define (make-date* year month day)
|
||||||
(make-date 0 0 0 0 day month year 0))
|
(make-date 0 0 0 0 day month year 0))
|
||||||
|
|
||||||
|
(define %tzoffset (date-zone-offset (current-date)))
|
||||||
|
|
||||||
(test-equal "post-ref"
|
(test-equal "post-ref"
|
||||||
'(hello test)
|
'(hello test)
|
||||||
(post-ref (make-post "foo.skr" '((tags hello test)) '()) 'tags))
|
(post-ref (make-post "foo.skr" '((tags hello test)) '()) 'tags))
|
||||||
|
@ -62,9 +64,20 @@
|
||||||
(parse-metadata 'tags "foo, bar, baz"))
|
(parse-metadata 'tags "foo, bar, baz"))
|
||||||
|
|
||||||
(test-equal "parse-metadata, date"
|
(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"))
|
(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)
|
(test-end)
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue