2014-04-15 11:28:41 -04:00
|
|
|
(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 page-url.")
|
|
|
|
|
|
|
|
;; 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* ((class-name (class-name doc-type))
|
|
|
|
(file-type (string-downcase (symbol-name class-name))))
|
|
|
|
(do-files (file (repo *config*) file-type)
|
|
|
|
(let ((obj (construct class-name (read-content file))))
|
2014-04-15 15:27:46 -04:00
|
|
|
(add-document obj))))))
|
2014-04-15 11:28:41 -04:00
|
|
|
|
2014-04-15 20:43:56 -04:00
|
|
|
(defmethod discover :before (doc-type)
|
|
|
|
(purge-all (class-name doc-type)))
|
|
|
|
|
2014-04-15 11:28:41 -04:00
|
|
|
;; Instance Methods
|
|
|
|
|
|
|
|
(defgeneric page-url (document)
|
2014-04-16 11:15:29 -04:00
|
|
|
(:documentation "The url to the DOCUMENT without the domain.")
|
|
|
|
(:method (document)
|
|
|
|
(let* ((class-name (class-name (class-of document)))
|
2014-04-29 13:48:52 -04:00
|
|
|
(route (assoc (make-keyword class-name) (routing *config*))))
|
2014-04-16 11:15:29 -04:00
|
|
|
(if route
|
|
|
|
(format nil (second route) (slot-value document 'slug))
|
|
|
|
(error "No routing method found for: ~A" class-name)))))
|
2014-04-15 11:28:41 -04:00
|
|
|
|
|
|
|
(defmethod page-url :around ((document t))
|
|
|
|
(let ((result (call-next-method)))
|
|
|
|
(if (pathname-type result)
|
|
|
|
result
|
|
|
|
(make-pathname :type "html" :defaults result))))
|
|
|
|
|
|
|
|
(defgeneric render (document &key &allow-other-keys)
|
|
|
|
(:documentation "Render the given DOCUMENT to HTML."))
|
2014-04-28 13:55:55 -04:00
|
|
|
|
2014-04-28 14:10:27 -04:00
|
|
|
;; Helper Functions
|
|
|
|
|
|
|
|
(defun add-document (doc)
|
|
|
|
"Add DOC to the in-memory database. Error if a matching entry is present."
|
|
|
|
(let ((url (page-url doc)))
|
|
|
|
(if (gethash url *site*)
|
|
|
|
(error "There is already an existing document with the url ~a" url)
|
|
|
|
(setf (gethash url *site*) doc))))
|
|
|
|
|
2014-04-28 13:55:55 -04:00
|
|
|
(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."
|
2014-04-28 14:09:27 -04:00
|
|
|
(let ((html (if (or theme-fn render-args)
|
2014-04-28 13:55:55 -04:00
|
|
|
(apply #'render-page document theme-fn render-args)
|
|
|
|
(render-page document nil))))
|
2014-04-28 14:12:43 -04:00
|
|
|
(write-file (page-path document) html)))
|
2014-04-28 14:10:27 -04:00
|
|
|
|
|
|
|
(defun find-all (doc-type)
|
|
|
|
"Return a list of all instances of a given DOC-TYPE."
|
|
|
|
(loop for val being the hash-values in *site*
|
|
|
|
when (typep val doc-type) collect val))
|
|
|
|
|
|
|
|
(defun purge-all (doc-type)
|
|
|
|
"Remove all instances of DOC-TYPE from memory."
|
|
|
|
(dolist (obj (find-all doc-type))
|
|
|
|
(remhash (page-url obj) *site*)))
|