Commit 21905dbb authored by Erik Huelsmann's avatar Erik Huelsmann

Introduce macrology to simplify definition and invocation of wrappers

parent fc5ae7fb
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(in-package :cl-site)
; Makes pathname from prefix + page object
(defun make-path (prefix suffix &optional page)
"Constructs a pathname from `prefix` and `suffix`.
`suffix` can be one of
1. a context (an alist) with a ':content' element
2. a pathname
3. a string identifying a path
`prefix` can be one of
1. a pathname
2. a string identifying a path
"
(let ((path (if page (cdr (assoc :content suffix)) suffix)))
(if (pathnamep prefix)
(merge-pathnames path prefix)
(pathname (concatenate 'string
prefix path)))))
; Slurps file from a string
(defun file-to-string (filepath)
"Reads the file designated by pathname `filepath` into memory,
returning the string with the sequence read from the file"
(with-open-file (stream filepath)
(let ((data (make-string (file-length stream))))
(read-sequence data stream)
data)))
(defun header-lines (lines)
"Returns a list of lines (subset of `lines`)
which form the header of the document `lines` were read from
"
(loop for line in lines
thereis (when (string= line "---") header-lines)
collect line into header-lines))
(defun content-lines (lines)
"Returns a list of lines (subset of `lines`)
which remain after the header (if any) has been discarded
"
(loop with found-header-p = nil
for line in lines
when found-header-p
collect line into post-header-lines
when (string= line "---")
do (setf found-header-p t)
collect line into content-lines
finally (return (if found-header-p post-header-lines content-lines))))
(defun populate-pages ()
"Each page is an alist containing info to be sent to the template via the context."
(mapcar (lambda (p)
......@@ -31,6 +63,35 @@
(directory (merge-pathnames #P"**/*.lisp" *pages-dir*)))))
(defvar *render-hooks* '()
"A list of hooks wrapping the rendering of the page.")
(defmacro def-render-hook (name (&rest args) &rest body)
"Registers a hook to wrap the rendering of the page.
Provides a `call-next-hook` function which dispatches
execution to the next wrapper and ultimately to the
page renderer.
The wrapper should return the value received from
a `call-next-hook` to its caller as it is the content
of the rendered page.
"
`(progn
(defun ,name (,@args next-hooks)
(flet ((call-next-hook (content context)
(funcall (pop next-hooks) content context next-hooks)))
,@body))
(push (function ,name) *render-hooks*)))
(defun render-page-with-hooks (content context)
(let ((hooks (reverse (cons #'(lambda (p c next-processors)
(process-page p c))
*render-hooks*))))
(funcall (pop hooks) content context hooks)))
(defun page-content (page) (rest (assoc :content page)))
......
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(in-package :cl-site)
(defun header-lines (lines)
(loop for line in lines
thereis (when (string= line "---") header-lines)
collect line into header-lines))
(defun content-lines (lines)
(loop with found-header-p = nil
for line in lines
when found-header-p
collect line into post-header-lines
when (string= line "---")
do (setf found-header-p t)
collect line into content-lines
finally (return (if found-header-p post-header-lines content-lines))))
(defun make-site (&optional output-dir)
(let ((*output-dir* (or output-dir *output-dir*))
......@@ -52,12 +38,8 @@
and do (format t "Delayed rendering ~a~%" rel-page-path)
when satisfies-deps-p
do (progn
(format t "Rendering ~A~%" rel-page-path))
(preprocess-md-page content context
(list #'preprocess-lisp-page
#'generate-news
(lambda (p c next-processors)
(process-page p c))))
(format t "Rendering ~A~%" rel-page-path)
(render-page-with-hooks content context))
and collect rel-page-path into processed-pages
and do (loop for resolved-deps-pages =
(loop for delay in delayed-pages
......@@ -67,11 +49,7 @@
and do (progn
(format t "Rendering delayed ~a~%" (fourth delay))
(push (fourth delay) processed-pages)
(preprocess-md-page (second delay) (third delay)
(list #'preprocess-lisp-page
#'generate-news
(lambda (p c next-processors)
(process-page p c))))))
(render-page-with-hooks (second delay) (third delay))))
while resolved-deps-pages
do (setf delayed-pages
(set-difference delayed-pages resolved-deps-pages :key #'fourth :test #'string=))))))
......
......@@ -47,21 +47,21 @@
page-context)
stream))))))
(defun preprocess-md-page (content context next-processors)
(def-render-hook preprocess-md-page (content context)
(let* ((md-file (enough-namestring (make-path *pages-dir* context t) *pages-dir*)))
(unless (string= (pathname-type md-file) "md")
(return-from preprocess-md-page (funcall (pop next-processors) content context next-processors)))
(return-from preprocess-md-page (call-next-hook content context)))
(let ((html-file (make-pathname :defaults md-file :type "html")))
(format t "Transforming ~A to ~A~%" md-file html-file)
(let ((md-content (with-output-to-string
(out)
(cl-markdown:markdown content :stream out))))
(funcall (pop next-processors) md-content context next-processors)))))
(call-next-hook md-content context)))))
(defun preprocess-lisp-page (content context next-processors)
(def-render-hook preprocess-lisp-page (content context)
(let* ((lisp-file (make-path *pages-dir* context t)))
(unless (string= (pathname-type lisp-file) "lisp")
(return-from preprocess-lisp-page (funcall (pop next-processors) content context next-processors)))
(return-from preprocess-lisp-page (call-next-hook content context)))
(let ((html-file (enough-namestring (make-pathname :defaults lisp-file :type "html") *pages-dir*))
*computed-page-content*)
(format t "Loading ~a and creating fresh ~a...~%"
......@@ -69,13 +69,12 @@
;;;###TODO not happy about loading the lisp file; it defeats the preprocessor/postprocessor purpose
(load (merge-pathnames lisp-file *pages-dir*))
(let ((headers (getf *computed-page-content* :headers)))
(funcall (pop next-processors) (getf *computed-page-content* :html-string)
(append (mapcan #'(lambda (key value)
(acons key value nil))
(plist-keys headers)
(plist-values headers))
context)
next-processors)))))
(call-next-hook (getf *computed-page-content* :html-string)
(append (mapcan #'(lambda (key value)
(acons key value nil))
(plist-keys headers)
(plist-values headers))
context))))))
(defun process-page (content context)
(let ((template-path (pathname (merge-pathnames *templates-dir* *DEFAULT-PAGE-TEMPLATE*))))
......@@ -92,9 +91,9 @@
;; newsbox. The news.lisp would have to include the hardcoded HTML
;; which is injected below as well.
;;
(defun generate-news (content context next-processors)
(def-render-hook generate-news (content context)
(let ((page-path (cdr (assoc :content context)))
(content (funcall (pop next-processors) content context next-processors)))
(content (call-next-hook content context)))
(when (and (string= (pathname-name page-path) "news")
(string= (pathname-type page-path) "md"))
(let ((newsbox (generate-news-box-content content)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment