marcuskammer/cl-hssg
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Switcher argument order in LET-METADATA macro

Browse source 
The new order which places the bindings is more consistent with the
order of other forms in the standard which created local bindings.
This commit is contained in:
HiPhish 2022-12-26 14:47:06 +01:00
parent aefa02fe1a
commit 4aa3958c99
12 changed files with 46 additions and 90 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
src/blog/facade.lisp
View file

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

3
src/blog/template/blog.lisp
View file

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

9
src/blog/templates.lisp
View file

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

4
src/hssg/artifact.lisp
View file

@ -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."))

5
src/hssg/artifacts/compound.lisp
View file

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

17
src/hssg/artifacts/directory.lisp
View file

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

12
src/hssg/artifacts/html.lisp
View file

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

8
src/hssg/artifacts/verbatim.lisp
View file

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

7
src/hssg/artifacts/xml.lisp
View file

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

5
src/hssg/template.lisp
View file

@ -58,7 +58,7 @@
(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
@ -68,10 +68,11 @@
Example:
(let ((data '((:a . \"a\") (:b . \"b\"))))
(let-metadata data ((a :a)
(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)"

3
test/hssg/readers/lisp.lisp
View file

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

12
test/hssg/template.lisp
View file

@ -34,10 +34,11 @@
(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)
(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)
@ -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)
(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)
(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)
(baz :baz))
out
(let ((clunit:*clunit-equality-test* #'string-equal))
(clunit:assert-equality* "foo" foo foo)
(clunit:assert-equality* "bar" bar bar)