coleslaw/src/indexes.lisp

92 lines
3.3 KiB
Common Lisp
Raw Normal View History

2011-04-16 15:45:37 -04:00
(in-package :coleslaw)
2012-09-12 11:00:21 -04:00
(defclass index ()
2014-05-07 22:31:06 -04:00
((slug :initarg :slug :reader index-slug)
(title :initarg :title :reader title-of)
2014-05-07 22:31:06 -04:00
(content :initarg :content :reader index-content)))
2012-09-12 11:00:21 -04:00
(defmethod render ((object index) &key prev next)
(funcall (theme-fn 'index) (list :tags (all-tags)
:months (all-months)
:config *config*
:index object
:prev prev
:next next)))
2014-04-15 15:27:46 -04:00
;;; Index by Tag
2014-04-15 15:27:46 -04:00
(defclass tag-index (index) ())
(defmethod discover ((doc-type (eql (find-class 'tag-index))))
(let ((content (by-date (find-all 'post))))
(dolist (tag (all-tags))
(add-document (index-by-tag tag content)))))
2013-01-02 14:23:56 -05:00
(defun index-by-tag (tag content)
"Return an index of all CONTENT matching the given TAG."
2014-04-07 20:54:45 -04:00
(make-instance 'tag-index :slug (tag-slug tag)
2014-04-15 20:30:47 -04:00
:content (remove-if-not (lambda (x) (tag-p tag x)) content)
:title (format nil "Content tagged ~a" (tag-name tag))))
2011-04-16 15:45:37 -04:00
2014-04-15 15:27:46 -04:00
(defmethod publish ((doc-type (eql (find-class 'tag-index))))
(dolist (index (find-all 'tag-index))
(write-document index)))
2014-04-15 15:27:46 -04:00
;;; Index by Month
(defclass month-index (index) ())
(defmethod discover ((doc-type (eql (find-class 'month-index))))
(let ((content (by-date (find-all 'post))))
(dolist (month (all-months))
(add-document (index-by-month month content)))))
2013-01-02 14:23:56 -05:00
(defun index-by-month (month content)
"Return an index of all CONTENT matching the given MONTH."
2014-04-15 15:27:46 -04:00
(make-instance 'month-index :slug month
2014-04-15 20:30:47 -04:00
:content (remove-if-not (lambda (x) (month-p month x)) content)
:title (format nil "Content from ~a" month)))
2012-09-12 13:37:55 -04:00
2014-04-15 15:27:46 -04:00
(defmethod publish ((doc-type (eql (find-class 'month-index))))
(dolist (index (find-all 'month-index))
(write-document index)))
2014-04-15 15:27:46 -04:00
;;; Reverse Chronological Index
(defclass numeric-index (index) ())
(defmethod discover ((doc-type (eql (find-class 'numeric-index))))
(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)
2013-01-02 14:23:56 -05:00
"Return the index for the Ith page of CONTENT in reverse chronological order."
(let ((content (subseq content (* 10 i))))
2014-04-07 20:54:45 -04:00
(make-instance 'numeric-index :slug (1+ i)
2014-04-15 20:30:47 -04:00
:content (take-up-to 10 content)
:title "Recent Content")))
2014-04-15 15:27:46 -04:00
(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))))
(write-document index nil
:prev (when (plusp prev) prev)
:next (when (<= next (length indexes)) next))))))
2014-04-15 15:27:46 -04:00
;;; 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))
2014-04-15 16:46:04 -04:00
(find-all 'post))))
2014-04-15 15:27:46 -04:00
(sort (remove-duplicates months :test #'string=) #'string>)))
(defun all-tags ()
"Retrieve a list of all tags used in content."
2014-04-15 16:46:04 -04:00
(let* ((dupes (mappend #'content-tags (find-all 'post)))
2014-05-01 17:28:51 -04:00
(tags (remove-duplicates dupes :test #'tag-slug=)))
2014-04-15 15:27:46 -04:00
(sort tags #'string< :key #'tag-name)))