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:
		@@ -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)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 
 | 
				
			|||||||
		Reference in New Issue
	
	Block a user