From 54bc4d547361a065f283720e6c0aee5fcb9268a8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Tue, 24 Dec 2019 01:06:43 +0100
Subject: ICAL handling of events different from display handling.

Previously repeating events where always instantiated to a stream of all
events to come (possibly infinite), and then zipped with the list of
regular events to create a stream of all events in the world.

This commit allows access to the raw lists of parsed regular and
repeating events before they are extrapolated and merged.
---
 module/entry-points/ical.scm | 12 ++++++------
 module/output/ical.scm       | 18 ++++++++++++------
 module/vcomponent.scm        |  5 +++--
 module/vcomponent/load.scm   | 38 +++++++++++++++++++++++---------------
 4 files changed, 44 insertions(+), 29 deletions(-)

diff --git a/module/entry-points/ical.scm b/module/entry-points/ical.scm
index 99253160..92d0d31c 100644
--- a/module/entry-points/ical.scm
+++ b/module/entry-points/ical.scm
@@ -2,7 +2,7 @@
   :export (main)
   :use-module (util)
   :use-module (output ical)
-  :use-module ((vcomponent) :select (load-calendars))
+  :use-module ((vcomponent) :select (load-calendars*))
   :use-module ((parameters) :select (calendar-files))
   :use-module (ice-9 getopt-long)
   :use-module (srfi srfi-19)
@@ -21,10 +21,10 @@
   (define end   (cond [(option-ref opts 'to  #f) => parse-freeform-date]
                       [else (normalize-date* (set (date-month start) = (+ 1)))]))
 
-  (define-values (calendars events)
-    (load-calendars
-     calendar-files: (cond [(option-ref opts 'file #f) => list]
-                           [else (calendar-files)]) ))
+  ;; TODO this contains repeated events multiple times
+  (define-values (calendars regular repeating)
+    (load-calendars* calendar-files: (cond [(option-ref opts 'file #f) => list]
+                                           [else (calendar-files)]) ))
 
-  (ical-main calendars events start end)
+  (ical-main calendars regular repeating start end)
  )
diff --git a/module/output/ical.scm b/module/output/ical.scm
index 146afc8c..d2f5800c 100644
--- a/module/output/ical.scm
+++ b/module/output/ical.scm
@@ -98,7 +98,8 @@ CALSCALE:GREGORIAN\r
 (define (print-footer)
   (format #t "END:VCALENDAR\r\n"))
 
-(define-public (ical-main calendars events start end)
+;; list x list x list x time x time → 
+(define-public (ical-main calendars regular-events repeating-events start end)
   (print-header)
 
   (let ((tzs (make-hash-table)))
@@ -109,11 +110,16 @@ CALSCALE:GREGORIAN\r
     (hash-for-each (lambda (key component) (component->ical-string component))
                    tzs))
 
-  ;; TODO this contains repeated events multiple times
-  (stream-for-each
+  ;; TODO add support for running without a range limiter, emiting all objects.
+  (for-each
    component->ical-string
-   (filter-sorted-stream (lambda (ev) ((in-date-range? start end)
-                                  (time-utc->date (attr ev 'DTSTART))))
-                         events))
+   (filter-sorted (lambda (ev) ((in-date-range? start end)
+                           (time-utc->date (attr ev 'DTSTART))))
+                  regular-events))
+
+  ;; TODO RECCURENCE-ID exceptions
+  ;; We just dump all repeating objects, since it's much cheaper to do it this way than
+  ;; to actually figure out which are applicable for the given date range.
+  (for-each component->ical-string repeating-events)
 
   (print-footer))
diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index f40756e2..32406f0a 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -3,7 +3,8 @@
   :use-module (vcomponent parse)
   :use-module (vcomponent load)
   :use-module (util)
-  :re-export (make-vcomponent parse-cal-path
-                              parse-calendar load-calendars))
+  :re-export (make-vcomponent
+              parse-cal-path parse-calendar
+              load-calendars load-calendars*))
 
 (re-export-modules (vcomponent base))
diff --git a/module/vcomponent/load.scm b/module/vcomponent/load.scm
index fb25732d..2d339c64 100644
--- a/module/vcomponent/load.scm
+++ b/module/vcomponent/load.scm
@@ -1,5 +1,5 @@
 (define-module (vcomponent load)
-  :export (load-calendars)
+  :export (load-calendars load-calendars*)
   :use-module (util)
   :use-module (srfi srfi-1)
   :use-module (srfi srfi-19)
@@ -13,12 +13,23 @@
   :use-module ((vcomponent datetime) :select (ev-time<?)))
 
 
-;; Reads all calendar files from disk, and creates a list of "regular" events,
-;; and a stream of "repeating" events, which are passed in that order to the
-;; given procedure @var{proc}.
-;;
-;; Given as a sepparate function from main to ease debugging.
+;; Reads all calendar files from disk, generate recurence-sets for all repeating events,
+;; and returns a list of calendars, and a stream of all events "ready" for display.
 (define* (load-calendars #:key (calendar-files (calendar-files)))
+  (let* ((calendars regular repeating (load-calendars* calendar-files: calendar-files)))
+    (values
+     calendars
+     (interleave-streams
+      ev-time<?
+      (cons (list->stream regular)
+            (map generate-recurrence-set repeating))))))
+
+;; Basic version, loads calendrs, sorts the events, and returns
+;; regular and repeating events separated from each other.
+;; 
+;; (list string) → (list calendar), (list event), (list event)
+(define* (load-calendars* #:key (calendar-files (calendar-files)))
+
   (define calendars (map parse-cal-path calendar-files))
   (define events (concatenate
                   ;; TODO does this drop events?
@@ -28,12 +39,9 @@
 
   (let* ((repeating regular (partition repeating? events)))
 
-    (set! repeating (sort*! repeating time<? (extract 'DTSTART))
-          regular   (sort*! regular   time<? (extract 'DTSTART)))
-
-    (values
-     calendars
-     (interleave-streams
-      ev-time<?
-      (cons (list->stream regular)
-            (map generate-recurrence-set repeating))))))
+    ;; NOTE There might be instances where we don't care if the
+    ;; collection if sorted, but for the time beieng it's much
+    ;; easier to always sort it.
+    (values calendars
+            (sort*! regular   time<? (extract 'DTSTART))
+            (sort*! repeating time<? (extract 'DTSTART)))))
-- 
cgit v1.2.3