From f575740684715d3de606b37f114d4f215c66c797 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Wed, 22 May 2019 22:04:50 +0200
Subject: Add support for events without DTEND set.

---
 module/util.scm       | 22 ++++++++++++++++++++++
 module/vcomponent.scm | 26 +++++++++++++++++++-------
 2 files changed, 41 insertions(+), 7 deletions(-)

diff --git a/module/util.scm b/module/util.scm
index c41b8061..89f6dab6 100644
--- a/module/util.scm
+++ b/module/util.scm
@@ -2,6 +2,7 @@
   #:use-module (srfi srfi-1)
   #:use-module ((ice-9 optargs) #:select (define*-public))
   #:use-module ((sxml fold) #:select (fold-values))
+  #:use-module (srfi srfi-9 gnu)
   #:export (for define-quick-record
                 mod! sort* sort*!
                 mod/r! set/r!
@@ -10,6 +11,7 @@
                 quote?
                 re-export-modules
                 use-modules*
+                -> set
                 tree-map let-lazy)
   #:replace (let* set! define-syntax
                   when unless if))
@@ -342,3 +344,23 @@
               (map (lambda (sub) (list (car form) sub))
                    (cadr form)))
             forms))))
+
+
+
+(define-syntax ->
+  (syntax-rules ()
+    [(-> obj) obj]
+    [(-> obj (func args ...) rest ...)
+     (-> (func obj args ...) rest ...)]
+    [(-> obj func rest ...)
+     (-> (func obj) rest ...)]))
+
+
+(define-syntax set
+  (syntax-rules (=)
+    [(set (acc obj)  value)
+     (set-fields
+      obj ((acc) value))]
+    [(set (acc obj) = (op rest ...))
+     (set-fields
+      obj ((acc) (op (acc obj) rest ...)))]))
diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index b628c11a..cc79b646 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -32,23 +32,35 @@
 
        ;; TZSET is the generated recurrence set of a timezone
        (set! (attr tz 'X-HNH-TZSET)
-             (make-tz-set tz)))
+             (make-tz-set tz)
+             #;
+             ((@ (srfi srfi-41) stream)
+              (list
+               (car (children tz))
+               (cadr (children tz))))
+             ))
 
   (for ev in (children cal 'VEVENT)
-       (define date     (parse-datetime (attr ev 'DTSTART)))
-       (define end-date (parse-datetime (attr ev 'DTEND)))
+       (define dptr (attr* ev 'DTSTART))
+       (define eptr (attr* ev 'DTEND))
 
-       (set! (attr ev "DTSTART") (date->time-utc date)
-             (attr ev "DTEND")   (date->time-utc end-date))
+       (define date     (parse-datetime (value dptr)))
+       (define end-date
+         (if (value eptr)
+             (parse-datetime (value eptr))
+             (set (date-hour date) = (+ 1))))
+
+       (set! (value dptr) (date->time-utc date)
+             (value eptr) (date->time-utc end-date))
 
        (when (prop (attr* ev 'DTSTART) 'TZID)
          (set! (zone-offset date) (get-tz-offset ev)
-               (attr ev 'DTSTART) (date->time-utc date)
+               (value dptr) (date->time-utc date)
 
                ;; The standard says that DTEND must have the same
                ;; timezone as DTSTART. Here we trust that blindly.
                (zone-offset end-date) (zone-offset date)
-               (attr ev 'DTEND) (date->time-utc end-date)))))
+               (value eptr) (date->time-utc end-date)))))
 
 
 ;; (define-public value caar)
-- 
cgit v1.2.3