Flexible Lisp Blogware. Fork for personal use. Mirrored from https://github.com/kingcons/coleslaw originally.

indices.lisp 3.1KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677
  1. (in-package :coleslaw)
  2. (defclass index ()
  3. ((id :initform nil :initarg :id :accessor index-id)
  4. (posts :initform nil :initarg :posts :accessor index-posts)
  5. (title :initform nil :initarg :title :accessor index-title)))
  6. (defclass tag-index (index) ())
  7. (defclass date-index (index) ())
  8. (defclass numeric-index (index) ())
  9. (defmethod page-url ((object index))
  10. (index-id object))
  11. (defmethod page-url ((object tag-index))
  12. (format nil "tag/~a" (index-id object)))
  13. (defmethod page-url ((object date-index))
  14. (format nil "date/~a" (index-id object)))
  15. (defmethod page-url ((object numeric-index))
  16. (format nil "~d" (index-id object)))
  17. (defmethod render ((object index) &key prev next)
  18. (funcall (theme-fn 'index) (list :tags (all-tags)
  19. :months (all-months)
  20. :config *config*
  21. :index object
  22. :prev prev
  23. :next next)))
  24. (defun all-months ()
  25. "Retrieve a list of all months with published content."
  26. (let ((months (mapcar (lambda (x) (subseq (content-date x) 0 7))
  27. (hash-table-values *content*))))
  28. (sort (remove-duplicates months :test #'string=) #'string>)))
  29. (defun all-tags ()
  30. "Retrieve a list of all tags used in content."
  31. (let* ((dupes (mappend #'content-tags (hash-table-values *content*)))
  32. (tags (remove-duplicates dupes :test #'string= :key #'tag-slug)))
  33. (sort tags #'string< :key #'tag-name)))
  34. (defun index-by-tag (tag content)
  35. "Return an index of all CONTENT matching the given TAG."
  36. (make-instance 'tag-index :id (tag-slug tag)
  37. :posts (remove-if-not (lambda (x) (tag-p tag x)) content)
  38. :title (format nil "Posts tagged ~a" (tag-name tag))))
  39. (defun index-by-month (month content)
  40. "Return an index of all CONTENT matching the given MONTH."
  41. (make-instance 'date-index :id month
  42. :posts (remove-if-not (lambda (x) (month-p month x)) content)
  43. :title (format nil "Posts from ~a" month)))
  44. (defun index-by-n (i content &optional (step 10))
  45. "Return the index for the Ith page of CONTENT in reverse chronological order."
  46. (let* ((start (* step i))
  47. (end (min (length content) (+ start step))))
  48. (make-instance 'numeric-index :id (1+ i)
  49. :posts (subseq content start end)
  50. :title "Recent Posts")))
  51. (defun render-index (index &rest render-args)
  52. "Render the given INDEX using RENDER-ARGS if provided."
  53. (write-page (page-path index) (apply #'render-page index nil render-args)))
  54. (defun render-indices ()
  55. "Render the indices to view content in groups of size N, by month, and by tag."
  56. (let ((results (by-date (find-all 'post))))
  57. (dolist (tag (all-tags))
  58. (render-index (index-by-tag tag results)))
  59. (dolist (month (all-months))
  60. (render-index (index-by-month month results)))
  61. (dotimes (i (ceiling (length results) 10))
  62. (render-index (index-by-n i results)
  63. :prev (and (plusp i) i)
  64. :next (and (< (* (1+ i) 10) (length results))
  65. (+ 2 i))))))