diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | haunt/artifact.scm | 66 | ||||
| -rw-r--r-- | haunt/asset.scm | 3 | ||||
| -rw-r--r-- | haunt/builder/atom.scm | 29 | ||||
| -rw-r--r-- | haunt/builder/blog.scm | 13 | ||||
| -rw-r--r-- | haunt/site.scm | 25 |
6 files changed, 106 insertions, 31 deletions
diff --git a/Makefile.am b/Makefile.am index b30753a..6e79c6d 100644 --- a/Makefile.am +++ b/Makefile.am @@ -49,6 +49,7 @@ SOURCES = \ haunt/post.scm \ haunt/page.scm \ haunt/asset.scm \ + haunt/artifact.scm \ haunt/site.scm \ haunt/html.scm \ haunt/builder/assets.scm \ diff --git a/haunt/artifact.scm b/haunt/artifact.scm new file mode 100644 index 0000000..7785a20 --- /dev/null +++ b/haunt/artifact.scm @@ -0,0 +1,66 @@ +;;; Haunt --- Static site generator for GNU Guile +;;; Copyright © 2020 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: +;; +;; Build artifact data type. +;; +;;; Code: + +(define-module (haunt artifact) + #:use-module (haunt utils) + #:use-module (ice-9 match) + #:use-module (ice-9 popen) + #:use-module (srfi srfi-9) + #:export (make-artifact + artifact? + artifact-file-name + artifact-writer + create-artifact + serialized-artifact + verbatim-artifact + external-artifact)) + +(define-record-type <artifact> + (make-artifact file-name writer) + artifact? + (file-name artifact-file-name) + (writer artifact-writer)) + +(define (create-artifact artifact prefix) + (let ((output (string-append prefix "/" (artifact-file-name artifact)))) + (mkdir-p (dirname output)) + ((artifact-writer artifact) output) + (unless (file-exists? output) + (error "failed to create artifact output file" output)))) + +(define (serialized-artifact destination obj serialize) + (make-artifact destination + (lambda (output) + (format #t "write '~a'~%" destination) + (call-with-output-file output + (lambda (port) + (serialize obj port)))))) + +(define (verbatim-artifact source destination) + (unless (file-exists? source) + (error "verbatim artifact source file does not exist" source)) + (make-artifact destination + (lambda (output) + (format #t "copy '~a' → '~a'~%" source destination) + (copy-file source output)))) diff --git a/haunt/asset.scm b/haunt/asset.scm index 2d9e27b..78d539b 100644 --- a/haunt/asset.scm +++ b/haunt/asset.scm @@ -27,6 +27,7 @@ #:use-module (srfi srfi-9) #:use-module (ice-9 ftw) #:use-module (ice-9 match) + #:use-module (haunt artifact) #:use-module (haunt utils) #:export (make-asset asset? @@ -71,7 +72,7 @@ files in DIRECTORY that match KEEP?, recursively." (let* ((file-name* (file-name-components file-name)) (target (join-file-name-components (append dest* (drop file-name* base-length))))) - (cons (make-asset file-name target) memo)) + (cons (verbatim-artifact file-name target) memo)) memo)))) (define (noop file-name stat memo) memo) diff --git a/haunt/builder/atom.scm b/haunt/builder/atom.scm index 2a6c356..acd74d4 100644 --- a/haunt/builder/atom.scm +++ b/haunt/builder/atom.scm @@ -29,6 +29,7 @@ #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:use-module (sxml simple) + #:use-module (haunt artifact) #:use-module (haunt site) #:use-module (haunt post) #:use-module (haunt page) @@ -184,20 +185,20 @@ MAX-ENTRIES: The maximum number of posts to render in the feed" (build-uri (site-scheme site) #:host (site-domain site) #:path (string-append "/" file-name))))) - (make-page file-name - `(feed (@ (xmlns "http://www.w3.org/2005/Atom")) - (title ,(site-title site)) - (id ,uri) - (subtitle ,subtitle) - (updated ,(date->string* (current-date))) - (link (@ (href ,(string-append (site-domain site) - "/" file-name)) - (rel "self"))) - (link (@ (href ,(site-domain site)))) - ,@(map (cut post->atom-entry site <> - #:blog-prefix blog-prefix) - (take-up-to max-entries (filter posts)))) - sxml->xml*)))) + (serialized-artifact file-name + `(feed (@ (xmlns "http://www.w3.org/2005/Atom")) + (title ,(site-title site)) + (id ,uri) + (subtitle ,subtitle) + (updated ,(date->string* (current-date))) + (link (@ (href ,(string-append (site-domain site) + "/" file-name)) + (rel "self"))) + (link (@ (href ,(site-domain site)))) + ,@(map (cut post->atom-entry site <> + #:blog-prefix blog-prefix) + (take-up-to max-entries (filter posts)))) + sxml->xml*)))) (define* (atom-feeds-by-tag #:key (prefix "feeds/tags") diff --git a/haunt/builder/blog.scm b/haunt/builder/blog.scm index 2830881..4cf671f 100644 --- a/haunt/builder/blog.scm +++ b/haunt/builder/blog.scm @@ -27,6 +27,7 @@ #:use-module (ice-9 match) #:use-module (srfi srfi-9) #:use-module (srfi srfi-19) + #:use-module (haunt artifact) #:use-module (haunt site) #:use-module (haunt post) #:use-module (haunt page) @@ -127,16 +128,16 @@ decorated by THEME, whose URLs start with PREFIX." (define (post->page post) (let ((base-name (string-append (site-post-slug site post) ".html"))) - (make-page (make-file-name base-name) - (render-post theme site post) - sxml->html))) + (serialized-artifact (make-file-name base-name) + (render-post theme site post) + sxml->html))) (define collection->page (match-lambda ((title file-name filter) - (make-page (make-file-name file-name) - (render-collection theme site title (filter posts) prefix) - sxml->html)))) + (serialized-artifact (make-file-name file-name) + (render-collection theme site title (filter posts) prefix) + sxml->html)))) (append (map post->page posts) (map collection->page collections)))) diff --git a/haunt/site.scm b/haunt/site.scm index 4b412bb..1dd41a0 100644 --- a/haunt/site.scm +++ b/haunt/site.scm @@ -28,6 +28,7 @@ #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module (haunt artifact) #:use-module (haunt utils) #:use-module (haunt reader) #:use-module (haunt page) @@ -112,16 +113,20 @@ BUILDERS: A list of procedures for building pages from posts" (delete-file-recursively build-dir) (mkdir build-dir)) (for-each (match-lambda - ((? page? page) - (format #t "writing page '~a'~%" (page-file-name page)) - (write-page page build-dir)) - ((? asset? asset) - (format #t "copying asset '~a' → '~a'~%" - (asset-source asset) - (asset-target asset)) - (install-asset asset build-dir)) - (obj - (error "unrecognized site object: " obj))) + ((? page? page) + (display "warning: page objects are deprecated; switch to serialized-artifact\n") + (format #t "writing page '~a'~%" (page-file-name page)) + (write-page page build-dir)) + ((? asset? asset) + (display "warning: asset objects are deprecated; switch to verbatim-artifact\n") + (format #t "copying asset '~a' → '~a'~%" + (asset-source asset) + (asset-target asset)) + (install-asset asset build-dir)) + ((? artifact? artifact) + (create-artifact artifact build-dir)) + (obj + (error "unrecognized site object: " obj))) (flat-map (cut <> site posts) (site-builders site))))) (define (make-file-filter patterns) |