7ba1e0d16a
Index-ext was a bit of a kludge used to support symlinking the index.html rather than due to any real need for indexes to have different extensions than other documents. Instead of an empty string to indicate no extension, we will use nil. We hardcode "index.html" and use the first numeric-index's page-url to not make assumptions about the user's routing scheme.
84 lines
3.1 KiB
Common Lisp
84 lines
3.1 KiB
Common Lisp
(in-package :coleslaw)
|
|
|
|
;;;; The Document Protocol
|
|
|
|
;; Data Storage
|
|
|
|
(defvar *site* (make-hash-table :test #'equal)
|
|
"An in-memory database to hold all site documents, keyed on relative URLs.")
|
|
|
|
;; Class Methods
|
|
|
|
(defgeneric publish (doc-type)
|
|
(:documentation "Write pages to disk for all documents of the given DOC-TYPE."))
|
|
|
|
(defgeneric discover (doc-type)
|
|
(:documentation "Load all documents of the given DOC-TYPE into memory.")
|
|
(:method (doc-type)
|
|
(let ((file-type (format nil "~(~A~)" (class-name doc-type))))
|
|
(do-files (file (repo-dir *config*) file-type)
|
|
(let ((obj (construct (class-name doc-type) (read-content file))))
|
|
(add-document obj))))))
|
|
|
|
(defmethod discover :before (doc-type)
|
|
(purge-all (class-name doc-type)))
|
|
|
|
;; Instance Methods
|
|
|
|
(defgeneric page-url (document)
|
|
(:documentation "The relative URL to the DOCUMENT."))
|
|
|
|
(defgeneric render (document &key &allow-other-keys)
|
|
(:documentation "Render the given DOCUMENT to HTML."))
|
|
|
|
;; Helper Functions
|
|
|
|
(defun compute-url (document unique-id &optional class)
|
|
"Compute the relative URL for a DOCUMENT based on its UNIQUE-ID. If CLASS
|
|
is provided, it overrides the route used."
|
|
(let* ((class-name (or class (class-name (class-of document))))
|
|
(route (get-route class-name)))
|
|
(unless route
|
|
(error "No routing method found for: ~A" class-name))
|
|
(let* ((result (format nil route unique-id))
|
|
(type (or (pathname-type result) (page-ext *config*))))
|
|
(make-pathname :name (funcall (name-fn *config*) (pathname-name result))
|
|
:type type
|
|
:defaults result))))
|
|
|
|
(defun get-route (doc-type)
|
|
"Return the route format string for DOC-TYPE."
|
|
(second (assoc (make-keyword doc-type) (routing *config*))))
|
|
|
|
(defun add-document (document)
|
|
"Add DOCUMENT to the in-memory database. Error if a matching entry is present."
|
|
(let ((url (page-url document)))
|
|
(if (gethash url *site*)
|
|
(error "There is already an existing document with the url ~a" url)
|
|
(setf (gethash url *site*) document))))
|
|
|
|
(defun delete-document (document)
|
|
"Given a DOCUMENT, delete it from the in-memory database."
|
|
(remhash (page-url document) *site*))
|
|
|
|
(defun write-document (document &optional theme-fn &rest render-args)
|
|
"Write the given DOCUMENT to disk as HTML. If THEME-FN is present,
|
|
use it as the template passing any RENDER-ARGS."
|
|
(let ((html (if (or theme-fn render-args)
|
|
(apply #'render-page document theme-fn render-args)
|
|
(render-page document nil)))
|
|
(url (namestring (page-url document))))
|
|
(write-file (rel-path (staging-dir *config*) url) html)))
|
|
|
|
(defun find-all (doc-type &optional (matches-p (lambda (x) (typep x doc-type))))
|
|
"Return a list of all instances of a given DOC-TYPE."
|
|
(loop for val being the hash-values in *site*
|
|
when (funcall matches-p val) collect val))
|
|
|
|
(defun purge-all (doc-type)
|
|
"Remove all instances of DOC-TYPE from memory."
|
|
(flet ((matches-class-name-p (x)
|
|
(class-name-p (symbol-name doc-type)
|
|
(class-of x))))
|
|
(dolist (obj (find-all doc-type #'matches-class-name-p))
|
|
(remhash (page-url obj) *site*))))
|