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 ++--------------------------
 module/vcomponent/group.scm | 39 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 41 insertions(+), 26 deletions(-)
 create mode 100644 module/vcomponent/group.scm

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
diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm
new file mode 100644
index 00000000..c5b6948e
--- /dev/null
+++ b/module/vcomponent/group.scm
@@ -0,0 +1,39 @@
+(define-module (vcomponent group)
+  #:use-module (vcomponent)
+  #:use-module (vcomponent datetime)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-19 util)
+  #:use-module (srfi srfi-41)
+  #:use-module (srfi srfi-41 util)
+  #:export (group-stream))
+
+(define-stream (group-stream in-stream)
+  (define (ein? day) (lambda (e) (event-contains? 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-public (get-groups-between groups start-date end-date)
+  (filter-sorted-stream
+   ;; TODO in-date-range? drops the first date
+   (compose (in-date-range? start-date end-date)
+            car)
+   groups))
+
+
+(define-public (group->event-list group)
+  (stream->list (cdr group)))
-- 
cgit v1.2.3