coleslaw/src/documents.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 :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)
  "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*)))