From 83a67e536a6320bcbcee4a66359131ebac42c66f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Mon, 22 Apr 2019 12:33:01 +0200
Subject: Limit HTML output to single week.

---
 module/html/html.scm         | 13 ++++++++++++-
 module/srfi/srfi-19/util.scm | 11 +++++++++++
 2 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/module/html/html.scm b/module/html/html.scm
index 51de18aa..93977106 100644
--- a/module/html/html.scm
+++ b/module/html/html.scm
@@ -1,6 +1,7 @@
 (define-module (html html)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-41)
+  #:use-module (srfi srfi-41 util)
   #:use-module (vcalendar)
   #:use-module (vcalendar datetime)
   #:use-module (util)
@@ -92,6 +93,9 @@ never on absolute times. For that see date->decimal-hour"
                ,(string-append time ":00")))
        (map number->string (iota 12 0 2))))
 
+(define (d str)
+  (string->date str "~Y-~m-~d"))
+
 (define-public (html-main calendars events)
   `(html (head
           (title "Calendar")
@@ -111,5 +115,12 @@ never on absolute times. For that see date->decimal-hour"
                     ,@(time-marker-div)
                     (div (@ (class "days"))
                          ,@(stream->list
-                            (stream-take 2000 (stream-map lay-out-day (group-stream events)))))))))
+                            (stream-map
+                             lay-out-day
+                             (filter-sorted-stream
+                              (compose (in-date-range?
+                                        (d "2019-04-15")
+                                        (d "2019-04-22"))
+                                       car)
+                              (group-stream events)))))))))
 
diff --git a/module/srfi/srfi-19/util.scm b/module/srfi/srfi-19/util.scm
index 928f9abb..f9453820 100644
--- a/module/srfi/srfi-19/util.scm
+++ b/module/srfi/srfi-19/util.scm
@@ -100,3 +100,14 @@ attribute set to 0. Can also be seen as \"Start of day\""
      (set! (day d) (1+ (day d)))
      (normalize-date d))
    start-day))
+
+(define-public (in-date-range? start-date end-date)
+  (format (current-error-port) "Start: ~a~%End: ~a~%"
+          (date->string start-date) (date->string end-date))
+  (lambda (date)
+    (format (current-error-port) "Date: ~a~%"
+            (date->string date "~1"))
+    (let ((time (date->time-utc date)))
+      (timespan-overlaps?
+       (date->time-utc start-date) (date->time-utc end-date)
+       time time))))
-- 
cgit v1.2.3