Skip to content
Snippets Groups Projects
Commit 754e9fba authored by Erik Huelsmann's avatar Erik Huelsmann
Browse files

Merge branch 'fix-' into 'master'

Integrate static asset deployment into Lisp code

Closes #5

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