Assorted cleanups.

src/coleslaw.lisp

@@ -47,6 +47,10 @@
         (update-symlink prev (truename curr)))
       (update-symlink curr new-build))))
 
+(defun update-symlink (path target)
+  "Update the symlink at PATH to point to TARGET."
+  (run-program "ln -sfn ~a ~a" target path))
+
 (defun preview (path &optional (content-type 'post))
   "Render the content at PATH under user's configured repo and save it to
 ~/tmp.html. Load the user's config and theme if necessary."
@@ -58,39 +62,12 @@
            (content (construct content-type (read-content file))))
       (write-file "tmp.html" (render-page content)))))
 
-(defgeneric render-text (text format)
-  (:documentation "Render TEXT of the given FORMAT to HTML for display.")
-  (:method (text (format (eql :html)))
-    text)
-  (:method (text (format (eql :md)))
-    (let ((3bmd-code-blocks:*code-blocks* t))
-      (with-output-to-string (str)
-        (3bmd:parse-string-and-print-to-stream text str)))))
-
-(defun make-pubdate ()
-  "Make a RFC1123 pubdate representing the current time."
-  (local-time:format-rfc1123-timestring nil (local-time:now)))
-
-(defun page-path (object)
-  "The path to store OBJECT at once rendered."
-  (rel-path (staging-dir *config*) (namestring (page-url object))))
-
 (defun render-page (content &optional theme-fn &rest render-args)
-  "Render the given CONTENT to disk using THEME-FN if supplied.
+  "Render the given CONTENT to HTML using THEME-FN if supplied.
 Additional args to render CONTENT can be passed via RENDER-ARGS."
   (funcall (or theme-fn (theme-fn 'base))
            (list :config *config*
                  :content content
                  :raw (apply 'render content render-args)
-                 :pubdate (make-pubdate)
+                 :pubdate (format-rfc1123-timestring nil (local-time:now))
                  :injections (find-injections content))))
-
-(defun write-file (filepath page)
-  "Write the given PAGE to FILEPATH."
-  (ensure-directories-exist filepath)
-  (with-open-file (out filepath
-                   :direction :output
-                   :if-exists :supersede
-                   :if-does-not-exist :create
-                   :external-format '(:utf-8))
-    (write page :stream out :escape nil)))

src/content.lisp

@@ -76,3 +76,12 @@
 (defun by-date (content)
   "Sort CONTENT in reverse chronological order."
   (sort content #'string> :key #'content-date))
+
+(defgeneric render-text (text format)
+  (:documentation "Render TEXT of the given FORMAT to HTML for display.")
+  (:method (text (format (eql :html)))
+    text)
+  (:method (text (format (eql :md)))
+    (let ((3bmd-code-blocks:*code-blocks* t))
+      (with-output-to-string (str)
+        (3bmd:parse-string-and-print-to-stream text str)))))

src/documents.lisp

@@ -5,7 +5,7 @@
 ;; Data Storage
 
 (defvar *site* (make-hash-table :test #'equal)
-  "An in-memory database to hold all site documents, keyed on page-url.")
+  "An in-memory database to hold all site documents, keyed on relative URLs.")
 
 ;; Class Methods
 
@@ -46,20 +46,21 @@
 
 ;; 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)))
+(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*) doc))))
+        (setf (gethash url *site*) document))))
 
 (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))))
-    (write-file (page-path document) html)))
+                  (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."

src/indexes.lisp

@@ -87,5 +87,5 @@
 (defun all-tags ()
   "Retrieve a list of all tags used in content."
   (let* ((dupes (mappend #'content-tags (find-all 'post)))
-         (tags (remove-duplicates dupes :test #'string= :key #'tag-slug)))
+         (tags (remove-duplicates dupes :test #'tag-slug=)))
     (sort tags #'string< :key #'tag-name)))

src/packages.lisp

@@ -7,6 +7,7 @@
                             #:compose)
   (:import-from :cl-fad #:file-exists-p)
   (:import-from :closure-template #:compile-template)
+  (:import-from :local-time #:format-rfc1123-timestring)
   (:export #:main
            #:preview
            #:*config*

src/util.lisp

@@ -82,10 +82,17 @@ If ARGS is provided, use (fmt path args) as the value of PATH."
 use (fmt program args) as the value of PROGRAM."
   (inferior-shell:run (fmt program args) :show t))
 
-(defun update-symlink (path target)
-  "Update the symlink at PATH to point to TARGET."
-  (run-program "ln -sfn ~a ~a" target path))
-
 (defun take-up-to (n seq)
   "Take elements from SEQ until all elements or N have been taken."
   (subseq seq 0 (min (length seq) n)))
+
+(defun write-file (path text)
+  "Write the given TEXT to PATH. PATH is overwritten if it exists and created
+along with any missing parent directories otherwise."
+  (ensure-directories-exist path)
+  (with-open-file (out path
+                   :direction :output
+                   :if-exists :supersede
+                   :if-does-not-exist :create
+                   :external-format '(:utf-8))
+    (write text :stream out :escape nil)))