split up now and blog

3 files changed, 62 insertions, 27 deletions

diff --git a/haunt.scm b/haunt.scm
index f76b1c7..f002287 100644
--- a/haunt.scm
+++ b/haunt.scm
@@ -33,11 +33,11 @@
       '((author . "Henry J. Webster")
         (email . "hwebs@hwebs.info"))
       #:readers (list commonmark-reader xml-reader)
-      #:builders (list (blog #:theme hwebs-theme
+      #:builders (list (blog #:theme hwebs-theme-blog
                              #:collections posts-other
                              #:prefix "blog"
                              #:post-prefix post-prefix)
-                       (blog #:theme hwebs-theme
+                       (blog #:theme hwebs-theme-now
                              #:collections posts-now
                              #:prefix "now")
                        (flat-pages #:template flat-page-template)
diff --git a/reader.scm b/reader.scm
index 3379829..3e86a87 100644
--- a/reader.scm
+++ b/reader.scm
@@ -3,8 +3,10 @@
   #:use-module (haunt post)
   #:use-module (sxml simple)
   #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
   #:export (xml-reader))
 
+;; copied from read-html-post
 (define (read-xml-post port)
   (values (read-metadata-headers port)
           (xml->sxml port)))
diff --git a/theme.scm b/theme.scm
index 4fb23dd..4529f63 100644
--- a/theme.scm
+++ b/theme.scm
@@ -3,34 +3,38 @@
   #:use-module (haunt site)
   #:use-module (haunt post)
   #:use-module (haunt builder blog)
-  #:export (hwebs-theme
+  #:use-module (sxml xpath)
+  #:export (hwebs-theme-blog
+            hwebs-theme-now
             flat-page-template))
 
+(define layout
+  (lambda (site title body)
+    `((doctype "html")
+      (html
+       (head
+        (meta (@ (http-equiv "Content-Type")
+                 (content "text/html")
+                 (charset "utf-8")))
+        (meta (@ (name "viewport")
+                 (content "width=device-width, initial-scale=1.0")))
+        (link (@ (rel "stylesheet")
+                 (type "text/css")
+                 (href "/style.css")))
+        (title ,(string-append title " — " (site-title site))))
+       (body
+        (header (span ,(assq-ref (site-default-metadata site) 'author))
+                (nav (ul (li (a (@ (href "/")) "Home"))
+                         (li (a (@ (href "/now")) "Now"))
+                         (li (a (@ (href "/blog")) "Blog")))))
+        (main
+         (article (h1 ,title)
+                  ,body)))))))
 
-(define hwebs-theme
+
+(define hwebs-theme-blog
   (theme #:name "hwebs"
-         #:layout
-         (lambda (site title body)
-           `((doctype "html")
-             (html
-              (head
-               (meta (@ (http-equiv "Content-Type")
-                        (content "text/html")
-                        (charset "utf-8")))
-               (meta (@ (name "viewport")
-                        (content "width=device-width, initial-scale=1.0")))
-               (link (@ (rel "stylesheet")
-                        (type "text/css")
-                        (href "/style.css")))
-               (title ,(string-append title " — " (site-title site))))
-              (body
-               (header (span ,(assq-ref (site-default-metadata site) 'author))
-                       (nav (ul (li (a (@ (href "/")) "Home"))
-                                (li (a (@ (href "/now")) "Now"))
-                                (li (a (@ (href "/blog")) "Blog")))))
-               (main
-                (article (h1 ,title)
-                         ,body))))))
+         #:layout layout
          #:post-template
          (lambda (post)
            ;; TODO fill in datetime correctly
@@ -50,5 +54,34 @@
                                ,(date->string* (post-date post)))))
                      posts))))))
 
+(define hwebs-theme-now
+  (theme #:name "hwebs-now"
+         #:layout layout
+         #:post-template
+         (lambda (post)
+           ;; TODO fill in datetime correctly
+           ;; TODO add <author>? (as hidden?)
+           `((time ,(date->string*(post-date post)))
+             ,(post-sxml post)))
+         #:collection-template
+         (lambda (site title posts prefix)
+           (define (post-uri post)
+             (string-append "/" (or prefix "") "/"
+                            (site-post-slug site post) ".html"))
+           (define (post-entries post)
+             ((sxpath '(rss channel item title *text*)) (post-sxml post)))
+
+           `(,@(map (lambda (post)
+                      `(section (h2 ,(post-ref post 'title))
+                                ;; TODO only show "See more" if there are more entries than max
+                                ;; + maybe put it at bottom
+                                (a (@ (href ,(post-uri post))) "See more.")
+                                (ul
+                                 ,@(map (lambda (entry-title)
+                                          `(li ,entry-title))
+                                        ;; TODO do this better
+                                        (list-head (post-entries post) (min 5 (length (post-entries post))))))))
+                    posts)))))
+
 (define (flat-page-template site metadata body)
-  ((theme-layout hwebs-theme) site (assq-ref metadata 'title) body))
+  ((theme-layout hwebs-theme-blog) site (assq-ref metadata 'title) body))