diff --git a/src/blog/facade.lisp b/src/blog/facade.lisp
index 4f62da0..0ede8f7 100644
--- a/src/blog/facade.lisp
+++ b/src/blog/facade.lisp
@@ -68,7 +68,7 @@
(last (pathname-directory file-path) 3)))
(post (funcall (gethash (pathname-type file-path) hssg.blog:*BLOG-POST-READERS*)
file-path)))
- (hssg:let-metadata post
+ (hssg:let-metadata
((category :category hssg.blog.i18n:*default-category*)
(slug :slug (pathname-name file-path))
(title :title)
@@ -77,6 +77,7 @@
(published :published (apply #'hssg.blog.util:date-from-numbers date-components))
(modified :modified)
(content :content))
+ post
(make-instance 'hssg.blog.artifacts:post-artifact :blog blog :slug slug :title title :content content
:category category :tags tags :author author
:published published
diff --git a/src/blog/template/blog.lisp b/src/blog/template/blog.lisp
index 82948fb..4f14251 100644
--- a/src/blog/template/blog.lisp
+++ b/src/blog/template/blog.lisp
@@ -22,8 +22,9 @@
(defun breadcrumb->sxml (item)
"Convert a breadcrumb entry from the items to an SXML tree"
(declare (type list item))
- (hssg:let-metadata item ((title :title)
- (url :url))
+ (hssg:let-metadata ((title :title)
+ (url :url))
+ item
`((:li :class ,(if url "" "active"))
,(if url
`((:a :href ,url) ,title)
diff --git a/src/blog/templates.lisp b/src/blog/templates.lisp
index 4ec8e65..9e0839a 100644
--- a/src/blog/templates.lisp
+++ b/src/blog/templates.lisp
@@ -172,16 +172,16 @@
- next Next post"
(:css
- (hssg:let-metadata post ((css :css))
+ (hssg:let-metadata ((css :css)) post
css))
(:periods
(with-slots ((periods hssg.blog.artifacts:periods ))
blog
periods))
(:breadcrumbs
- (hssg:let-metadata post ((title :title)
- (date :published)
+ (hssg:let-metadata ((date :published)
(slug :slug))
+ post
`(((:title . ,(slot-value blog 'hssg.blog.artifacts:top))
(:url . "../../../../"))
((:title . ,(hssg.blog.util:date->year date))
@@ -191,7 +191,7 @@
((:title . ,(hssg.blog.util:date->day date)))
((:title . ,slug)))))
(:content
- (hssg:let-metadata post ((status :status :published)
+ (hssg:let-metadata ((status :status :published)
(title :title)
(date :published)
(modified :modified)
@@ -199,6 +199,7 @@
(tags :tags '())
(author :author)
(content :content))
+ post
`(((:main :class "blogpost")
(:article
(:h1
diff --git a/src/hssg/artifact.lisp b/src/hssg/artifact.lisp
index 5db10eb..6c138c6 100644
--- a/src/hssg/artifact.lisp
+++ b/src/hssg/artifact.lisp
@@ -19,10 +19,6 @@
;;;; along with CL-HSSG If not, see .
(in-package #:hssg.artifact)
-(defgeneric write-artifact (artifact)
- (:documentation "Write the given ARTIFACT to disc. The artifact's state
- determines where and how the artifact will be written."))
-
(defgeneric derive-artifact (artifact)
(:documentation "Derives the GIVEN artifact to produce a file system instruction."))
diff --git a/src/hssg/artifacts/compound.lisp b/src/hssg/artifacts/compound.lisp
index 0480b13..3803b8d 100644
--- a/src/hssg/artifacts/compound.lisp
+++ b/src/hssg/artifacts/compound.lisp
@@ -19,11 +19,6 @@
;;;; along with CL-HSSG If not, see .(in-package #:hssg.artifact)
(in-package #:hssg.artifact._compound)
-(defmethod hssg.artifact:write-artifact ((wrapper hssg.artifact:compound-artifact))
- "Writes each of the artifacts inside the WRAPPER individually."
- (dolist (artifact (slot-value wrapper 'hssg.artifact:artifacts))
- (hssg.artifact:write-artifact artifact)))
-
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:compound-artifact))
(with-slots ((artifacts hssg.artifact:artifacts)) artifact
(make-instance 'hssg.filesystem:compound-instruction
diff --git a/src/hssg/artifacts/directory.lisp b/src/hssg/artifacts/directory.lisp
index cb872cd..f2e6ed5 100644
--- a/src/hssg/artifacts/directory.lisp
+++ b/src/hssg/artifacts/directory.lisp
@@ -19,23 +19,6 @@
;;;; along with CL-HSSG If not, see .
(in-package #:hssg.artifact.directory)
-(defmethod hssg.artifact:write-artifact ((artifact hssg.artifact:directory-artifact))
- (with-slots ((input hssg.artifact::input)
- (output hssg.artifact::output))
- artifact
- ;; The INPUT contains the directory to copy, but we need its parent to
- ;; construct file paths
- (let ((content-dir (merge-pathnames (fad:pathname-parent-directory input)))
- (output-dir (merge-pathnames (fad:pathname-parent-directory output))))
- (fad:walk-directory
- input
- (lambda (pathname)
- (let* ((relative (enough-namestring pathname content-dir))
- (target (merge-pathnames relative output-dir)))
- (ensure-directories-exist target)
- (fad:copy-file pathname target :overwrite t))))))
- nil)
-
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:directory-artifact))
(with-slots ((path hssg.artifact::directory)
(base-path hssg.artifact::base))
diff --git a/src/hssg/artifacts/html.lisp b/src/hssg/artifacts/html.lisp
index ce284a4..e32cce5 100644
--- a/src/hssg/artifacts/html.lisp
+++ b/src/hssg/artifacts/html.lisp
@@ -19,18 +19,6 @@
;;;; along with CL-HSSG If not, see .
(in-package #:hssg.artifact.html)
-(defmethod hssg.artifact:write-artifact ((artifact hssg.artifact:html-artifact))
- (with-slots ((data hssg.artifact::data)
- (template hssg.artifact::template)
- (output hssg.artifact::output))
- artifact
- (ensure-directories-exist output)
- (with-open-file (*STANDARD-OUTPUT* output :direction :output :if-exists :supersede :if-does-not-exist :create)
- (let ((plump:*tag-dispatchers* plump:*xml-tags*))
- (format t "~%")
- (plump:serialize (sexp->plump-tree
- (cdr (assoc :content (funcall template data)))))))))
-
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:html-artifact))
(with-slots ((data hssg.artifact::data)
(template hssg.artifact::template)
diff --git a/src/hssg/artifacts/verbatim.lisp b/src/hssg/artifacts/verbatim.lisp
index b66d7d5..6804e2f 100644
--- a/src/hssg/artifacts/verbatim.lisp
+++ b/src/hssg/artifacts/verbatim.lisp
@@ -25,14 +25,6 @@
"Buffer size to use when copying a file. The file will be copied in chunks of
this size.")
-(defmethod hssg.artifact:write-artifact ((artifact hssg.artifact:verbatim-artifact))
- (with-slots ((input hssg.artifact::input)
- (output hssg.artifact::output))
- artifact
- (ensure-directories-exist output)
- (fad:copy-file input output :overwrite t)
- nil))
-
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:verbatim-artifact))
(with-slots ((file-name hssg.artifact::file-name)
(directory hssg.artifact::directory))
diff --git a/src/hssg/artifacts/xml.lisp b/src/hssg/artifacts/xml.lisp
index e1de02c..1162298 100644
--- a/src/hssg/artifacts/xml.lisp
+++ b/src/hssg/artifacts/xml.lisp
@@ -19,13 +19,6 @@
;;;; along with CL-HSSG If not, see .
(in-package #:hssg.artifact.xml)
-(defmethod hssg.artifact:write-artifact ((artifact hssg.artifact:xml-artifact))
- (with-slots ((data hssg.artifact::data)
- (output hssg.artifact::output))
- artifact
- (with-open-file (*STANDARD-OUTPUT* output :direction :output :if-exists :supersede :if-does-not-exist :create)
- (plump:serialize (sexp->xml-tree data)))))
-
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:xml-artifact))
(with-slots ((data hssg.artifact::data)
(output hssg.artifact::output))
diff --git a/src/hssg/template.lisp b/src/hssg/template.lisp
index 145631d..c2d87f0 100644
--- a/src/hssg/template.lisp
+++ b/src/hssg/template.lisp
@@ -26,11 +26,11 @@
'(or symbol function))
(defmacro template ((&rest bindings) &body entries)
- "Define an anonymous template. A template is a function which maps an a-list
+ "Define an anonymous template. A template is a function which maps an a-list
onto another a-list.
For each binding in BINDINGS bind the corresponding value from the input
- a-list. These bindings can then be used inside the individual ENTRIES."
+ a-list. These bindings can then be used inside the individual ENTRIES."
(let ((data (gensym "METADATA")))
`(lambda (,data)
(let (,@(mapcar (lambda (binding)
@@ -47,7 +47,7 @@
,data)))))
(defmacro deftemplate (name (&rest bindings) &body entries)
- "Define a named template, which is just an ordinary function. Refer to
+ "Define a named template, which is just an ordinary function. Refer to
TEMPLATE for details."
(let* ((docstring (and (typep (car entries) 'string)
(car entries)))
@@ -58,20 +58,21 @@
(setf (documentation ',name 'function) ,docstring)
',name)))
-(defmacro let-metadata (data-expr (&rest bindings) &body body)
+(defmacro let-metadata ((&rest bindings) data-expr &body body)
"Binds the metadata from the DATA-EXPRession to the BINDINGS for the
- evaluation of the BODY expressions. Each bindings is a tuple of the form
- (KEYWORD SYMBOL &OPTIONAL DEFAULT). The DEFAULT expression will only be
+ evaluation of the BODY expressions. Each bindings is a tuple of the form
+ (KEYWORD SYMBOL &OPTIONAL DEFAULT). The DEFAULT expression will only be
evaluated if the KEYWORD is not present in the DATA.
The result is the value of the last BODY form.
Example:
(let ((data '((:a . \"a\") (:b . \"b\"))))
- (let-metadata data ((a :a)
- (b :b)
- (c :c \"c\") ; Explicit default
- (d :d)) ; Implicit default
+ (let-metadata ((a :a)
+ (b :b)
+ (c :c \"c\") ; Explicit default
+ (d :d)) ; Implicit default
+ data
(list a b c d)))
--
(\"a\" \"b\" \"c\" NIL)"
diff --git a/test/hssg/readers/lisp.lisp b/test/hssg/readers/lisp.lisp
index 63f47a0..69328dd 100644
--- a/test/hssg/readers/lisp.lisp
+++ b/test/hssg/readers/lisp.lisp
@@ -35,9 +35,10 @@
(clunit:deftest lisp-reader-can-read-files (hssg.reader.lisp)
"The Lisp reader can read the contents of a Lisp file"
(let ((data (funcall reader "test/hssg/sample-files/metadata.lisp")))
- (hssg:let-metadata data ((foo :foo)
- (bar :bar)
- (baz :baz))
+ (hssg:let-metadata ((foo :foo)
+ (bar :bar)
+ (baz :baz))
+ data
(let ((clunit:*clunit-equality-test* #'string-equal))
(clunit:assert-equality* "foo" foo foo)
(clunit:assert-equality* "bar" bar bar)
diff --git a/test/hssg/template.lisp b/test/hssg/template.lisp
index 12f829a..24dbf66 100644
--- a/test/hssg/template.lisp
+++ b/test/hssg/template.lisp
@@ -34,14 +34,15 @@
(clunit:deftest let-metadata-form (hssg.template)
"The LET-METADATA form can bind data from an association list"
- (hssg:let-metadata foo-bar-data ((foo :foo)
- (bar :bar)
- (baz :baz)
- (qux :qux "qux"))
- (clunit:assert-equal "foo" foo foo)
- (clunit:assert-equal "bar" bar bar)
- (clunit:assert-equal nil baz baz)
- (clunit:assert-equal "qux" qux qux)))
+ (hssg:let-metadata ((foo :foo)
+ (bar :bar)
+ (baz :baz)
+ (qux :qux "qux"))
+ foo-bar-data
+ (clunit:assert-equal "foo" foo foo)
+ (clunit:assert-equal "bar" bar bar)
+ (clunit:assert-equal nil baz baz)
+ (clunit:assert-equal "qux" qux qux)))
(clunit:deftest identity-template-unchanged (hssg.template)
"The identity template returns its input unchanged"
@@ -59,9 +60,10 @@
(:foo (string-upcase foo))
(:baz "baz")))
(out (hssg:apply-template template foo-bar-data)))
- (hssg:let-metadata out ((foo :foo)
- (bar :bar)
- (baz :baz))
+ (hssg:let-metadata ((foo :foo)
+ (bar :bar)
+ (baz :baz))
+ out
(let ((clunit:*clunit-equality-test* #'string-equal))
(clunit:assert-equality* "FOO" foo foo)
(clunit:assert-equality* "bar" bar bar)
@@ -78,9 +80,10 @@
(:bar (string-upcase bar))))
(template (hssg:chain-templates t1 t2 t3))
(out (hssg:apply-template template foo-data)))
- (hssg:let-metadata out ((foo :foo)
- (bar :bar)
- (baz :baz))
+ (hssg:let-metadata ((foo :foo)
+ (bar :bar)
+ (baz :baz))
+ out
(let ((clunit:*clunit-equality-test* #'string-equal))
(clunit:assert-equality* "FOO" foo foo)
(clunit:assert-equality* "bar" bar bar)
@@ -91,9 +94,10 @@
(let* ((template (hssg:template-with-data (hssg:template () (:baz "baz"))
'((:bar . "bar"))))
(out (hssg:apply-template template foo-data)))
- (hssg:let-metadata out ((foo :foo)
- (bar :bar)
- (baz :baz))
+ (hssg:let-metadata ((foo :foo)
+ (bar :bar)
+ (baz :baz))
+ out
(let ((clunit:*clunit-equality-test* #'string-equal))
(clunit:assert-equality* "foo" foo foo)
(clunit:assert-equality* "bar" bar bar)