summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson@vistahigherlearning.com>2021-03-18 17:51:37 -0400
committerDavid Thompson <dthompson@vistahigherlearning.com>2021-03-18 17:52:29 -0400
commitd22bf423c1b82bd7ddb47ae1e3cb13f3ee270a0c (patch)
tree7ea249bab45436962187f0aec6ddd38912a98f74
parent5255259bf048b863e222c41dc406c91be1b2eba0 (diff)
Create a unified type for build artifacts.
Deprecate <page> and <asset>.
-rw-r--r--Makefile.am1
-rw-r--r--haunt/artifact.scm66
-rw-r--r--haunt/asset.scm3
-rw-r--r--haunt/builder/atom.scm29
-rw-r--r--haunt/builder/blog.scm13
-rw-r--r--haunt/site.scm25
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)