From e822f7b81245c919eda8bd8ad4b482df075e0508 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Fri, 24 Jan 2020 20:21:41 +0100
Subject: Start of new date structures.

---
 module/vcomponent/datetime.scm         | 25 +++++++++++------------
 module/vcomponent/group.scm            |  4 ++--
 module/vcomponent/load.scm             |  6 +++---
 module/vcomponent/parse.scm            | 36 +++++++++++++++++++---------------
 module/vcomponent/recurrence/parse.scm |  7 +++----
 5 files changed, 39 insertions(+), 39 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/datetime.scm b/module/vcomponent/datetime.scm
index 5bf829a9..c01de7e7 100644
--- a/module/vcomponent/datetime.scm
+++ b/module/vcomponent/datetime.scm
@@ -1,10 +1,10 @@
 (define-module (vcomponent datetime)
   #:use-module (vcomponent base)
-  #:use-module (srfi srfi-19)
-  #:use-module (srfi srfi-19 util)
+  #:use-module (srfi srfi-19 alt)
+  #:use-module (srfi srfi-19 alt util)
   #:use-module (util)
 
-  #:export (parse-datetime
+  #:export (#;parse-datetime
             event-overlaps?
             overlapping?
             event-contains?
@@ -12,6 +12,7 @@
   )
 
 ;;; date time pointer
+#;
 (define (parse-datetime dtime)
   "Parse the given date[time] string into a date object."
   (string->date
@@ -33,30 +34,26 @@ Event must have the DTSTART and DTEND attribute set."
                       (attr event-b 'DTSTART)
                       (attr event-b 'DTEND)))
 
-(define (event-contains? ev time)
+(define (event-contains? ev datetime)
   "Does event overlap the date that contains time."
-  (let* ((date (time-utc->date time))
-         (start (date->time-utc (drop-time date)))
+  (let* ((start (get-date datetime))
          (end (add-day start)))
     (event-overlaps? ev start end)))
 
-(define (ev-time<? a b)
-  (time<? (attr a 'DTSTART)
-          (attr b 'DTSTART)))
+(define-public (ev-time<? a b)
+  (date/-time<? (attr a 'DTSTART)
+                (attr b 'DTSTART)))
 
 ;; Returns length of the event @var{e}, as a time-duration object.
 (define-public (event-length e)
-  (time-difference
+  (time-
    (attr e 'DTEND)
    (attr e 'DTSTART)))
 
 ;; Returns the length of the part of @var{e} which is within the day
 ;; starting at the time @var{start-of-day}.
 (define-public (event-length/day e start-of-day)
-  (time-difference
+  (time-
    (time-min (add-day start-of-day) (attr e 'DTEND))
    (time-max start-of-day (attr e 'DTSTART))))
 
-(define-public (ev-time<? a b)
-  (time<? (attr a 'DTSTART)
-          (attr b 'DTSTART)))
diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm
index 46160a3a..acf41999 100644
--- a/module/vcomponent/group.scm
+++ b/module/vcomponent/group.scm
@@ -1,8 +1,8 @@
 (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-19 alt)
+  #:use-module (srfi srfi-19 alt util)
   #:use-module (srfi srfi-41)
   #:use-module (srfi srfi-41 util)
   #:export (group-stream get-groups-between))
diff --git a/module/vcomponent/load.scm b/module/vcomponent/load.scm
index 574c1d20..2e69d1f5 100644
--- a/module/vcomponent/load.scm
+++ b/module/vcomponent/load.scm
@@ -2,7 +2,7 @@
   :export (load-calendars load-calendars*)
   :use-module (util)
   :use-module (srfi srfi-1)
-  :use-module (srfi srfi-19)
+  :use-module (srfi srfi-19 alt)
   :use-module (srfi srfi-41)
   :use-module (srfi srfi-41 util)
   :use-module (parameters)
@@ -43,5 +43,5 @@
     ;; 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)))))
+            (sort*! regular   date/-time<? (extract 'DTSTART))
+            (sort*! repeating date/-time<? (extract 'DTSTART)))))
diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm
index c4142910..646d1f72 100644
--- a/module/vcomponent/parse.scm
+++ b/module/vcomponent/parse.scm
@@ -3,9 +3,10 @@
   :use-module (rnrs bytevectors)
   :use-module (srfi srfi-1)
   :use-module (srfi srfi-9)
-  :use-module (srfi srfi-19)
-  :use-module (srfi srfi-19 setters)
-  :use-module (srfi srfi-19 util)
+  :use-module (srfi srfi-19 alt)
+  ;; :use-module (srfi srfi-19 setters)
+  :use-module (srfi srfi-19 alt util)
+  :use-module (srfi srfi-26)
   :use-module ((ice-9 rdelim) :select (read-line))
   :use-module ((ice-9 textual-ports) :select (unget-char))
   :use-module ((ice-9 ftw) :select (scandir ftw))
@@ -14,6 +15,7 @@
   :use-module (util strbuf)
   :use-module (vcomponent base)
   :use-module (vcomponent datetime)
+  :use-module (srfi srfi-19 alt util)
   )
 
 (use-modules ((rnrs base) #:select (assert)))
@@ -147,25 +149,27 @@
                               (when (and (eq? 'VEVENT (type component))
                                          (not (attr component 'DTEND)))
                                 (set! (attr component 'DTEND)
-                                  (add-duration (attr component 'DTSTART)
-                                                (make-duration 3600))))
+                                  (let ((start (attr component 'DTSTART)))
+                                   (if (date? start)
+                                       (date+ start (date day: 1))
+                                       (datetime+ start (datetime time: (time hour: 1)))))))
 
-                              (set! component (parent component))
-                              ]
+                              (set! component (parent component))]
 
                              [else
                               ;; TODO repeated keys
                               (let ((it (make-vline str (get-param-table ctx))))
                                 ;; Type specific processing
                                 (case (get-line-key ctx)
-                                  [(DTSTART DTEND)
-                                   (with-vline-tz
-                                    it
-                                    ;; TODO many of these are way to low
-                                    (mod! (value it) (compose date->time-utc parse-datetime)))]
-                                  [(RECURRENCE-ID)
-                                   (with-vline-tz
-                                    it (mod! (value it) (compose date->time-utc parse-datetime)))])
+                                  [(DTSTART DTEND RECURRENCE-ID)
+
+                                   (let ((v (prop it 'VALUE)))
+                                     (mod! (value it)
+                                           (if (or (and=>> v car (cut string=? <> "DATE-TIME"))
+                                                   (string-contains (value it) "T"))
+                                               parse-datetime parse-date)))]
+
+                                  )
 
 
                                 ;; From RFC 5545 §3.6.1
@@ -298,7 +302,7 @@ row ~a	column ~a	ctx = ~a
 
                      (set! (attr head 'X-HNH-ALTERNATIVES)
                        (sort*! rest ;; HERE
-                               time<? (extract 'RECURRENCE-ID)))
+                               date/-time< (extract 'RECURRENCE-ID)))
                      (add-child! calendar head))])
 
                 ;; return
diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm
index 680a818e..f532987a 100644
--- a/module/vcomponent/recurrence/parse.scm
+++ b/module/vcomponent/recurrence/parse.scm
@@ -4,10 +4,9 @@
   #:export (parse-recurrence-rule)
 
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-19)           ; Datetime
-  #:use-module (srfi srfi-19 util)
+  #:use-module (srfi srfi-19 alt)           ; Datetime
+  #:use-module (srfi srfi-19 alt util)
   #:use-module (srfi srfi-26)
-  #:use-module ((vcomponent datetime) #:select (parse-datetime))
   #:use-module (vcomponent recurrence internal)
   #:use-module (util)
   #:use-module (ice-9 match))
@@ -50,7 +49,7 @@
      (let* (((key val) kv))
        (let-lazy
         ((symb (string->symbol val))
-         (date (date->time-utc (parse-datetime val)))
+         (date (parse-datetime val))
          (days (map parse-day-spec (string-split val #\,)))
          (num  (string->number val))
          (nums (map string->number (string-split val #\,))))
-- 
cgit v1.2.3