From 6b600d3ee57f2b6ad4eda1e020d207cbfc1a817f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Mon, 22 Apr 2019 18:33:32 +0200
Subject: Made multi day events appear in HTML.

---
 module/html/html.scm         | 10 ++++++++--
 module/srfi/srfi-41/util.scm | 11 +++++++++++
 2 files changed, 19 insertions(+), 2 deletions(-)

(limited to 'module')

diff --git a/module/html/html.scm b/module/html/html.scm
index d81faaaf..bb964963 100644
--- a/module/html/html.scm
+++ b/module/html/html.scm
@@ -18,9 +18,15 @@
              (stream in-stream))
     (if (stream-null? stream)
         stream-null
-        (let ((day (stream-car days)))
+        (let* ((day (stream-car days))
+               (tomorow (add-day (date->time-utc (drop-time day)))))
           (let ((head (stream-take-while (ein? day) stream))
-                (tail (stream-drop-while (ein? day) stream)))
+                (tail
+                 (filter-sorted-stream*
+                  (lambda (e) (time<? tomorow (attr e 'DTEND)))
+                  (lambda (e) (time<=? tomorow (attr e 'DTSTART)))
+                  stream)))
+
             (stream-cons (cons day head)
                          (loop (stream-cdr days)
                                tail)))))))
diff --git a/module/srfi/srfi-41/util.scm b/module/srfi/srfi-41/util.scm
index 2492d088..56c50ce9 100644
--- a/module/srfi/srfi-41/util.scm
+++ b/module/srfi/srfi-41/util.scm
@@ -26,6 +26,17 @@
    proc (stream-drop-while
          (negate proc) stream)))
 
+(define-public (filter-sorted-stream* pred? keep-remaining? stream)
+  (cond [(stream-null? stream) stream-null]
+        [(keep-remaining? (stream-car stream)) stream]
+        [(pred? (stream-car stream))
+         (stream-cons (stream-car stream)
+                      (filter-sorted-stream*
+                       pred? keep-remaining?
+                       (stream-cdr stream)))]
+        [else (filter-sorted-stream* pred? keep-remaining?
+                                     (stream-cdr stream))]))
+
 (define-public (stream-find pred stream)
   (cond ((stream-null? stream) #f)
         ((pred (stream-car stream)) (stream-car stream))
-- 
cgit v1.2.3