From 4aa3958c99410d81d708c43236979be5ad285114 Mon Sep 17 00:00:00 2001 From: HiPhish Date: Mon, 26 Dec 2022 14:47:06 +0100 Subject: [PATCH] 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 | 3 ++- src/blog/template/blog.lisp | 5 ++-- src/blog/templates.lisp | 9 ++++---- src/hssg/artifact.lisp | 4 ---- src/hssg/artifacts/compound.lisp | 5 ---- src/hssg/artifacts/directory.lisp | 17 -------------- src/hssg/artifacts/html.lisp | 12 ---------- src/hssg/artifacts/verbatim.lisp | 8 ------- src/hssg/artifacts/xml.lisp | 7 ------ src/hssg/template.lisp | 21 +++++++++-------- test/hssg/readers/lisp.lisp | 7 +++--- test/hssg/template.lisp | 38 +++++++++++++++++-------------- 12 files changed, 46 insertions(+), 90 deletions(-) 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)