diff options
| -rw-r--r-- | haunt/post.scm | 19 | ||||
| -rw-r--r-- | haunt/reader.scm | 18 | ||||
| -rw-r--r-- | tests/post.scm | 15 |
3 files changed, 35 insertions, 17 deletions
diff --git a/haunt/post.scm b/haunt/post.scm index 361fd6d..47aaa55 100644 --- a/haunt/post.scm +++ b/haunt/post.scm @@ -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) diff --git a/haunt/reader.scm b/haunt/reader.scm index 6d4477d..305bcee 100644 --- a/haunt/reader.scm +++ b/haunt/reader.scm @@ -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") diff --git a/tests/post.scm b/tests/post.scm index bfc0d0e..38fcfbe 100644 --- a/tests/post.scm +++ b/tests/post.scm @@ -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) |