1.0, why not

1 files changed, 95 insertions, 0 deletions

@@ -0,0 +1,95 @@
+(declare (module (boudin page index))
+         (export make-index
+                 index-template
+                 index-writer
+                 make-feed
+                 feed-template
+                 feed-writer))
+
+(import (boudin page)
+        (boudin page write)
+        (boudin site)
+        (chicken pathname)
+        (html-parser)
+        (sxml-serializer)
+        (rename (atom)
+                (make-feed atom/make-feed)))
+
+(define (make-index pgs)
+  (make-page ((index-template) pgs)
+             (make-pathname (site-output) "index.html")
+             page-content
+             (index-writer)
+             `()))
+
+(define index-writer
+  (make-parameter
+   sxml-display-as-html))
+
+(define index-template
+  (make-parameter
+   (lambda (pgs)
+     `(html (@ (lang "en-us"))
+            (head ,@(html-head)
+                  (title ,(site-name)))
+            (body (h1 ,(site-name))
+                  (ul ,@(map (lambda (pg)
+                               `(li (a (@ (href ,(page-slug pg)))
+                                       ,(or (page-ref pg "title")
+                                            (page-slug pg)))))
+                             ((site-sort) pgs))))))))
+
+(define (make-feed pgs)
+  (make-page ((feed-template) pgs)
+             (make-pathname (site-output) "feed.xml")
+             page-content
+             (feed-writer)
+             `()))
+
+(define feed-writer
+  (make-parameter
+   (lambda (sxml)
+     (serialize-sxml sxml
+                     output: (current-output-port)
+                     cdata-section-elements: '(atom:content)
+                     ns-prefixes:
+                     `((*default* . "http://www.w3.org/2005/Atom")
+                       (*default* . "http://www.w3.org/1999/xhtml")
+                       ,@(atom-ns-prefixes))
+                     allow-prefix-redeclarations: #t))))
+
+(define feed-template
+  (make-parameter
+   (lambda (pgs)
+     (make-atom-doc
+      (atom/make-feed
+       title: (make-title (site-name))
+       id: (site-host)
+       updated: (site-build-time)
+       authors: (list (make-author name: (site-author)
+                                   uri: (site-host)))
+       links: (list (make-link type: 'html
+                               uri-language: "en"
+                               uri: (site-host))
+                    (make-link relation: "self"
+                               type: "application/atom+xml"
+                               uri: (make-pathname
+                                     (site-host) "feed" "xml")))
+       rights: (make-rights (force (site-rights)))
+       generator: (make-generator "Boudin"
+                                  uri: "https://git.acdw.net/boudin"
+                                  version: "rice")
+       entries: (map (lambda (pg)
+                       (make-entry
+                        title: (make-title
+                                (or (page-ref pg "title") "[untitled]"))
+                        links: (list (make-link type: 'html
+                                                uri: (page-url pg)))
+                        id: (page-url pg)
+                        updated: (page-updated pg)
+                        ;;published:
+                        content: (make-content
+                                  (sxml->html
+                                   (page-content pg))
+                                  type: 'html)))
+                     ((site-sort) pgs)))))))