From b6d956cc7bc9772302a04b4d609fee664b57a6e3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Thu, 25 Apr 2019 19:05:21 +0200
Subject: Move group-stream, add helper methods.

---
 module/output/html.scm | 28 ++--------------------------
 1 file changed, 2 insertions(+), 26 deletions(-)

(limited to 'module/output')

diff --git a/module/output/html.scm b/module/output/html.scm
index 34363367..22958d0e 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -3,6 +3,7 @@
   #:use-module (srfi srfi-41)
   #:use-module (srfi srfi-41 util)
   #:use-module (vcomponent)
+  #:use-module (vcomponent group)
   #:use-module (vcomponent datetime)
   #:use-module (util)
   #:use-module (util tree)
@@ -15,26 +16,6 @@
   #:use-module (parameters)
   #:use-module (config))
 
-(define-stream (group-stream in-stream)
-  (define (ein? day) (lambda (e) (event-in? e (date->time-utc day))))
-
-  (let loop ((days (day-stream (time-utc->date (attr (stream-car in-stream) 'DTSTART))))
-             (stream in-stream))
-    (if (stream-null? stream)
-        stream-null
-        (let* ((day (stream-car days))
-               (tomorow (add-day (date->time-utc (drop-time day)))))
-          (let ((head (stream-take-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)))))))
-
 (define x-pos (make-object-property))
 (define width (make-object-property))
 
@@ -140,12 +121,7 @@
   (define start (parse-freeform-date (option-ref opts 'from "2019-04-15")))
   (define end   (parse-freeform-date (option-ref opts 'to   "2019-05-10")))
 
-  (define evs
-    (filter-sorted-stream
-     ;; TODO in-date-range? drops the first date
-     (compose (in-date-range? start end)
-              car)
-     (group-stream events)))
+  (define evs (get-groups-between (group-stream events)))
 
   ((@ (sxml simple) sxml->xml)
    `(html (head
-- 
cgit v1.2.3