break haunt.scm down into smaller (bandali *) modules

[~bandali/bndl.org] / bandali / feeds.scm

diff --git a/bandali/feeds.scm b/bandali/feeds.scm
new file mode 100644 (file)
index 0000000..07678fc
--- /dev/null
+++ b/bandali/feeds.scm
@@ -0,0 +1,71 @@
+;;; Copyright © 2019 Amin Bandali <bandali@gnu.org>
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation; either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (bandali feeds)
+  #:use-module (haunt builder atom)     ; atom-feed
+  #:use-module (haunt builder rss)      ; rss-feed
+  #:use-module (haunt post)             ; post-*
+  #:use-module (ice-9 match)            ; match-lambda
+  #:re-export (atom-feed
+               rss-feed)
+  #:export (atom-feeds-by-tag
+            rss-feeds-by-tag))
+
+(define* (atom-feeds-by-tag #:key
+                            (prefix "feeds/tags")
+                            (filter posts/reverse-chronological)
+                            (max-entries 20)
+                            (blog-prefix ""))
+  "Return a builder procedure that renders an atom feed for every tag
+used in a post.  All arguments are optional:
+
+PREFIX: The directory in which to write the feeds
+FILTER: The procedure called to manipulate the posts list before rendering
+MAX-ENTRIES: The maximum number of posts to render in each feed"
+  (lambda (site posts)
+    (let ((tag-groups (posts/group-by-tag posts)))
+      (map (match-lambda
+            ((tag . posts)
+             ((atom-feed #:file-name (string-append prefix "/" tag ".atom")
+                         #:subtitle (string-append "Tag: " tag)
+                         #:filter filter
+                         #:max-entries max-entries
+                         #:blog-prefix blog-prefix)
+              site posts)))
+           tag-groups))))
+
+(define* (rss-feeds-by-tag #:key
+                           (prefix "feeds/tags")
+                           (filter posts/reverse-chronological)
+                           (max-entries 20)
+                           (blog-prefix ""))
+  "Return a builder procedure that renders an rss feed for every tag
+used in a post.  All arguments are optional:
+
+PREFIX: The directory in which to write the feeds
+FILTER: The procedure called to manipulate the posts list before rendering
+MAX-ENTRIES: The maximum number of posts to render in each feed"
+  (lambda (site posts)
+    (let ((tag-groups (posts/group-by-tag posts)))
+      (map (match-lambda
+            ((tag . posts)
+             ((rss-feed #:file-name (string-append prefix "/" tag ".rss")
+                        #:subtitle (string-append "Tag: " tag)
+                        #:filter filter
+                        #:max-entries max-entries
+                        #:blog-prefix blog-prefix)
+              site posts)))
+           tag-groups))))