Commit 11d4db3d authored by Erik Huelsmann's avatar Erik Huelsmann

Integrate static asset deployment into Lisp code

parent 47316678
......@@ -5,7 +5,7 @@ serve:
static:
mkdir -p output/static
cp -rf content/static/* output/static
# cp -rf content/static/* output/static
favicon:
cp content/favicon.ico output/
......
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(in-package :cl-site)
(defparameter *LAYOUT-DIR* (asdf:system-relative-pathname :cl-site "layout/templates/")
"Pathname for location of template files.")
(defparameter *OUTPUT-DIR* (asdf:system-relative-pathname :cl-site "output/")
"Pathname where the generated output should be written to.")
;; @TO-DO: store layout name as global, generate js/css pathnames from it.
;; (More template-related variables may go here in the future)
(defparameter *DEFAULT-PAGE-TEMPLATE* "layout_2018.html"
"Default template to use unless another is explicitly specified.")
;; @TO-DO: replace this with better css preprocessing.
(defparameter *STYLES-DIR* (asdf:system-relative-pathname :cl-site "layout/css/")
"Pathname for location and list of styles.")
(defparameter *STYLES*
(list "layout_2018.css")
"A list of strings representing relative filenames.")
;; JS files - separate from static files, because they are processed differently
;; within the template.
(defparameter *SCRIPTS-DIR* (asdf:system-relative-pathname :cl-site "layout/js/")
"Pathname for location and list of scripts.")
(defparameter *SCRIPTS*
(list "scripts.js")
"A list of strings representing relative filenames.")
;; General static files - images etc
(defparameter *STATIC-DIR* (asdf:system-relative-pathname :cl-site "layout/static/")
"Pathname for location of static files.")
;; The only REQUIRED field is :content which must be the filename of the page content
;; The :content field will NOT be sent to the template.
;; @TO-DO: store fields within content files and parse them out.
(defparameter *PAGES-DIR* (asdf:system-relative-pathname :cl-site "content/")
"Pathname for location of page content.")
(defparameter *PRIVATE-KEYS* '(:slug :content))
;; Extra context for pages
(defparameter *PAGE-CONTEXT*
`(("about.html" ((:title . "Common-Lisp.net | About")))
("index.html" ((:title . "Welcome to Common-Lisp.net!")))
("faq.html" ((:title . "Frequently asked questions")))
("gitlab-migration-repository-mapping.html" ((:title . "GitLab migration")))
("gitlab-migration-status.html" ((:title . "Migration to GitLab")))
("independent-lists.html" ((:title . "Independent Mailing Lists")))
("orphaned-mailing-lists.html" ((:title . "Orphaned mailing lists")))
("orphaned-projects.html" ((:title . "Orphaned projects")))
("phub.html" ((:title . "Projects")))
("project-intro.html" ((:title . "Project Hosting")))))
(defun page-context (filename)
(cadr (assoc filename *page-context* :test 'equalp)))
(defun page-title (filename)
(or (cdr (assoc :title (page-context filename)))
(format nil "Common-Lisp.net | ~a"
(string-capitalize
(pathname-name (pathname filename))))))
(defparameter *PAGES*
(mapcar (lambda (p)
(let ((context
(append (list (cons :content (file-namestring p)))
(page-context (file-namestring p)))))
(when (not (assoc :title context))
(push (cons :title (page-title (file-namestring p)))
context))
context))
(directory (make-pathname :defaults *PAGES-DIR*
:name :wild
:type "html")))
"Each page is an alist containing info to be sent to the template via the context.")
;; Initialize global context (will be appended to all individual page contexts)
;; Used to store things like stylesheets, etc...
(defparameter *GLOBAL-CONTEXT* ())
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(in-package :cl-site)
(defparameter *LAYOUT-DIR* (asdf:system-relative-pathname :cl-site "layout/templates/")
"Pathname for location of template files.")
(defparameter *OUTPUT-DIR* (asdf:system-relative-pathname :cl-site "output/")
"Pathname where the generated output should be written to.")
;; @TO-DO: store layout name as global, generate js/css pathnames from it.
;; (More template-related variables may go here in the future)
(defparameter *DEFAULT-PAGE-TEMPLATE* "layout_2018.html"
"Default template to use unless another is explicitly specified.")
;; @TO-DO: replace this with better css preprocessing.
(defparameter *STYLES-DIR* (asdf:system-relative-pathname :cl-site "layout/css/")
"Pathname for location and list of styles.")
(defparameter *STYLES*
(list "layout_2018.css")
"A list of strings representing relative filenames.")
;; JS files - separate from static files, because they are processed differently
;; within the template.
(defparameter *SCRIPTS-DIR* (asdf:system-relative-pathname :cl-site "layout/js/")
"Pathname for location and list of scripts.")
(defparameter *SCRIPTS*
(list "scripts.js")
"A list of strings representing relative filenames.")
;; General static files - images etc
(defparameter *STATIC-DIR* (asdf:system-relative-pathname :cl-site "content/static/")
"Pathname for location of static files.")
;; The only REQUIRED field is :content which must be the filename of the page content
;; The :content field will NOT be sent to the template.
;; @TO-DO: store fields within content files and parse them out.
(defparameter *PAGES-DIR* (asdf:system-relative-pathname :cl-site "content/")
"Pathname for location of page content.")
(defparameter *PRIVATE-KEYS* '(:slug :content))
;; Extra context for pages
(defparameter *PAGE-CONTEXT*
`(("about.html" ((:title . "Common-Lisp.net | About")))
("index.html" ((:title . "Welcome to Common-Lisp.net!")))
("faq.html" ((:title . "Frequently asked questions")))
("gitlab-migration-repository-mapping.html" ((:title . "GitLab migration")))
("gitlab-migration-status.html" ((:title . "Migration to GitLab")))
("independent-lists.html" ((:title . "Independent Mailing Lists")))
("orphaned-mailing-lists.html" ((:title . "Orphaned mailing lists")))
("orphaned-projects.html" ((:title . "Orphaned projects")))
("phub.html" ((:title . "Projects")))
("project-intro.html" ((:title . "Project Hosting")))))
(defun page-context (filename)
(cadr (assoc filename *page-context* :test 'equalp)))
(defun page-title (filename)
(or (cdr (assoc :title (page-context filename)))
(format nil "Common-Lisp.net | ~a"
(string-capitalize
(pathname-name (pathname filename))))))
(defparameter *PAGES*
(mapcar (lambda (p)
(let ((context
(append (list (cons :content (file-namestring p)))
(page-context (file-namestring p)))))
(when (not (assoc :title context))
(push (cons :title (page-title (file-namestring p)))
context))
context))
(directory (make-pathname :defaults *PAGES-DIR*
:name :wild
:type "html")))
"Each page is an alist containing info to be sent to the template via the context.")
;; Initialize global context (will be appended to all individual page contexts)
;; Used to store things like stylesheets, etc...
(defparameter *GLOBAL-CONTEXT* ())
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(in-package :cl-site)
;; Copies/renders stylesheets + adds to global context
(defun process-styles ()
(let
((styles-list (mapcar
(lambda (s) (progn
(uiop:copy-file (make-path *STYLES-DIR* s)
(make-path *OUTPUT-DIR* s))
(cons :location s)))
*STYLES*)))
(push (cons :styles styles-list) *GLOBAL-CONTEXT*)))
;; Copies/renders script files + adds to global context
(defun process-scripts () nil)
;; Copies/renders static assets (imgs, etc)
(defun process-static ())
#+nil
(defun process-static ()
(let*
((static-output-dir (merge-pathnames #P"static/" *OUTPUT-DIR*))
(static-list (mapcar
(lambda (s) (progn
(uiop:copy-file (make-path *STATIC-DIR* s)
(make-path static-output-dir s))
(cons :location s)))
(mapcar
(lambda (p) (file-namestring p))
(directory (make-pathname :defaults *STATIC-DIR*
:name :wild
:type :wild))))))
(push (cons :static static-list) *GLOBAL-CONTEXT*)))
;; process-pages : Copies/renders pages - called last
(defun render-page (page template-path)
(let*
((page-path (make-path *PAGES-DIR* page t))
(output-path (make-path *OUTPUT-DIR* page t))
(page-content (let ((mustache:*load-path* (cons *PAGES-DIR* mustache:*load-path*))
(mustache:*default-pathname-type* "html"))
(mustache:render* page-path)))
(page-context (remove-if (lambda (p) (find p *PRIVATE-KEYS*))
(push (cons :page-content page-content) page) :key 'car)))
(with-open-file (output-stream output-path
:direction :output
:if-exists :supersede)
(let ((mustache:*load-path* (cons *PAGES-DIR* mustache:*load-path*))
(mustache:*default-pathname-type* "html"))
(mustache:render template-path (append page-context *GLOBAL-CONTEXT*)
output-stream)))))
(defun process-pages ()
(format t "Processing pages..~%")
(generate-news)
(let ((template-path (pathname (merge-pathnames *LAYOUT-DIR* *DEFAULT-PAGE-TEMPLATE*))))
(ensure-directories-exist *OUTPUT-DIR*)
(loop for page in *PAGES*
do
(format t "Generating ~A~%" (cdr (assoc :content page)))
(render-page page template-path))
(format t "Done.~%")))
;; Process news
(defparameter +edit-news-link+ "https://gitlab.common-lisp.net/clo/cl-site/edit/master/content/news.md")
(defun generate-news ()
(let ((html
(markdown:parse-file (merge-pathnames "news.md" *PAGES-DIR*))))
(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 Common-Lisp.net 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))))
(defun shallow-copy-object (original)
(let* ((class (class-of original))
(copy (allocate-instance class)))
(dolist (slot (mapcar #'c2mop:slot-definition-name (c2mop:class-slots class)))
(when (slot-boundp original slot)
(setf (slot-value copy slot)
(slot-value original slot))))
copy))
(defun generate-news-box-content (html &key (count 5))
(let ((dom (plump-parser:parse html)))
(let ((state :start)
(node (plump:first-child dom))
(news (plump:make-root))
(current-news))
(block done
(flet ((next-node ()
(setf node (plump:next-sibling node))
(when (null node)
;;(print "DONE")
(return-from done))
node))
(loop
;;(print state)
;;(print node)
(ecase state
(:start
(if (and (plump:element-p node)
(equalp (plump:tag-name node) "h3"))
(setf state :read-news-heading)
;; else
(next-node)))
(:read-news-heading
;; If enough news, exit
(when (= (length (plump:children news)) count)
(return-from done))
;; Start a new one
(setf 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))
(next-node)
(setf state :read-news-content))
(:read-news-content
;; We assume the node is a paragraph and we read its content
(if (and (plump:element-p node)
(equalp (plump:tag-name node) "p"))
(progn
(plump:append-child current-news (shallow-copy-object node))
(next-node)
(setf state :start))
;; else
(next-node)))))))
(plump:serialize news nil))))
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(in-package :cl-site)
;; Copies/renders stylesheets + adds to global context
(defun process-styles ()
(let
((styles-list (mapcar
(lambda (s) (progn
(uiop:copy-file (make-path *STYLES-DIR* s)
(make-path *OUTPUT-DIR* s))
(cons :location s)))
*STYLES*)))
(push (cons :styles styles-list) *GLOBAL-CONTEXT*)))
;; Copies/renders script files + adds to global context
(defun process-scripts () nil)
;; Copies/renders static assets (imgs, etc)
(defun process-static ()
(let ((destination-root (merge-pathnames #P"static/" *output-dir*))
(sources (directory (merge-pathnames "**/*.*" *static-dir*)))
static-list)
(dolist (source sources)
(let* ((relative-path (enough-namestring source *static-dir*))
(destination (merge-pathnames relative-path destination-root)))
(when (pathname-name destination) ;; ignore directories
(ensure-directories-exist destination)
(uiop:copy-file source destination)
(push (cons :location relative-path) static-list))))
(push (cons :static (nreverse static-list))
*global-context*)))
;; process-pages : Copies/renders pages - called last
(defun render-page (page template-path)
(let*
((page-path (make-path *PAGES-DIR* page t))
(output-path (make-path *OUTPUT-DIR* page t))
(page-content (let ((mustache:*load-path* (cons *PAGES-DIR* mustache:*load-path*))
(mustache:*default-pathname-type* "html"))
(mustache:render* page-path)))
(page-context (remove-if (lambda (p) (find p *PRIVATE-KEYS*))
(push (cons :page-content page-content) page) :key 'car)))
(with-open-file (output-stream output-path
:direction :output
:if-exists :supersede)
(let ((mustache:*load-path* (cons *PAGES-DIR* mustache:*load-path*))
(mustache:*default-pathname-type* "html"))
(mustache:render template-path (append page-context *GLOBAL-CONTEXT*)
output-stream)))))
(defun process-pages ()
(format t "Processing pages..~%")
(generate-news)
(let ((template-path (pathname (merge-pathnames *LAYOUT-DIR* *DEFAULT-PAGE-TEMPLATE*))))
(ensure-directories-exist *OUTPUT-DIR*)
(loop for page in *PAGES*
do
(format t "Generating ~A~%" (cdr (assoc :content page)))
(render-page page template-path))
(format t "Done.~%")))
;; Process news
(defparameter +edit-news-link+ "https://gitlab.common-lisp.net/clo/cl-site/edit/master/content/news.md")
(defun generate-news ()
(let ((html
(markdown:parse-file (merge-pathnames "news.md" *PAGES-DIR*))))
(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 Common-Lisp.net 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))))
(defun shallow-copy-object (original)
(let* ((class (class-of original))
(copy (allocate-instance class)))
(dolist (slot (mapcar #'c2mop:slot-definition-name (c2mop:class-slots class)))
(when (slot-boundp original slot)
(setf (slot-value copy slot)
(slot-value original slot))))
copy))
(defun generate-news-box-content (html &key (count 5))
(let ((dom (plump-parser:parse html)))
(let ((state :start)
(node (plump:first-child dom))
(news (plump:make-root))
(current-news))
(block done
(flet ((next-node ()
(setf node (plump:next-sibling node))
(when (null node)
;;(print "DONE")
(return-from done))
node))
(loop
;;(print state)
;;(print node)
(ecase state
(:start
(if (and (plump:element-p node)
(equalp (plump:tag-name node) "h3"))
(setf state :read-news-heading)
;; else
(next-node)))
(:read-news-heading
;; If enough news, exit
(when (= (length (plump:children news)) count)
(return-from done))
;; Start a new one
(setf 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))
(next-node)
(setf state :read-news-content))
(:read-news-content
;; We assume the node is a paragraph and we read its content
(if (and (plump:element-p node)
(equalp (plump:tag-name node) "p"))
(progn
(plump:append-child current-news (shallow-copy-object node))
(next-node)
(setf state :start))
;; else
(next-node)))))))
(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