Quellcode durchsuchen

Cleanups to feeds.

Brit Butler vor 12 Jahren
Ursprung
Commit
0e6edb7211
3 geänderte Dateien mit 33 neuen und 21 gelöschten Zeilen
  1. 4 0
      src/content.lisp
  2. 28 17
      src/feeds.lisp
  3. 1 4
      src/indices.lisp

+ 4 - 0
src/content.lisp

@@ -11,6 +11,10 @@
11 11
   "Takes a string and returns a TAG instance with a name and slug."
12 12
   (make-instance 'tag :name (string-trim " " str) :slug (slugify str)))
13 13
 
14
+(defun tag-slug= (a b)
15
+  "Test if the slugs for tag A and B are equal."
16
+  (string= (tag-slug a) (tag-slug b)))
17
+
14 18
 (defclass content ()
15 19
   ((tags :initform nil :initarg :tags :accessor content-tags)
16 20
    (slug :initform nil :initarg :slug :accessor content-slug)

+ 28 - 17
src/feeds.lisp

@@ -4,20 +4,31 @@
4 4
   "Make a RFC1123 pubdate representing the current time."
5 5
   (local-time:format-rfc1123-timestring nil (local-time:now)))
6 6
 
7
-(defun render-feeds (feeds)
8
-  "Render and write the given FEEDS for the site."
9
-  (flet ((first-10 (list)
10
-           (subseq list 0 (min (length list) 10))))
11
-    (let* ((by-date (by-date (find-all 'post)))
12
-           (posts (first-10 by-date))
13
-           (rss (make-instance 'index :id "rss.xml" :posts posts))
14
-           (atom (make-instance 'index :id "feed.atom" :posts posts))
15
-           (rss-template (theme-fn :rss-feed "feeds"))
16
-           (atom-template (theme-fn :atom-feed "feeds")))
17
-      (write-page (page-path rss) (render-page rss rss-template))
18
-      (write-page (page-path atom) (render-page atom atom-template))
19
-      (dolist (feed feeds)
20
-        (let ((index (index-by-tag (make-tag feed) by-date)))
21
-          (setf (index-id index) (format nil "~a-rss.xml" feed)
22
-                (index-posts index) (first-10 (index-posts index)))
23
-          (write-page (page-path index) (render-page index rss-template)))))))
7
+(defun first-10 (list)
8
+  "Get up to the first 10 items in LIST."
9
+  (subseq list 0 (min (length list) 10)))
10
+
11
+(defun make-tag-feed (tag posts)
12
+  "Make an RSS feed for the given TAG and POSTS."
13
+  (flet ((valid-p (obj) (member tag (content-tags obj) :test #'tag-slug=)))
14
+    (make-instance 'tag-index :id (format nil "~A-rss.xml" (tag-slug tag))
15
+                   :posts (first-10 (remove-if-not #'valid-p posts)))))
16
+
17
+(defun render-feed (posts &key path template tag)
18
+  "Given a PATH, TEMPLATE, and possibly a TAG, render the appropriate feed."
19
+  (let ((template (theme-fn template "feeds"))
20
+        (index (if tag
21
+                   (make-tag-feed tag posts)
22
+                   (make-instance 'index :id path
23
+                                  :posts (first-10 posts)))))
24
+    (write-page (page-path index) (render-page index template))))
25
+
26
+(defun render-feeds (tag-feeds)
27
+  "Render the default RSS and ATOM feeds along with any TAG-FEEDS."
28
+  (let ((posts (by-date (find-all 'post))))
29
+    (dolist (feed '((:path "rss.xml" :template :rss-feed)
30
+                    (:path "feed.atom" :template :atom-feed)))
31
+      (apply #'render-feed posts feed))
32
+    (dolist (feed tag-feeds)
33
+      (apply #'render-feed posts (list :tag (make-tag feed)
34
+                                       :template :rss-feed)))))

+ 1 - 4
src/indices.lisp

@@ -44,10 +44,7 @@
44 44
 
45 45
 (defun index-by-tag (tag content)
46 46
   "Return an index of all CONTENT matching the given TAG."
47
-  (labels ((tag-slug= (a b)
48
-             (string= (tag-slug a) (tag-slug b)))
49
-           (valid-p (obj)
50
-             (member tag (content-tags obj) :test #'tag-slug=)))
47
+  (flet ((valid-p (obj) (member tag (content-tags obj) :test #'tag-slug=)))
51 48
     (make-instance 'tag-index :id (tag-slug tag)
52 49
                    :posts (remove-if-not #'valid-p content)
53 50
                    :title (format nil "Posts tagged ~a" (tag-name tag)))))