From 1bc8f0c31fd94b3936fc13ed325ecd8308d73f87 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sat, 5 Oct 2019 23:51:50 +0200
Subject: Fix day-stream, and in effect terminal output.

---
 module/output/terminal.scm   | 5 ++++-
 module/srfi/srfi-19/util.scm | 6 +++---
 module/util.scm              | 3 +++
 module/vcomponent/group.scm  | 8 +++++---
 4 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/module/output/terminal.scm b/module/output/terminal.scm
index a2c5486e..37fe1b86 100644
--- a/module/output/terminal.scm
+++ b/module/output/terminal.scm
@@ -62,10 +62,12 @@
 
   (define-values (height width) (get-terminal-size))
 
+  (define grouped-stream (group-stream event-stream))
+
   (while #t
     ;; TODO reusing the same grouping causes it to lose events.
     ;; I currently have no idea why, but it's BAD.
-    (let ((groups (get-groups-between (group-stream event-stream)
+    (let ((groups (get-groups-between grouped-stream
                                       (time-utc->date time) (time-utc->date time))))
       (format (current-error-port) "len(groups) = ~a~%" (stream-length groups))
       (let ((events
@@ -157,5 +159,6 @@
     (let ((time (date->time-utc
                  (drop-time (or (and=> (option-ref opts 'date #f) parse-freeform-date)
                                 (current-date))))))
+      ;; (format (current-error-port) "len(events) = ~a~%" (stream-length events))
       (with-vulgar
        (lambda () (main-loop time events))))))
diff --git a/module/srfi/srfi-19/util.scm b/module/srfi/srfi-19/util.scm
index 2e969f6e..4155b263 100644
--- a/module/srfi/srfi-19/util.scm
+++ b/module/srfi/srfi-19/util.scm
@@ -108,9 +108,9 @@ attribute set to 0. Can also be seen as \"Start of day\""
 (define-public (day-stream start-day)
   (stream-iterate
    (lambda (d)
-     (mod! (day d) = (+ 1))
-     (set! d (drop-time (normalize-date* d)))
-     d)
+     (drop-time
+      (normalize-date*
+       (set (date-day d) = (+ 1)))))
    (drop-time start-day)))
 
 (define-public (in-date-range? start-date end-date)
diff --git a/module/util.scm b/module/util.scm
index 6aadbc79..707cba90 100644
--- a/module/util.scm
+++ b/module/util.scm
@@ -363,6 +363,9 @@
      (-> (func obj) rest ...)]))
 
 
+;; Non-destructive set, syntax extension from set-fields from (srfi
+;; srfi-9 gnu). Also doubles as a non-destructive mod!, if the `='
+;; operator is used.
 (define-syntax set
   (syntax-rules (=)
     [(set (acc obj)  value)
diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm
index 41123126..7733d981 100644
--- a/module/vcomponent/group.scm
+++ b/module/vcomponent/group.scm
@@ -5,7 +5,7 @@
   #:use-module (srfi srfi-19 util)
   #:use-module (srfi srfi-41)
   #:use-module (srfi srfi-41 util)
-  #:export (group-stream))
+  #:export (group-stream get-groups-between))
 
 ;; TODO templetize this
 (define-stream (group-stream in-stream)
@@ -16,7 +16,8 @@
     (if (stream-null? stream)
         stream-null
         (let* ((day (stream-car days))
-               (tomorow (add-day (date->time-utc (drop-time day)))))
+               (tomorow (date->time-utc (stream-car (stream-cdr days)))))
+
           (let ((head (stream-take-while (ein? day) stream))
                 (tail
                  (filter-sorted-stream*
@@ -24,11 +25,12 @@
                   (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)
+(define (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)
-- 
cgit v1.2.3