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)
-  (:documentation "Render the given CONTENT to HTML."))
+(defgeneric render (object &key &allow-other-keys)
+  (: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
-                 (post (format nil "posts/~a.html" (post-slug content)))
-                 (index (index-path content))))
-         (filepath (merge-pathnames path (staging *config*)))
-         (page (funcall (theme-fn (or theme-fn 'base))
-                        (list :config *config*
-                              :content content
-                              :raw (apply 'render content render-args)
-                              :pubdate (make-pubdate)
-                              :injections (find-injections content)))))
-    (ensure-directories-exist filepath)
-    (with-open-file (out filepath
-                     :direction :output
-                     :if-does-not-exist :create)
-      (write-line page out))))
+  (funcall (theme-fn (or theme-fn 'base))
+           (list :config *config*
+                 :content content
+                 :raw (apply 'render content render-args)
+                 :pubdate (make-pubdate)
+                 :injections (find-injections content))))
+
+(defun write-page (filepath page)
+  "Write the given PAGE to FILEPATH."
+  (ensure-directories-exist filepath)
+  (with-open-file (out filepath
+                   :direction :output
+                   :if-does-not-exist :create)
+    (write-line page out)))
 
 (defun compile-blog (staging)
   "Compile the blog to a STAGING directory as specified in .coleslawrc."

src/posts.lisp

@@ -11,38 +11,14 @@
    (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)))
 
-(defun load-posts ()
-  "Read the stored .post files from the repo."
-  (clrhash *posts*)
-  (do-files (file (repo *config*) "post")
-    (with-open-file (in file)
-      (let ((post (read-post in)))
-        (if (gethash (post-slug post) *posts*)
-            (error "There is already an existing post with the slug ~a."
-                   (post-slug post))
-            (setf (gethash (post-slug post) *posts*) post))))))
-
-(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*)
-                                                       #'string< :key #'post-date))
-       while post do (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))))
+(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."
@@ -51,6 +27,8 @@
              (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 ()
@@ -58,11 +36,9 @@
              (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))
+    (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)))))
-      (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
@@ -70,6 +46,24 @@
                                                          (getf args :format))
                                 :slug (slugify (getf args :title))))))))
 
+(defun load-posts ()
+  "Read the stored .post files from the repo."
+  (clrhash *posts*)
+  (do-files (file (repo *config*) "post")
+    (with-open-file (in file)
+      (let ((post (read-post in)))
+        (if (gethash (post-slug post) *posts*)
+            (error "There is already an existing post with the slug ~a."
+                   (post-slug post))
+            (setf (gethash (post-slug post) *posts*) post))))))
+
+(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*)
+                                                     #'string< :key #'post-date))
+     while post do (write-page (page-path post)
+                               (render-page post nil :prev prev :next next))))
+
 (defun slug-char-p (char)
   "Determine if CHAR is a valid slug (i.e. URL) character."
   (or (char<= #\0 char #\9)

src/util.lisp

@@ -1,9 +1,13 @@
 (in-package :coleslaw)
 
-(defun app-path (path &rest args)
-  "Take a relative PATH and return the corresponding pathname beneath coleslaw.
+(defun rel-path (base path &rest args)
+  "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,