Add reader module.
* haunt/reader.scm: New file. * Makefile.am (SOURCES): Add it.
This commit is contained in:
		@@ -42,6 +42,7 @@ godir=$(libdir)/guile/2.0/ccache
 | 
				
			|||||||
SOURCES =					\
 | 
					SOURCES =					\
 | 
				
			||||||
  haunt/config.scm				\
 | 
					  haunt/config.scm				\
 | 
				
			||||||
  haunt/post.scm				\
 | 
					  haunt/post.scm				\
 | 
				
			||||||
 | 
					  haunt/reader.scm				\
 | 
				
			||||||
  haunt/ui.scm					\
 | 
					  haunt/ui.scm					\
 | 
				
			||||||
  haunt/ui/serve.scm				\
 | 
					  haunt/ui/serve.scm				\
 | 
				
			||||||
  haunt/serve/mime-types.scm			\
 | 
					  haunt/serve/mime-types.scm			\
 | 
				
			||||||
 
 | 
				
			|||||||
							
								
								
									
										75
									
								
								haunt/reader.scm
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										75
									
								
								haunt/reader.scm
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,75 @@
 | 
				
			|||||||
 | 
					n;;; Haunt --- Static site generator for GNU Guile
 | 
				
			||||||
 | 
					;;; Copyright © 2015 David Thompson <davet@gnu.org>
 | 
				
			||||||
 | 
					;;;
 | 
				
			||||||
 | 
					;;; This file is part of Haunt.
 | 
				
			||||||
 | 
					;;;
 | 
				
			||||||
 | 
					;;; Haunt is free software; you can redistribute it and/or modify it
 | 
				
			||||||
 | 
					;;; under the terms of the GNU General Public License as published by
 | 
				
			||||||
 | 
					;;; the Free Software Foundation; either version 3 of the License, or
 | 
				
			||||||
 | 
					;;; (at your option) any later version.
 | 
				
			||||||
 | 
					;;;
 | 
				
			||||||
 | 
					;;; Haunt is distributed in the hope that it will be useful, but
 | 
				
			||||||
 | 
					;;; WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
				
			||||||
 | 
					;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 | 
				
			||||||
 | 
					;;; General Public License for more details.
 | 
				
			||||||
 | 
					;;;
 | 
				
			||||||
 | 
					;;; You should have received a copy of the GNU General Public License
 | 
				
			||||||
 | 
					;;; along with Haunt.  If not, see <http://www.gnu.org/licenses/>.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					;;; Commentary:
 | 
				
			||||||
 | 
					;;
 | 
				
			||||||
 | 
					;; Post readers.
 | 
				
			||||||
 | 
					;;
 | 
				
			||||||
 | 
					;;; Code:
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define-module (haunt reader)
 | 
				
			||||||
 | 
					  #:use-module (srfi srfi-1)
 | 
				
			||||||
 | 
					  #:use-module (srfi srfi-9)
 | 
				
			||||||
 | 
					  #:use-module (srfi srfi-11)
 | 
				
			||||||
 | 
					  #:use-module (ice-9 regex)
 | 
				
			||||||
 | 
					  #:use-module (haunt post)
 | 
				
			||||||
 | 
					  #:export (make-reader
 | 
				
			||||||
 | 
					            reader?
 | 
				
			||||||
 | 
					            reader-matcher
 | 
				
			||||||
 | 
					            reader-proc
 | 
				
			||||||
 | 
					            reader-match?
 | 
				
			||||||
 | 
					            read-post
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					            make-file-extension-matcher
 | 
				
			||||||
 | 
					            sxml-reader))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define-record-type <reader>
 | 
				
			||||||
 | 
					  (make-reader matcher proc)
 | 
				
			||||||
 | 
					  reader?
 | 
				
			||||||
 | 
					  (matcher reader-matcher)
 | 
				
			||||||
 | 
					  (proc reader-proc))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define (reader-match? reader file-name)
 | 
				
			||||||
 | 
					  "Return #t if FILE-NAME is a file supported by READER."
 | 
				
			||||||
 | 
					  ((reader-matcher reader) file-name))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define* (read-post reader file-name #:optional (default-metadata '()))
 | 
				
			||||||
 | 
					  "Read a post object from FILE-NAME using READER, merging its
 | 
				
			||||||
 | 
					metadata with DEFAULT-METADATA."
 | 
				
			||||||
 | 
					  (let-values (((metadata sxml) ((reader-proc reader) file-name)))
 | 
				
			||||||
 | 
					    (make-post file-name
 | 
				
			||||||
 | 
					               (append metadata default-metadata)
 | 
				
			||||||
 | 
					               sxml)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					;;;
 | 
				
			||||||
 | 
					;;; Simple readers
 | 
				
			||||||
 | 
					;;;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define (make-file-extension-matcher ext)
 | 
				
			||||||
 | 
					  "Return a procedure that returns #t when a file name ends with
 | 
				
			||||||
 | 
					'.EXT'."
 | 
				
			||||||
 | 
					  (let ((regexp (make-regexp (string-append "\\." ext "$"))))
 | 
				
			||||||
 | 
					    (lambda (file-name)
 | 
				
			||||||
 | 
					      (regexp-match? (regexp-exec regexp file-name)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define sxml-reader
 | 
				
			||||||
 | 
					  (make-reader (make-file-extension-matcher "sxml")
 | 
				
			||||||
 | 
					               (lambda (file-name)
 | 
				
			||||||
 | 
					                 (let ((contents (load file-name)))
 | 
				
			||||||
 | 
					                   (values (alist-delete 'content contents eq?)
 | 
				
			||||||
 | 
					                           (assq-ref contents 'content))))))
 | 
				
			||||||
		Reference in New Issue
	
	Block a user