From 394df06bb40acf307baaedca59778d12e27d6dac Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sun, 10 Nov 2019 23:53:50 +0100
Subject: Fix next and prev month buttons.

---
 module/output/html.scm       | 14 +++++++++-----
 module/srfi/srfi-19/util.scm | 13 +++++++++++--
 2 files changed, 20 insertions(+), 7 deletions(-)

(limited to 'module')

diff --git a/module/output/html.scm b/module/output/html.scm
index b3adefd6..cd983955 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -265,12 +265,16 @@
                             `(span "Version " (a (@ (href ,url)) ,hash)))))
                 (aside (@ (class "sideinfo"))
                        (div (@ (class "about"))
-                            (div (@ (class "nav"))
-                                 (a (@ (href "#")) "«"))
+                            (a (@ (href ,(date->string (set (date-month start) = (- 1)) "~Y-~m-~d") ".html")
+                                  (class "nav hidelink"))
+                               (div (@ (class "nav"))
+                                    "«"))
                             (div ,(cal-table (start-of-month start)
                                              (current-date)))
-                            (div (@ (class "nav"))
-                                 (a (@ (href "#")) "»")))
+                            (a (@ (href ,(date->string (set (date-month start) = (+ 1)) "~Y-~m-~d") ".html")
+                                  (class "nav hidelink"))
+                               (div (@ (class "nav"))
+                                    "»")))
                        (div (@ (class "eventlist"))
                             ,@(stream->list (stream-map fmt-day evs)))))))))
 
@@ -297,7 +301,7 @@
                             (let ((ms (month-stream start)))
                               (stream-take
                                12 (stream-zip
-                                   ms (stream-map (lambda (d) (normalize-date**
+                                   ms (stream-map (lambda (d) (normalize-date
                                                           (set (date-day d) = (- 1))))
                                                   (stream-cdr ms))))
                               )))
diff --git a/module/srfi/srfi-19/util.scm b/module/srfi/srfi-19/util.scm
index e4439da5..09900bf2 100644
--- a/module/srfi/srfi-19/util.scm
+++ b/module/srfi/srfi-19/util.scm
@@ -120,7 +120,7 @@ attribute set to 0. Can also be seen as \"Start of day\""
   (set (date-second next-date) 0))
 
 ;; date x (date → date) → stream<date>
-(define (date-increment-stream start-date transfer-proc)
+(define (date-increment-stream* start-date transfer-proc)
   (stream-iterate
    (lambda (d)
      (drop-time
@@ -130,9 +130,18 @@ attribute set to 0. Can also be seen as \"Start of day\""
        (set (date-hour (transfer-proc d)) = (+ 1)))))
    (drop-time start-date)))
 
+;; Just dropping timezones seems to work when we are dealing with months...
+(define (date-increment-stream start-date transfer-proc)
+  (stream-iterate
+   (lambda (d)
+     (drop-time
+      (normalize-date
+       (transfer-proc d))))
+   (drop-time start-date)))
+
 ;; Returns a stream of date objects, one day appart, staring from start-day.
 (define-public (day-stream start-day)
-  (date-increment-stream start-day (lambda (d) (set (date-day d) = (+ 1)))))
+  (date-increment-stream* start-day (lambda (d) (set (date-day d) = (+ 1)))))
 
 (define-public (month-stream start-date)
   (date-increment-stream start-date (lambda (d) (set (date-month d) = (+ 1)))))
-- 
cgit v1.2.3