coleslaw/src/indices.lisp

87 lines
3.6 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 ()
2012-11-28 17:37:19 -05:00
((id :initform nil :initarg :id :accessor index-id)
2012-09-12 11:00:21 -04:00
(posts :initform nil :initarg :posts :accessor index-posts)
(title :initform nil :initarg :title :accessor index-title)))
2012-11-28 17:37:19 -05:00
(defmethod render ((object index) &key prev next)
(funcall (theme-fn 'index) (list :tags (all-tags)
:months (all-months)
:config *config*
2012-11-28 17:37:19 -05:00
:index object
:prev prev
:next next)))
2012-09-12 11:00:21 -04:00
2012-11-28 17:37:19 -05:00
(defclass tag-index (index) ())
(defclass date-index (index) ())
(defclass int-index (index) ())
(defmethod page-path ((object index))
(rel-path (staging *config*) (index-id object)))
(defmethod page-path ((object tag-index))
(rel-path (staging *config*) "tag/~a" (index-id object)))
2012-11-28 17:37:19 -05:00
(defmethod page-path ((object date-index))
(rel-path (staging *config*) "date/~a" (index-id object)))
2012-11-28 17:37:19 -05:00
(defmethod page-path ((object int-index))
(rel-path (staging *config*) "~d" (index-id object)))
2012-11-28 17:37:19 -05:00
(defun all-months ()
2013-01-02 14:23:56 -05:00
"Retrieve a list of all months with published content."
(let ((months (mapcar (lambda (x) (get-month (content-date x)))
(hash-table-values *content*))))
(sort (remove-duplicates months :test #'string=) #'string>)))
(defun all-tags ()
2013-01-02 14:23:56 -05:00
"Retrieve a list of all tags used in content."
2013-04-19 13:32:05 -04:00
(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 get-month (timestamp)
"Extract the YYYY-MM portion of TIMESTAMP."
(subseq timestamp 0 7))
2013-01-02 14:23:56 -05:00
(defun index-by-tag (tag content)
"Return an index of all CONTENT matching the given TAG."
2013-04-19 13:32:05 -04:00
(labels ((tag-slug= (a b)
(string= (tag-slug a) (tag-slug b)))
(valid-p (obj)
(member tag (content-tags obj) :test #'tag-slug=)))
(make-instance 'tag-index :id (tag-slug tag)
2013-04-19 13:32:05 -04:00
:posts (remove-if-not #'valid-p content)
:title (format nil "Posts tagged ~a" (tag-name tag)))))
2011-04-16 15:45:37 -04:00
2013-01-02 14:23:56 -05:00
(defun index-by-month (month content)
"Return an index of all CONTENT matching the given MONTH."
(flet ((valid-p (obj) (search month (content-date obj))))
2012-11-28 17:37:19 -05:00
(make-instance 'date-index :id month
2013-01-29 14:42:48 +00:00
:posts (remove-if-not #'valid-p content)
2012-11-28 17:37:19 -05:00
:title (format nil "Posts from ~a" month))))
2012-09-12 13:37:55 -04:00
2013-01-02 14:23:56 -05:00
(defun index-by-n (i content &optional (step 10))
"Return the index for the Ith page of CONTENT in reverse chronological order."
(let* ((start (* step i))
2013-01-23 12:34:22 -05:00
(end (min (length content) (+ start step))))
(make-instance 'int-index :id (1+ i)
2013-01-23 12:34:22 -05:00
:posts (subseq content start end)
:title "Recent Posts")))
2012-08-20 11:53:39 -04:00
(defun render-indices ()
"Render the indices to view content in groups of size N, by month, and by tag."
(let ((results (by-date (hash-table-values *content*))))
2012-09-12 13:37:55 -04:00
(dolist (tag (all-tags))
(let ((index (index-by-tag tag results)))
2012-11-28 17:37:19 -05:00
(write-page (page-path index) (render-page index))))
2012-09-12 13:37:55 -04:00
(dolist (month (all-months))
(let ((index (index-by-month month results)))
2012-11-28 17:37:19 -05:00
(write-page (page-path index) (render-page index))))
(dotimes (i (ceiling (length results) 10))
(let ((index (index-by-n i results)))
2012-11-28 17:37:19 -05:00
(write-page (page-path index)
(render-page index nil
:prev (and (plusp i) i)
:next (and (< (* (1+ i) 10) (length results))
2012-11-28 17:37:19 -05:00
(+ 2 i)))))))
2012-09-12 13:37:55 -04:00
(update-symlink "index.html" "1.html"))