Generalize DO-CTYPES to DO-SUBCLASSES, update callsites.

src/coleslaw.lisp

@@ -55,7 +55,8 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
                        (merge-pathnames "static" (repo *config*))))
       (when (probe-file dir)
         (run-program "rsync --delete -raz ~a ." dir)))
-    (do-ctypes (publish (make-keyword ctype)))
+    (do-subclasses (ctype content)
+      (publish (make-keyword ctype)))
     (render-indexes (feeds *config*))
     (update-symlink "index.html" "1.html")))
 

src/content.lisp

@@ -70,7 +70,7 @@
 (defun discover (content-type)
   "Load all content of the given CONTENT-TYPE from disk."
   (purge-all content-type)
-  (let ((file-type (string-downcase (princ-to-string content-type))))
+  (let ((file-type (string-downcase (symbol-name content-type))))
     (do-files (file (repo *config*) file-type)
       (let ((obj (construct content-type (read-content file))))
         (if (gethash (content-slug obj) *content*)
@@ -78,16 +78,10 @@
                    (content-slug obj))
             (setf (gethash (content-slug obj) *content*) obj))))))
 
-(defmacro do-ctypes (&body body)
-  "Iterate over the subclasses of CONTENT performing BODY with ctype lexically
-bound to the current subclass."
-  (alexandria:with-gensyms (ctypes)
-    `(let ((,ctypes (closer-mop:class-direct-subclasses (find-class 'content))))
-       (loop for ctype in (mapcar #'class-name ,ctypes) do ,@body))))
-
 (defun load-content ()
   "Load all content stored in the blog's repo."
-  (do-ctypes (discover ctype)))
+  (do-subclasses (ctype content)
+    (discover ctype)))
 
 (defun by-date (content)
   "Sort CONTENT in reverse chronological order."

src/util.lisp

@@ -4,6 +4,13 @@
   "Create an instance of CLASS-NAME with the given ARGS."
   (apply 'make-instance class-name args))
 
+(defmacro do-subclasses ((var class) &body body)
+  "Iterate over the subclasses of CLASS performing BODY with VAR
+lexically bound to the current subclass' class-name."
+  (alexandria:with-gensyms (klasses)
+    `(let ((,klasses (closer-mop:class-direct-subclasses (find-class ',class))))
+       (loop for ,var in (mapcar #'class-name ,klasses) do ,@body))))
+
 (defun fmt (fmt-str args)
   "A convenient FORMAT interface for string building."
   (apply 'format nil fmt-str args))