Commit c23f28a2 authored by Erik Huelsmann's avatar Erik Huelsmann
Browse files

Merge branch 'edit-page' into 'master'

Refactor 'preprocess-*' and 'generate-news' into around-like functions

Closes #8

See merge request clo/cl-site!73
parents 11fa5fc4 eba4bd4b
......@@ -8,10 +8,5 @@ auto-save-list
# Output files
\ No newline at end of file
# stage: build
# script: make
stage: build
script: make
- site-gen
stage: deploy
title: Welcome to!
<main id="bodyText">
<a class="btn btn-primary float-right" href="/downloads"><i class="fa fa-arrow-right"></i>&nbsp;&nbsp;Get started</a>
......@@ -19,7 +21,7 @@ title: Welcome to!
<div id="clnet-news">
<h2><a href="/news">Latest news</a></h2>
{{> newsbox}}
<p><a href="/news" style="font-size: 80%">Read more...</a></p>
......@@ -2,6 +2,7 @@ title: News
# Latest news
### 2018-10-26
;;;; -*- 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)
(defun file-to-list (path)
(with-open-file (f path :direction :input)
(loop for line = (read-line f nil)
while line
collect line)))
(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."
......@@ -31,6 +69,36 @@
(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.
(let ((next-hooks-sym (gensym)))
(defun ,name (,@args ,next-hooks-sym)
(flet ((call-next-hook (content context)
(funcall (pop ,next-hooks-sym) content context ,next-hooks-sym)))
(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))
(funcall (pop hooks) content context hooks)))
(defun page-content (page) (rest (assoc :content page)))
......@@ -57,6 +125,11 @@
(cons (second plist)
(plist-values (rest (rest plist))))))
(defun alist-from-hash (hash)
(loop for k being each hash-key of hash
using (hash-value v)
collect (cons k v)))
(defmacro with-cl-who-string ((&rest args) &body body)
"Form. Sets up body to be evaluated with cl-who:with-html-output and return the resulting string instead
......@@ -66,8 +66,14 @@
<footer class="footer border-top bg-light">
<div class="container">
<footer class="bg-light footer" style="margin-top:15px;clear:both">
<div style="display:block;margin-left:auto;margin-right:auto;margin-bottom:20px;text-align:center">
<a class="btn btn-secondary" style="color: #29aa22;border-color: #29aa22" href="{{{rel-path}}}">
<i class="far fa-edit"></i>&nbsp;Edit this page
<div class="container border-top">
<div class="row">
<div class="col-md-6" style="font-style: italic;">
<div style="text-align:left;width:100%; margin-bottom: 0px;">
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(in-package :cl-site)
(defun make-site (&optional output-dir)
(let ((*output-dir* (or output-dir *output-dir*)))
(format t "Generating site in ~A.~%" *output-dir*)
(process-static *static-dir* *output-dir*)
(process-static (merge-pathnames #P"static/" *layout-dir*) *output-dir*)
(let ((pages (populate-pages)))
(preprocess-md-pages pages)
(preprocess-lisp-pages pages))
(process-pages (populate-pages))))
(defun check-deps-fn (dependencies)
#'(lambda (processed-pages)
(every (lambda (d)
(member d processed-pages :test #'string=))
(defun make-site (&optional (output-dir *output-dir*))
(let ((pages (populate-pages)))
(ensure-directories-exist output-dir)
(format t "Generating site in ~A.~%" output-dir)
(process-static *static-dir* output-dir)
(process-static (merge-pathnames #P"static/" *layout-dir*) output-dir)
(loop with processed-pages = '()
with delayed-pages = '()
for page in pages
for page-path = (make-path *pages-dir* page t)
for rel-page-path = (enough-namestring page-path *pages-dir*)
for page-lines = (file-to-list page-path)
for header = (yaml:parse (format nil "~{~A~%~}" (header-lines page-lines)))
for content = (format nil "~{~A~%~}" (content-lines page-lines))
;; order in the context is very important: for any key appearing twice
;; (e.g. the 'title' key), the first will be selected; by taking the header values
;; first, the default 'title' being the content filename, can be overridden in the page's metadata
for context = (append (when header (alist-from-hash header)) page)
for dependencies = (cdr (assoc "depends-on" context :test #'string=))
for satisfies-deps-fn = (check-deps-fn dependencies)
for satisfies-deps-p = (funcall satisfies-deps-fn processed-pages)
do (push (list satisfies-deps-fn content context rel-page-path) delayed-pages)
do (loop for resolved-deps-pages =
(loop for delay in delayed-pages
for satisfies-deps-p = (funcall (car delay) processed-pages)
when satisfies-deps-p
collect delay
and do (progn
(format t "Rendering ~a~%" (fourth delay))
(push (fourth delay) processed-pages)
(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=))))))
(defun make-clean (&optional (output-dir *output-dir*))
;;;; -*-Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(in-package :cl-site)
(defun split-content-from-header (path)
"Returns two values; the header and the content"
(with-open-file (f path :direction :input)
(let ((header-lines
(loop for line = (read-line f nil)
unless line do (return-from split-content-from-header
(values nil lines))
when (string= line "---") return lines
collect line into lines)))
(loop for line = (read-line f nil)
unless line
return (values header-lines lines)
collect line into lines))))
;; Copies/renders static assets (imgs, etc)
(defun process-static (static-dir output-dir)
(let ((destination-root (merge-pathnames #P"static/" output-dir))
......@@ -45,76 +30,55 @@
(with-output-to-string (output-stream)
(render-template template context output-stream)))
(defun render-page (page template-path)
(let ((page-path (make-path *PAGES-DIR* page t))
(output-path (make-path *OUTPUT-DIR* page t)))
(defun render-page (content context template-path)
(let ((output-path (make-pathname :defaults (make-path *OUTPUT-DIR* context t) :type "html")))
(ensure-directories-exist output-path)
(header content)
(split-content-from-header page-path)
(let* ((header-text (format nil "~{~A~%~}" header))
(content-text (format nil "~{~A~%~}" content))
(parsed-header (when header (yaml:parse header-text)))
(when parsed-header
(loop for k being each hash-key of parsed-header
using (hash-value v)
collect (cons k v)))))
(with-open-file (output-stream output-path
:direction :output
:if-exists :supersede)
(render-template template-path
(append (acons :page-content (render-template* content-text) page-context) *GLOBAL-CONTEXT*)
(defun preprocess-md-pages (pages)
(format t "Preprocessing Markdown pages..~%")
(dolist (page pages)
(let* ((md-file (make-path *pages-dir* page t)))
(when (string= (pathname-type md-file) "md")
(let ((html-file (make-pathname :defaults md-file :type "html")))
(format t "Transforming ~A to ~A~%" md-file html-file)
(header content)
(split-content-from-header md-file)
(let ((md-content (with-output-to-string (out) (cl-markdown:markdown (format nil "~{~A~%~}" content) :stream out))))
(with-open-file (f html-file
:direction :output
:if-exists :supersede)
(when header
(format f "~{~A~%~}---~%" header))
(format f "~A~%" md-content)))))))))
(defun preprocess-lisp-pages (pages)
(format t "Preprocessing LHTML pages..~%")
(dolist (page pages)
(let* ((lisp-file (page-content page)))
(when (string-equal (pathname-type lisp-file) "lisp")
(let ((html-file (make-pathname :defaults lisp-file :type "html")))
(format t "Loading ~a and creating fresh ~a...~%"
(file-namestring lisp-file) html-file)
(let (*computed-page-content*)
(load (merge-pathnames lisp-file *pages-dir*))
(with-open-file (out (merge-pathnames html-file *pages-dir*) :if-exists :supersede
:if-does-not-exist :create :direction :output)
(let ((headers (getf *computed-page-content* :headers)))
(mapc #'(lambda(key value) (format out "~a: ~a~%" key value))
(plist-keys headers)(plist-values headers)))
(format out "---~%")
(write-string (getf *computed-page-content* :html-string) out))))))))
(defun process-pages (pages)
(format t "Processing pages..~%")
(with-open-file (output-stream output-path
:direction :output
:if-exists :supersede)
(with-output-to-string (string-stream)
(let* ((stream (make-broadcast-stream output-stream string-stream))
(page-context (append (acons :rel-path
(enough-namestring (cdr (assoc :content context)) *pages-dir*)
(page-content (render-template* content page-context)))
(render-template template-path (acons :page-content page-content
(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 (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
(cl-markdown:markdown content :stream out))))
(call-next-hook md-content context)))))
(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 (call-next-hook content context)))
(let ((html-file (enough-namestring (make-pathname :defaults lisp-file :type "html") *pages-dir*))
(format t "Loading ~a and creating fresh ~a...~%"
(file-namestring lisp-file) html-file)
;;;###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)))
(call-next-hook (getf *computed-page-content* :html-string)
(append (mapcan #'(lambda (key value)
(acons key value nil))
(plist-keys headers)
(plist-values headers))
(defun process-page (content context)
(let ((template-path (pathname (merge-pathnames *templates-dir* *DEFAULT-PAGE-TEMPLATE*))))
(ensure-directories-exist *OUTPUT-DIR*)
(loop for page in pages
when (string= (pathname-type (cdr (assoc :content page))) "html")
(format t "Rendering ~A~%" (cdr (assoc :content page)))
(render-page page template-path))
(format t "Done.~%")))
(render-page content context template-path)))
;; Process news
......@@ -127,23 +91,14 @@
;; newsbox. The news.lisp would have to include the hardcoded HTML
;; which is injected below as well.
(defun generate-news ()
(let ((html
(with-output-to-string (out) (cl-markdown:markdown (merge-pathnames "" *PAGES-DIR*) :stream out))))
(with-open-file (f (merge-pathnames "news.html" *PAGES-DIR*)
:direction :output
:if-does-not-exist :create
:if-exists :supersede)
(write-string "<div id=\"bodyText\">" f)
(format f "<a class=\"btn btn-secondary float-right\" href=\"~A\"><i class=\"far fa-edit\"></i>&nbsp;Edit this page</a>" +edit-news-link+)
(write-string "<h1>Latest news</h1>" f)
(write-string html f)
(write-string "</div>" f))
(with-open-file (f (merge-pathnames "newsbox.html" *PAGES-DIR*)
:direction :output
:if-does-not-exist :create
:if-exists :supersede)
(write-string (generate-news-box-content html) f))))
(def-render-hook generate-news (content context)
(let ((page-path (cdr (assoc :content context)))
(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)))
(push (cons :newsbox newsbox) *global-context*)))
(defun shallow-copy-object (original)
(let* ((class (class-of original))
......@@ -162,22 +117,44 @@
(block done
(flet ((next-node ()
(setf node (plump:next-sibling node))
(setq node (plump:next-sibling node))
(when (null node)
;;(print "DONE")
(return-from done))
;;(print state)
;;(print node)
;;(describe node)
(ecase state
(if (and (plump:element-p node)
(equalp (plump:tag-name node) "h3"))
(setf state :read-news-heading)
(equalp (plump:tag-name node) "html"))
(setq state :html
node (plump:first-child node))
;; else
(if (and (plump:element-p node)
(equalp (plump:tag-name node) "body"))
(setq state :body
node (plump:first-child node))
;; else
(if (and (plump:element-p node)
(equalp (plump:tag-name node) "main"))
(setq state :main
node (plump:first-child node))
(if (and (plump:element-p node)
(equalp (plump:tag-name node) "h3"))
(setq state :read-news-heading)
;; If enough news, exit
......@@ -185,14 +162,14 @@
(return-from done))
;; Start a new one
(setf current-news
(setq current-news
(plump:make-element news "section"))
(let ((title-node (shallow-copy-object node)))
(setf (plump:tag-name title-node) "h7")
(plump:append-child current-news title-node))
(setf state :read-news-content))
(setq state :read-news-content))
;; We assume the node is a paragraph and we read its content
......@@ -201,7 +178,7 @@
(plump:append-child current-news (shallow-copy-object node))
(setf state :start))
(setq state :main))
;; else
(plump:serialize news nil))))
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