Massive indexes rewrite.

docs/hacking.md

@@ -42,7 +42,7 @@ template, and their inclusion in an INDEX is presently ad-hoc.
 // TODO: Write something about class-names as file-extension/eql-specializers!
 ### Current Content Types & Indexes
 
-There are 5 INDEX subclasses at present: TAG-INDEX, DATE-INDEX,
+There are 5 INDEX subclasses at present: TAG-INDEX, MONTH-INDEX,
 NUMERIC-INDEX, FEED, and TAG-FEED. Respectively, they support
 grouping content by tags, publishing date, and reverse chronological
 order. Feeds exist to special case RSS and ATOM generation.
@@ -71,6 +71,7 @@ loaded. These functions take a property list (or plist) as an argument
 and return rendered HTML.  **Coleslaw** defines a helper called
 `theme-fn` for easy access to the template functions.
 
+// TODO: Update for changes to compile-blog, indexes refactor, etc.
 ### The Lifecycle of a Page
 
 - `(load-content)`
@@ -84,6 +85,7 @@ from each matching file and inserted into the `*content*` hash-table.
 
 - `(compile-blog dir)`
 
+
 Compilation starts by ensuring the staging directory (`/tmp/coleslaw/`
 by default) exists, cd'ing there, and copying over any necessary theme
 assets. Then *coleslaw* iterates over the content types, calling the

plugins/mathjax.lisp

@@ -4,10 +4,8 @@
   (:import-from :coleslaw #:add-injection
                           #:content
                           #:index
-                          #:content-tags
-                          #:index-posts
-                          #:make-tag
-                          #:tag-slug=))
+                          #:tag-p
+                          #:index-posts))
 
 (in-package :coleslaw-mathjax)
 
@@ -19,7 +17,8 @@
 (defun enable (&key force config (preset "TeX-AMS-MML_HTMLorMML")
                  (location "http://cdn.mathjax.org/mathjax/latest/MathJax.js"))
   (labels ((math-post-p (obj)
-             (member (make-tag "math") (content-tags obj) :test #'tag-slug=))
+             ;; Would it be better to test against latex than math, here?
+             (tag-p "math" obj))
            (mathjax-p (obj)
              (or force
                  (etypecase obj

src/coleslaw.lisp

@@ -1,37 +1,20 @@
 (in-package :coleslaw)
 
-(defgeneric render-content (text format)
-  (:documentation "Compile TEXT from 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 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.
-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)
-                 :injections (find-injections content))))
+(defun main (&optional config-key)
+  "Load the user's config file, then compile and deploy the site."
+  (load-config config-key)
+  (load-content)
+  (compile-theme (theme *config*))
+  (let ((dir (staging-dir *config*)))
+    (compile-blog dir)
+    (deploy dir)))
 
-(defun write-page (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-line page out)))
+(defun load-content ()
+  "Load all content stored in the blog's repo."
+  (do-subclasses (ctype content)
+    (discover ctype))
+  (do-subclasses (itype index)
+    (discover itype)))
 
 (defun compile-blog (staging)
   "Compile the blog to a STAGING directory as specified in .coleslawrc."
@@ -44,8 +27,9 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
       (when (probe-file dir)
         (run-program "rsync --delete -raz ~a ." dir)))
     (do-subclasses (ctype content)
-      (publish (make-keyword ctype)))
-    (render-indexes (feeds *config*))
+      (publish ctype))
+    (do-subclasses (itype index)
+      (publish itype))
     (update-symlink "index.html" "1.html")))
 
 (defgeneric deploy (staging)
@@ -63,15 +47,6 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
         (update-symlink prev (truename curr)))
       (update-symlink curr new-build))))
 
-(defun main (&optional config-key)
-  "Load the user's config file, then compile and deploy the site."
-  (load-config config-key)
-  (load-content)
-  (compile-theme (theme *config*))
-  (let ((dir (staging-dir *config*)))
-    (compile-blog dir)
-    (deploy dir)))
-
 (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."
@@ -82,3 +57,36 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
     (let* ((file (rel-path (repo *config*) path))
            (content (construct content-type (read-content file))))
       (write-page "tmp.html" (render-page content)))))
+
+(defgeneric render-content (text format)
+  (:documentation "Compile TEXT from 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 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.
+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)
+                 :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-exists :supersede
+                   :if-does-not-exist :create
+                   :external-format '(:utf-8))
+    (write-line page out)))

src/content.lisp

@@ -21,7 +21,8 @@
 
 (defun tag-p (tag obj)
   "Test if OBJ is tagged with TAG."
-  (member tag (content-tags obj) :test #'tag-slug=))
+  (let ((tag (if (typep tag 'tag) tag (make-tag tag))))
+    (member tag (content-tags obj) :test #'tag-slug=)))
 
 (defun month-p (month obj)
   "Test if OBJ was written in MONTH."
@@ -51,11 +52,6 @@
         (setf (getf meta :tags) (read-tags (getf meta :tags)))
         (append meta (list :text content))))))
 
-(defun load-content ()
-  "Load all content stored in the blog's repo."
-  (do-subclasses (ctype content)
-    (discover ctype)))
-
 (defun by-date (content)
   "Sort CONTENT in reverse chronological order."
   (sort content #'string> :key #'content-date))

src/documents.lisp

@@ -7,6 +7,13 @@
 (defvar *site* (make-hash-table :test #'equal)
   "An in-memory database to hold all site documents, keyed on page-url.")
 
+(defun add-document (doc)
+  "Add DOC to the in-memory database. If a matching entry is present, error."
+  (let ((url (page-url doc)))
+    (if (gethash url *site*)
+        (error "There is already an existing document with the url ~a" url)
+        (setf (gethash url *site*) doc))))
+
 ;; Class Methods
 
 (defun find-all (doc-type)
@@ -25,15 +32,12 @@
 (defgeneric discover (doc-type)
   (:documentation "Load all documents of the given DOC-TYPE into memory.")
   (:method (doc-type)
-    (purge-all doc-type)
     (let* ((class-name (class-name doc-type))
            (file-type (string-downcase (symbol-name class-name))))
+      (purge-all class-name)
       (do-files (file (repo *config*) file-type)
         (let ((obj (construct class-name (read-content file))))
-          (if (gethash (page-url obj) *site*)
-              (error "There is already existing content with the url ~a."
-                     (page-url obj))
-              (setf (gethash (page-url obj) *site*) obj)))))))
+          (add-document obj))))))
 
 ;; Instance Methods
 

src/indexes.lisp

@@ -5,27 +5,6 @@
    (posts :initform nil :initarg :posts :accessor index-posts)
    (title :initform nil :initarg :title :accessor index-title)))
 
-(defclass tag-index (index) ())
-(defclass date-index (index) ())
-(defclass numeric-index (index) ())
-
-(defclass feed (index)
-  ((format :initform nil :initarg :format :accessor feed-format)))
-;; TODO: tag-feed isn't reached by do-subclasses!
-(defclass tag-feed (feed) ())
-
-(defmethod page-url ((object tag-index))
-  (format nil "tag/~a" (index-slug object)))
-(defmethod page-url ((object date-index))
-  (format nil "date/~a" (index-slug object)))
-(defmethod page-url ((object numeric-index))
-  (format nil "~d" (index-slug object)))
-
-(defmethod page-url ((object feed))
-  (format nil "~(~a~).xml" (feed-format object)))
-(defmethod page-url ((object tag-feed))
-  (format nil "tag/~a~(~a~).xml" (index-slug object) (feed-format object)))
-
 (defmethod render ((object index) &key prev next)
   (funcall (theme-fn 'index) (list :tags (all-tags)
                                    :months (all-months)
@@ -34,17 +13,18 @@
                                    :prev prev
                                    :next next)))
 
-(defun all-months ()
-  "Retrieve a list of all months with published content."
-  (let ((months (mapcar (lambda (x) (subseq (content-date x) 0 7))
-                        (hash-table-values *content*))))
-    (sort (remove-duplicates months :test #'string=) #'string>)))
+;;; Index by Tag
 
-(defun all-tags ()
-  "Retrieve a list of all tags used in content."
-  (let* ((dupes (mappend #'content-tags (hash-table-values *content*)))
-         (tags (remove-duplicates dupes :test #'string= :key #'tag-slug)))
-    (sort tags #'string< :key #'tag-name)))
+(defclass tag-index (index) ())
+
+(defmethod page-url ((object tag-index))
+  (format nil "tag/~a" (index-slug object)))
+
+(defmethod discover ((doc-type (eql (find-class 'tag-index))))
+  (purge-all (class-name doc-type))
+  (let ((content (by-date (find-all 'post))))
+    (dolist (tag (all-tags))
+      (add-document (index-by-tag tag content)))))
 
 (defun index-by-tag (tag content)
   "Return an index of all CONTENT matching the given TAG."
@@ -52,12 +32,46 @@
                  :posts (remove-if-not (lambda (x) (tag-p tag x)) content)
                  :title (format nil "Posts tagged ~a" (tag-name tag))))
 
+(defmethod publish ((doc-type (eql (find-class 'tag-index))))
+  (dolist (index (find-all 'tag-index))
+    (render-index index)))
+
+;;; Index by Month
+
+(defclass month-index (index) ())
+
+(defmethod page-url ((object month-index))
+  (format nil "date/~a" (index-slug object)))
+
+(defmethod discover ((doc-type (eql (find-class 'month-index))))
+  (purge-all (class-name doc-type))
+  (let ((content (by-date (find-all 'post))))
+    (dolist (month (all-months))
+      (add-document (index-by-month month content)))))
+
 (defun index-by-month (month content)
   "Return an index of all CONTENT matching the given MONTH."
-  (make-instance 'date-index :slug month
+  (make-instance 'month-index :slug month
                  :posts (remove-if-not (lambda (x) (month-p month x)) content)
                  :title (format nil "Posts from ~a" month)))
 
+(defmethod publish ((doc-type (eql (find-class 'month-index))))
+  (dolist (index (find-all 'month-index))
+    (render-index index)))
+
+;;; Reverse Chronological Index
+
+(defclass numeric-index (index) ())
+
+(defmethod page-url ((object numeric-index))
+  (format nil "~d" (index-slug object)))
+
+(defmethod discover ((doc-type (eql (find-class 'numeric-index))))
+  (purge-all (class-name doc-type))
+  (let ((content (by-date (find-all 'post))))
+    (dotimes (i (ceiling (length content) 10))
+      (add-document (index-by-n i content)))))
+
 (defun index-by-n (i content)
   "Return the index for the Ith page of CONTENT in reverse chronological order."
   (let ((content (subseq content (* 10 i))))
@@ -65,6 +79,66 @@
                    :posts (take-up-to 10 content)
                    :title "Recent Posts")))
 
+(defmethod publish ((doc-type (eql (find-class 'numeric-index))))
+  (let ((indexes (sort (find-all 'numeric-index) #'< :key #'index-slug)))
+    (dolist (index indexes)
+      (let ((prev (1- (index-slug index)))
+            (next (1+ (index-slug index))))
+        (render-index index :prev (when (plusp prev) prev)
+                            :next (when (<= next (length indexes)) next))))))
+
+;;; Atom and RSS Feeds
+
+(defclass feed (index)
+  ((format :initform nil :initarg :format :accessor feed-format)))
+
+(defmethod page-url ((object feed))
+  (format nil "~(~a~).xml" (feed-format object)))
+
+(defmethod discover ((doc-type (eql (find-class 'feed))))
+  (let ((content (take-up-to 10 (by-date (find-all 'post)))))
+    (dolist (format '(rss atom))
+      (let ((feed (make-instance 'feed :posts content :format format)))
+        (add-document feed)))))
+
+(defmethod publish ((doc-type (eql (find-class 'feed))))
+  (dolist (feed (find-all 'feed))
+    (render-feed feed)))
+
+;; TODO: tag-feed isn't reached by do-subclasses!
+(defclass tag-feed (feed) ())
+
+(defmethod page-url ((object tag-feed))
+  (format nil "tag/~a~(~a~).xml" (index-slug object) (feed-format object)))
+
+(defmethod discover ((doc-type (eql (find-class 'tag-feed))))
+  (let ((content (by-date (find-all 'post))))
+    (dolist (tag (feeds *config*))
+      (let ((posts (remove-if-not (lambda (x) (tag-p tag x)) content)))
+        (dolist (format '(rss atom))
+          (let ((feed (make-instance 'tag-feed :posts (take-up-to 10 posts)
+                                     :format format
+                                     :slug tag)))
+            (add-document feed)))))))
+
+(defmethod publish ((doc-type (eql (find-class 'tag-feed))))
+  (dolist (feed (find-all 'tag-feed))
+    (render-feed feed)))
+
+;;; Helper Functions
+
+(defun all-months ()
+  "Retrieve a list of all months with published content."
+  (let ((months (mapcar (lambda (x) (subseq (content-date x) 0 7))
+                        (hash-table-values *content*))))
+    (sort (remove-duplicates months :test #'string=) #'string>)))
+
+(defun all-tags ()
+  "Retrieve a list of all tags used in content."
+  (let* ((dupes (mappend #'content-tags (hash-table-values *content*)))
+         (tags (remove-duplicates dupes :test #'string= :key #'tag-slug)))
+    (sort tags #'string< :key #'tag-name)))
+
 (defun render-feed (feed)
   "Render the given FEED to both RSS and ATOM."
   (let ((theme-fn (theme-fn (feed-format feed) "feeds")))
@@ -73,25 +147,3 @@
 (defun render-index (index &rest render-args)
   "Render the given INDEX using RENDER-ARGS if provided."
   (write-page (page-path index) (apply #'render-page index nil render-args)))
-
-(defun render-indexes (tag-feeds)
-  "Render the indexes to view content in groups of size N, by month, or by tag,
-along with RSS and ATOM feeds and any supplied TAG-FEEDS."
-  (let ((content (by-date (find-all 'post))))
-    (dolist (tag (all-tags))
-      (render-index (index-by-tag tag content)))
-    (dolist (month (all-months))
-      (render-index (index-by-month month content)))
-    (dotimes (i (ceiling (length content) 10))
-      (render-index (index-by-n i content)
-                    :prev (and (plusp i) i)
-                    :next (and (< (* (1+ i) 10) (length content))
-                               (+ 2 i))))
-    (dolist (format '(rss atom))
-      (dolist (tag tag-feeds)
-        (let ((posts (remove-if-now (lambda (x) (tag-p (make-tag tag) x)) content)))
-          (render-feed (make-instance 'tag-feed :posts (take-up-to 10 posts)
-                                      :format format
-                                      :slug tag))))
-      (render-feed (make-instance 'feed :posts (take-up-to 10 content)
-                                  :format format)))))

src/posts.lisp

@@ -24,7 +24,7 @@
 (defmethod page-url ((object post))
   (format nil "~a/~a" (posts-dir *config*) (content-slug object)))
 
-(defmethod publish ((content-type (eql :post)))
+(defmethod publish ((doc-type (eql (find-class 'post))))
   (loop for (next post prev) on (append '(nil) (by-date (find-all 'post)))
      while post do (write-page (page-path post)
                                (render-page post nil :prev prev :next next))))