From dfad89079b64b97e099f6d86e44b6d9deb76a5d5 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Thu, 15 Oct 2015 22:46:30 -0400
Subject: 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.
---
 haunt/post.scm   | 19 ++++++++++++++++++-
 haunt/reader.scm | 18 +++---------------
 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)
 
 
-- 
cgit v1.2.3