Switcher argument order in LET-METADATA macro

The new order which places the bindings is more consistent with the
order of other forms in the standard which created local bindings.

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

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)
+  (hssg:let-metadata ((title :title)
-                           (url :url))
+                      (url :url))
+      item
     `((:li :class ,(if url "" "active"))
        ,(if url
           `((:a :href ,url) ,title)

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)
+    (hssg:let-metadata ((date :published)
-                        (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

src/hssg/artifact.lisp

@@ -19,10 +19,6 @@
 ;;;; along with CL-HSSG  If not, see <https://www.gnu.org/licenses/>.
 (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."))
 

src/hssg/artifacts/compound.lisp

@@ -19,11 +19,6 @@
 ;;;; along with CL-HSSG  If not, see <https://www.gnu.org/licenses/>.(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

src/hssg/artifacts/directory.lisp

@@ -19,23 +19,6 @@
 ;;;; along with CL-HSSG  If not, see <https://www.gnu.org/licenses/>.
 (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))

src/hssg/artifacts/html.lisp

@@ -19,18 +19,6 @@
 ;;;; along with CL-HSSG  If not, see <https://www.gnu.org/licenses/>.
 (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 "<!DOCTYPE html>~%")
-        (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)

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))

src/hssg/artifacts/xml.lisp

@@ -19,13 +19,6 @@
 ;;;; along with CL-HSSG  If not, see <https://www.gnu.org/licenses/>.
 (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))

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
+  evaluation of the BODY expressions.  Each bindings is a tuple of the form
-  (KEYWORD SYMBOL &OPTIONAL DEFAULT). The DEFAULT expression will only be
+  (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)
+      (let-metadata ((a :a)
-                          (b :b)
+                     (b :b)
-                          (c :c \"c\")  ; Explicit default
+                     (c :c \"c\")  ; Explicit default
-                          (d :d))       ; Implicit default
+                     (d :d))       ; Implicit default
+          data 
         (list a b c d)))
     --
     (\"a\" \"b\" \"c\" NIL)"

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)
+    (hssg:let-metadata ((foo :foo)
-                             (bar :bar)
+                        (bar :bar)
-                             (baz :baz))
+                        (baz :baz))
+        data
       (let ((clunit:*clunit-equality-test* #'string-equal))
         (clunit:assert-equality* "foo" foo foo)
         (clunit:assert-equality* "bar" bar bar)

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)
+  (hssg:let-metadata ((foo :foo)
-                                   (bar :bar)
+                      (bar :bar)
-                                   (baz :baz)
+                      (baz :baz)
-                                   (qux :qux "qux"))
+                      (qux :qux "qux"))
-      (clunit:assert-equal "foo" foo foo)
+      foo-bar-data
-      (clunit:assert-equal "bar" bar bar)
+    (clunit:assert-equal "foo" foo foo)
-      (clunit:assert-equal   nil baz baz)
+    (clunit:assert-equal "bar" bar bar)
-      (clunit:assert-equal "qux" qux qux)))
+    (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)
+    (hssg:let-metadata ((foo :foo)
-                            (bar :bar)
+                        (bar :bar)
-                            (baz :baz))
+                        (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)
+    (hssg:let-metadata ((foo :foo)
-                            (bar :bar)
+                        (bar :bar)
-                            (baz :baz))
+                        (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)
+    (hssg:let-metadata ((foo :foo)
-                            (bar :bar)
+                        (bar :bar)
-                            (baz :baz))
+                        (baz :baz))
+        out
       (let ((clunit:*clunit-equality-test* #'string-equal))
         (clunit:assert-equality* "foo" foo foo)
         (clunit:assert-equality* "bar" bar bar)