WARNING: This commit breaks indices and feeds.

Factor write-page from render-page. Reorganization to allow for new content types.

src/coleslaw.lisp

@@ -1,26 +1,37 @@
 (in-package :coleslaw)
 
-(defgeneric render (content &key &allow-other-keys)
+(defgeneric render (object &key &allow-other-keys)
-  (:documentation "Render the given CONTENT to HTML."))
+  (:documentation "Render the given OBJECT to HTML."))
+
+(defgeneric render-content (text format)
+  (:documentation "Compile TEXT from the given FORMAT to HTML for display.")
+  (:method (text (format (eql :html)))
+    text)
+  (:method (test (format (eql :md)))
+    (let ((3bmd-code-blocks:*code-blocks* t))
+      (with-output-to-string (str)
+        (3bmd:parse-string-and-print-to-stream text str)))))
+
+(defgeneric page-path (content)
+  (:documentation "The path to store CONTENT at once rendered."))
 
 (defun render-page (content &optional theme-fn &rest render-args)
   "Render the given CONTENT to disk using THEME-FN if supplied.
 Additional args to render CONTENT can be passed via RENDER-ARGS."
-  (let* ((path (etypecase content
+  (funcall (theme-fn (or theme-fn 'base))
-                 (post (format nil "posts/~a.html" (post-slug content)))
+           (list :config *config*
-                 (index (index-path content))))
+                 :content content
-         (filepath (merge-pathnames path (staging *config*)))
+                 :raw (apply 'render content render-args)
-         (page (funcall (theme-fn (or theme-fn 'base))
+                 :pubdate (make-pubdate)
-                        (list :config *config*
+                 :injections (find-injections content))))
-                              :content content
+
-                              :raw (apply 'render content render-args)
+(defun write-page (filepath page)
-                              :pubdate (make-pubdate)
+  "Write the given PAGE to FILEPATH."
-                              :injections (find-injections content)))))
+  (ensure-directories-exist filepath)
-    (ensure-directories-exist filepath)
+  (with-open-file (out filepath
-    (with-open-file (out filepath
+                   :direction :output
-                     :direction :output
+                   :if-does-not-exist :create)
-                     :if-does-not-exist :create)
+    (write-line page out)))
-      (write-line page out))))
 
 (defun compile-blog (staging)
   "Compile the blog to a STAGING directory as specified in .coleslawrc."

src/posts.lisp

@@ -11,12 +11,41 @@
    (format :initform nil :initarg :format :accessor post-format)
    (content :initform nil :initarg :content :accessor post-content)))
 
-(defmethod render ((content post) &key prev next)
+(defmethod render ((object post) &key prev next)
   (funcall (theme-fn 'post) (list :config *config*
-                                  :post content
+                                  :post object
                                   :prev prev
                                   :next next)))
 
+(defmethod page-path ((post post))
+  (rel-path (staging *config*) "posts/~a.html" (post-slug post)))
+
+(defun read-post (in)
+  "Make a POST instance based on the data from the stream IN."
+  (flet ((check-header ()
+           (unless (string= (read-line in) ";;;;;")
+             (error "The provided file lacks the expected header.")))
+         (parse-field (str)
+           (nth-value 1 (cl-ppcre:scan-to-strings "[a-zA-Z]+: (.*)" str)))
+         (field-name (line)
+           (subseq line 0 (position #\: line)))
+         (read-tags (str)
+           (mapcar #'string-downcase (cl-ppcre:split ", " str)))
+         (slurp-remainder ()
+           (let ((seq (make-string (- (file-length in) (file-position in)))))
+             (read-sequence seq in)
+             (remove #\Nul seq))))
+    (check-header)
+    (let ((args (loop for line = (read-line in nil) until (string= line ";;;;;")
+                   appending (list (make-keyword (string-upcase (field-name line)))
+                                   (aref (parse-field line) 0)))))
+      (setf (getf args :tags) (read-tags (getf args :tags))
+            (getf args :format) (make-keyword (string-upcase (getf args :format))))
+      (apply 'make-instance 'post
+             (append args (list :content (render-content (slurp-remainder)
+                                                         (getf args :format))
+                                :slug (slugify (getf args :title))))))))
+
 (defun load-posts ()
   "Read the stored .post files from the repo."
   (clrhash *posts*)
@@ -30,45 +59,10 @@
 
 (defun render-posts ()
   "Iterate through the files in the repo to render+write the posts out to disk."
-    (loop for (prev post next) on (append '(nil) (sort (hash-table-values *posts*)
+  (loop for (prev post next) on (append '(nil) (sort (hash-table-values *posts*)
-                                                       #'string< :key #'post-date))
+                                                     #'string< :key #'post-date))
-       while post do (render-page post nil :prev prev :next next)))
+     while post do (write-page (page-path post)
-
+                               (render-page post nil :prev prev :next next))))
-(defgeneric render-content (text format)
-  (:documentation "Compile TEXT from the given FORMAT to HTML for display.")
-  (:method (text (format (eql :html)))
-    text))
-
-(defmethod render-content (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 read-post (in)
-  "Make a POST instance based on the data from the stream IN."
-  (flet ((check-header ()
-           (unless (string= (read-line in) ";;;;;")
-             (error "The provided file lacks the expected header.")))
-         (parse-field (str)
-           (nth-value 1 (cl-ppcre:scan-to-strings "[a-zA-Z]+: (.*)" str)))
-         (read-tags (str)
-           (mapcar #'string-downcase (cl-ppcre:split ", " str)))
-         (slurp-remainder ()
-           (let ((seq (make-string (- (file-length in) (file-position in)))))
-             (read-sequence seq in)
-             (remove #\Nul seq))))
-    (check-header)
-    (let ((args (loop for field in '("title" "tags" "date" "format")
-                   for line = (read-line in nil)
-                   appending (list (make-keyword (string-upcase field))
-                                   (aref (parse-field line) 0)))))
-      (check-header)
-      (setf (getf args :tags) (read-tags (getf args :tags))
-            (getf args :format) (make-keyword (string-upcase (getf args :format))))
-      (apply 'make-instance 'post
-             (append args (list :content (render-content (slurp-remainder)
-                                                         (getf args :format))
-                                :slug (slugify (getf args :title))))))))
 
 (defun slug-char-p (char)
   "Determine if CHAR is a valid slug (i.e. URL) character."

src/util.lisp

@@ -1,9 +1,13 @@
 (in-package :coleslaw)
 
-(defun app-path (path &rest args)
+(defun rel-path (base path &rest args)
-  "Take a relative PATH and return the corresponding pathname beneath coleslaw.
+  "Take a relative PATH and return the corresponding pathname beneath BASE.
 If ARGS is provided, use (apply 'format nil PATH ARGS) as the value of PATH."
-  (merge-pathnames (apply 'format nil path args) coleslaw-conf:*basedir*))
+  (merge-pathnames (apply 'format nil path args) base))
+
+(defun app-path (path &rest args)
+  "Return a relative path beneath coleslaw."
+  (apply 'rel-path coleslaw-conf:*basedir* path args))
 
 (defun run-program (program &rest args)
   "Take a PROGRAM and execute the corresponding shell command. If ARGS is provided,