First pass at support for multiple content-types. WARNING: Indices and feeds are broken.

coleslaw.asd

@@ -12,12 +12,14 @@
                :local-time
                :inferior-shell
                :cl-fad
-               :cl-ppcre)
+               :cl-ppcre
+               :closer-mop)
   :serial t
   :components ((:file "packages")
                (:file "util")
                (:file "config")
                (:file "themes")
+               (:file "content")
                (:file "posts")
                (:file "indices")
                (:file "feeds")

src/coleslaw.lisp

@@ -49,7 +49,7 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
                        (merge-pathnames "static" (repo *config*))))
       (when (probe-file dir)
         (run-program "cp -R ~a ." dir)))
-    (render-posts)
+    (do-ctypes (publish (class-name ctype)))
     (render-indices)
     (render-feeds (feeds *config*))))
 
@@ -76,7 +76,7 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
   "Load the user's config section corresponding to CONFIG-KEY, then
 compile and deploy the blog."
   (load-config config-key)
-  (load-posts)
+  (load-content)
   (compile-theme (theme *config*))
   (compile-blog (staging *config*))
   (deploy (staging *config*)))

src/content.lisp

@@ -0,0 +1,81 @@
+(in-package :coleslaw)
+
+(defparameter *content* (make-hash-table :test #'equal)
+  "A hash table to store all the site content and metadata.")
+
+(defclass content ()
+  ((tags :initform nil :initarg :tags :accessor content-tags)
+   (slug :initform nil :initarg :slug :accessor content-slug)
+   (date :initform nil :initarg :date :accessor content-date)))
+
+(defun construct (content-type args)
+  "Create an instance of CONTENT-TYPE with the given ARGS."
+  (apply 'make-instance content-type args))
+
+(defgeneric discover (content-type)
+  (:documentation "Load all content of the given CONTENT-TYPE from disk."))
+
+(defgeneric publish (content-type)
+  (:documentation "Write pages to disk for all content of the given CONTENT-TYPE."))
+
+(defun read-content (file &optional plist-p)
+  "Returns two values, a list of metadata from FILE, and the content as a string.
+If PLIST-P is non-nil, a single plist is returned with :content holding the text."
+  (flet ((slurp-remainder (stream)
+           (let ((seq (make-string (- (file-length stream)
+                                      (file-position stream)))))
+             (read-sequence seq stream)
+             (remove #\Nul seq)))
+         (parse-field (str)
+           (nth-value 1 (cl-ppcre:scan-to-strings "[a-zA-Z]+: (.*)" str)))
+         (field-name (line)
+           (make-keyword (string-upcase (subseq line 0 (position #\: line)))))
+         (read-delimited (str &optional (delimiter ", "))
+           (mapcar #'string-downcase (cl-ppcre:split delimiter str))))
+    (with-open-file (in file)
+      (unless (string= (read-line in) ";;;;;")
+        (error "The provided file lacks the expected header."))
+      (let ((meta (loop for line = (read-line in nil)
+                     until (string= line ";;;;;")
+                     appending (list (field-name line)
+                                     (aref (parse-field line) 0))))
+            (content (slurp-remainder in)))
+        (setf (getf meta :tags) (read-delimited (getf meta :tags)))
+        (if plist-p
+            (append meta (list :content content))
+            (values meta content))))))
+
+(defun find-all (content-type)
+  "Return a list of all instances of a given CONTENT-TYPE."
+  (loop for val being the hash-values in *content*
+     when (eql content-type (type-of val)) collect val))
+
+(defun purge-all (content-type)
+  "Remove all instances of CONTENT-TYPE from *content*."
+  (dolist (obj (find-all content-type))
+    (remhash (content-slug obj) *content*)))
+
+(defmacro do-ctypes (&body body)
+  "Iterate over the subclasses of CONTENT performing BODY with ctype lexically
+bound to the current subclass."
+  `(loop for ctype in (closer-mop:class-direct-subclasses (find-class 'content))
+      do ,@body))
+
+(defun load-content ()
+  "Load all content stored in the blog's repo."
+  (do-ctypes (discover (class-name ctype))))
+
+(defun by-date (content)
+  "Sort CONTENT in reverse chronological order."
+  (sort content #'string> :key #'content-date))
+
+(defun slug-char-p (char)
+  "Determine if CHAR is a valid slug (i.e. URL) character."
+  (or (char<= #\0 char #\9)
+      (char<= #\a char #\z)
+      (char<= #\A char #\Z)
+      (member char '(#\_ #\- #\.))))
+
+(defun slugify (string)
+  "Return a version of STRING suitable for use as a URL."
+  (remove-if-not #'slug-char-p (substitute #\- #\Space string)))

src/indices.lisp

@@ -29,25 +29,21 @@
 (defun all-months ()
   "Retrieve a list of all months with published posts."
   (sort (remove-duplicates (mapcar (lambda (x) (get-month (post-date x)))
-                                   (hash-table-values *posts*)) :test #'string=)
+                                   (hash-table-values *content*)) :test #'string=)
         #'string>))
 
 (defun all-tags ()
   "Retrieve a list of all tags used in posts."
-  (sort (remove-duplicates (mappend 'post-tags (hash-table-values *posts*))
+  (sort (remove-duplicates (mappend 'content-tags (hash-table-values *content*))
                            :test #'string=) #'string<))
 
 (defun get-month (timestamp)
   "Extract the YYYY-MM portion of TIMESTAMP."
   (subseq timestamp 0 7))
 
-(defun by-date (posts)
-  "Sort POSTS in reverse chronological order."
-  (sort posts #'string> :key #'post-date))
-
 (defun index-by-tag (tag posts)
   "Return an index of all POSTS matching the given TAG."
-  (let ((content (remove-if-not (lambda (post) (member tag (post-tags post)
+  (let ((content (remove-if-not (lambda (post) (member tag (content-tags post)
                                                        :test #'string=)) posts)))
     (make-instance 'tag-index :id tag
                               :posts content
@@ -71,7 +67,7 @@
 
 (defun render-indices ()
   "Render the indices to view posts in groups of size N, by month, and by tag."
-  (let ((posts (by-date (hash-table-values *posts*))))
+  (let ((posts (by-date (hash-table-values *content*))))
     (dolist (tag (all-tags))
       (let ((index (index-by-tag tag posts)))
         (write-page (page-path index) (render-page index))))

src/posts.lisp

@@ -1,13 +1,7 @@
 (in-package :coleslaw)
 
-(defparameter *posts* (make-hash-table :test #'equal)
+(defclass post (content)
-  "A hash table to store all the posts and their metadata.")
+  ((title :initform nil :initarg :title :accessor post-title)
-
-(defclass post ()
-  ((slug :initform nil :initarg :slug :accessor post-slug)
-   (title :initform nil :initarg :title :accessor post-title)
-   (tags :initform nil :initarg :tags :accessor post-tags)
-   (date :initform nil :initarg :date :accessor post-date)
    (format :initform nil :initarg :format :accessor post-format)
    (content :initform nil :initarg :content :accessor post-content)))
 
@@ -18,59 +12,26 @@
                                   :next next)))
 
 (defmethod page-path ((object post))
-  (rel-path (staging *config*) "posts/~a" (post-slug object)))
+  (rel-path (staging *config*) "posts/~a" (content-slug object)))
 
-(defun read-post (in)
+(defmethod initialize-instance :after ((post post) &key)
-  "Make a POST instance based on the data from the stream IN."
+  (with-accessors ((title post-title)
-  (flet ((check-header ()
+                   (format post-format)
-           (unless (string= (read-line in) ";;;;;")
+                   (content post-content)) post
-             (error "The provided file lacks the expected header.")))
+      (setf (content-slug post) (slugify title)
-         (parse-field (str)
+            format (make-keyword (string-upcase format))
-           (nth-value 1 (cl-ppcre:scan-to-strings "[a-zA-Z]+: (.*)" str)))
+            content (render-content content format))))
-         (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 ()
+(defmethod discover ((content-type (eql :post)))
-  "Read the stored .post files from the repo."
+  (purge-all 'post)
-  (clrhash *posts*)
   (do-files (file (repo *config*) "post")
-    (with-open-file (in file)
+    (let ((post (construct :post (read-content file t))))
-      (let ((post (read-post in)))
+      (if (gethash (content-slug post) *content*)
-        (if (gethash (post-slug post) *posts*)
+          (error "There is already an existing post with the slug ~a."
-            (error "There is already an existing post with the slug ~a."
+                 (content-slug post))
-                   (post-slug post))
+          (setf (gethash (content-slug post) *content*) post)))))
-            (setf (gethash (post-slug post) *posts*) post))))))
 
-(defun render-posts ()
+(defmethod publish ((content-type (eql :post)))
-  "Iterate through the files in the repo to render+write the posts out to disk."
+  (loop for (next post prev) on (append '(nil) (by-date (find-all 'post)))
-  (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)
-      (char<= #\a char #\z)
-      (char<= #\A char #\Z)
-      (member char '(#\_ #\- #\.))))
-
-(defun slugify (string)
-  "Return a version of STRING suitable for use as a URL."
-  (remove-if-not #'slug-char-p (substitute #\- #\Space string)))