src/indexes.lisp (4200 bytes)
1 (in-package :coleslaw) 2 3 (defvar *all-months* nil 4 "The list of months in which content was authored.") 5 (defvar *all-tags* nil 6 "The list of tags which content has been tagged with.") 7 8 (defvar *pages-listings-on-index* 10 9 "Page listings in the index per page.") 10 11 (defclass index () 12 ((url :initarg :url :reader page-url) 13 (name :initarg :name :reader index-name) 14 (title :initarg :title :reader title-of) 15 (content :initarg :content :reader index-content))) 16 17 (defmethod initialize-instance :after ((object index) &key slug) 18 (with-slots (url) object 19 (setf url (compute-url object slug)))) 20 21 (defmethod render ((object index) &key prev next) 22 (funcall (theme-fn 'index) (list :tags (find-all 'tag-index) 23 :months (find-all 'month-index) 24 :config *config* 25 :index object 26 :prev prev 27 :next next))) 28 29 ;;; Index by Tag 30 31 (defclass tag-index (index) ()) 32 33 (defmethod discover ((doc-type (eql (find-class 'tag-index)))) 34 (let ((content (by-date (find-all 'post)))) 35 (dolist (tag *all-tags*) 36 (add-document (index-by-tag tag content))))) 37 38 (defun index-by-tag (tag content) 39 "Return an index of all CONTENT matching the given TAG." 40 (make-instance 'tag-index :slug (tag-slug tag) :name (tag-name tag) 41 :content (remove-if-not (lambda (x) (tag-p tag x)) content) 42 :title (format nil "Content tagged ~a" (tag-name tag)))) 43 44 (defmethod publish ((doc-type (eql (find-class 'tag-index)))) 45 (dolist (index (find-all 'tag-index)) 46 (write-document index))) 47 48 ;;; Index by Month 49 50 (defclass month-index (index) ()) 51 52 (defmethod discover ((doc-type (eql (find-class 'month-index)))) 53 (let ((content (by-date (find-all 'post)))) 54 (dolist (month *all-months*) 55 (add-document (index-by-month month content))))) 56 57 (defun index-by-month (month content) 58 "Return an index of all CONTENT matching the given MONTH." 59 (make-instance 'month-index :slug month :name month 60 :content (remove-if-not (lambda (x) (month-p month x)) content) 61 :title (format nil "Content from ~a" month))) 62 63 (defmethod publish ((doc-type (eql (find-class 'month-index)))) 64 (dolist (index (find-all 'month-index)) 65 (write-document index))) 66 67 ;;; Reverse Chronological Index 68 69 (defclass numeric-index (index) ()) 70 71 (defmethod discover ((doc-type (eql (find-class 'numeric-index)))) 72 (let ((content (by-date (find-all 'post)))) 73 (dotimes (i (ceiling (length content) *pages-listings-on-index*)) 74 (add-document (index-by-n i content))))) 75 76 (defun index-by-n (i content) 77 "Return the index for the Ith page of CONTENT in reverse chronological order." 78 (let ((content (subseq content (* *pages-listings-on-index* i)))) 79 (make-instance 'numeric-index :slug (1+ i) :name (1+ i) 80 :content (take-up-to *pages-listings-on-index* content) 81 :title "Recent Content"))) 82 83 (defmethod publish ((doc-type (eql (find-class 'numeric-index)))) 84 (let ((indexes (sort (find-all 'numeric-index) #'< :key #'index-name))) 85 (loop for (next index prev) on (append '(nil) indexes) 86 while index do (write-document index nil :prev prev :next next)))) 87 88 ;;; Helper Functions 89 90 (defun update-content-metadata () 91 "Set *ALL-TAGS* and *ALL-MONTHS* to the union of all tags and months 92 of content loaded in the DB." 93 (setf *all-tags* (all-tags)) 94 (setf *all-months* (all-months))) 95 96 (defun all-months () 97 "Retrieve a list of all months with published content." 98 (let ((months (loop :for post :in (find-all 'post) 99 :for content-date := (content-date post) 100 :when content-date 101 :collect (subseq content-date 0 102 (min 7 (length content-date)))))) 103 (sort (remove-duplicates months :test #'string=) #'string>))) 104 105 (defun all-tags () 106 "Retrieve a list of all tags used in content." 107 (let* ((dupes (mappend #'content-tags (find-all 'post))) 108 (tags (remove-duplicates dupes :test #'tag-slug=))) 109 (sort tags #'string< :key #'tag-name)))