Once again compiles.

8 files changed, 86 insertions, 41 deletions

diff --git a/module/vcomponent/datetime.scm b/module/vcomponent/datetime.scm
index c01de7e7..765c065d 100644
--- a/module/vcomponent/datetime.scm
+++ b/module/vcomponent/datetime.scm
@@ -34,9 +34,9 @@ Event must have the DTSTART and DTEND attribute set."
                       (attr event-b 'DTSTART)
                       (attr event-b 'DTEND)))
 
-(define (event-contains? ev datetime)
+(define (event-contains? ev date/-time)
   "Does event overlap the date that contains time."
-  (let* ((start (get-date datetime))
+  (let* ((start (as-date date/-time))
          (end (add-day start)))
     (event-overlaps? ev start end)))
 
@@ -52,8 +52,14 @@ Event must have the DTSTART and DTEND attribute set."
 
 ;; 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)
+;; currently the secund argument is a date, but should possibly be changed
+;; to a datetime to allow for more explicit TZ handling?
+(define-public (event-length/day e)
   (time-
-   (time-min (add-day start-of-day) (attr e 'DTEND))
-   (time-max start-of-day (attr e 'DTSTART))))
+   (time-min #00:00:00 (as-time (attr e 'DTEND)))
+   (time-max #24:00:00 (as-time (attr e 'DTSTART)))))
 
+
+;; 22:00 - 03:00
+;; 2h för dag 1
+;; 3h för dag 2
diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm
index acf41999..83d79f9a 100644
--- a/module/vcomponent/group.scm
+++ b/module/vcomponent/group.scm
@@ -9,14 +9,14 @@
 
 ;; TODO templetize this
 (define-stream (group-stream in-stream)
-  (define (ein? day) (lambda (e) (event-contains? e (date->time-utc day))))
+  (define (ein? day) (lambda (e) (event-contains? e day)))
 
-  (let loop ((days (day-stream (time-utc->date (attr (stream-car in-stream) 'DTSTART))))
+  (let loop ((days (day-stream (as-date (attr (stream-car in-stream) 'DTSTART))))
              (stream in-stream))
     (if (stream-null? stream)
         stream-null
         (let* ((day (stream-car days))
-               (tomorow (date->time-utc (stream-car (stream-cdr days)))))
+               (tomorow (stream-car (stream-cdr days))))
 
           (let ((head (stream-take-while (ein? day) stream))
                 (tail
@@ -26,8 +26,8 @@
                  ;; of tommorow, and finishes with the rest when it finds the first
                  ;; object which begins tomorow (after midnight, exclusize).
                  (filter-sorted-stream*
-                  (lambda (e) (time<? tomorow (attr e 'DTEND)))
-                  (lambda (e) (time<=? tomorow (attr e 'DTSTART)))
+                  (lambda (e) (date/-time<? tomorow (attr e 'DTEND)))
+                  (lambda (e) (date/-time<=? tomorow (attr e 'DTSTART)))
                   stream)))
 
 
diff --git a/module/vcomponent/load.scm b/module/vcomponent/load.scm
index 2e69d1f5..72200b32 100644
--- a/module/vcomponent/load.scm
+++ b/module/vcomponent/load.scm
@@ -3,6 +3,7 @@
   :use-module (util)
   :use-module (srfi srfi-1)
   :use-module (srfi srfi-19 alt)
+  :use-module (srfi srfi-19 alt util)
   :use-module (srfi srfi-41)
   :use-module (srfi srfi-41 util)
   :use-module (parameters)
@@ -19,10 +20,15 @@
   (let* ((calendars regular repeating (load-calendars* #:calendar-files calendar-files)))
     (values
      calendars
+     (list->stream regular)
+     #;
      (interleave-streams
       ev-time<?
       (cons (list->stream regular)
-            (map generate-recurrence-set repeating))))))
+            '()
+            ;; TODO reactivate this
+            #; (map generate-recurrence-set repeating)
+            )))))
 
 ;; Basic version, loads calendrs, sorts the events, and returns
 ;; regular and repeating events separated from each other.
diff --git a/module/vcomponent/output.scm b/module/vcomponent/output.scm
index 14c1bf13..55cc0b12 100644
--- a/module/vcomponent/output.scm
+++ b/module/vcomponent/output.scm
@@ -3,7 +3,8 @@
   #:use-module (vcomponent control)
   #:use-module (util)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-19 util)
+  #:use-module (srfi srfi-19 alt)
+  #:use-module (srfi srfi-19 alt util)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 format)
   #:export (print-vcomponent
@@ -66,9 +67,15 @@ Removes the X-HNH-FILENAME attribute, and sets PRODID to
                         (string->ics-safe-string
                          (case key
                            ((DTSTART DTEND)
-                            (if (string? value)
-                                value
-                                (time->string value "~Y~m~dT~H~M~S")))
+                            (cond [(string? value) value]
+                                  [(date? value) (date->string value "~H~M~S")]
+                                  [(datetime? value)
+                                   (string-append
+                                    (date->string (get-date value) "~Y~m~d")
+                                    "T"
+                                    (time->string (get-time value) "~H~M~S"))]))
+                           ((X-HNH-DURATION)
+                            (format #f "~s" value))
                            (else value)))))
 
               ;; Catch
diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm
index 646d1f72..24becd13 100644
--- a/module/vcomponent/parse.scm
+++ b/module/vcomponent/parse.scm
@@ -167,7 +167,12 @@
                                      (mod! (value it)
                                            (if (or (and=>> v car (cut string=? <> "DATE-TIME"))
                                                    (string-contains (value it) "T"))
-                                               parse-datetime parse-date)))]
+                                               (begin
+                                                 (set! (prop it 'VALUE) "DATE-TIME")
+                                                 parse-datetime)
+                                               (begin
+                                                 (set! (prop it 'VALUE) "DATE")
+                                                 parse-date))))]
 
                                   )
 
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index 938d99f9..8a4eed36 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -142,20 +142,32 @@
   ;; TODO DURATION might be used for something else, check applicable types
   ;; TODO Far from all events have DTEND
   ;;      VTIMEZONE's always lack it.
-  (if (not (attr event 'RRULE))
-      (stream event)
-      (begin
-        (set! (attr event 'X-HNH-DURATION)
-          (cond [(attr event 'DURATION) => identity]
-                [(attr event 'DTEND)
-                 => (lambda (end)
-                      ;; The value type of dtstart and dtend must be the same
-                      ;; according to RFC 5545 3.8.2.2 (Date-Time End).
-                      (if (date? end)
-                          (date- end (attr event 'DTSTART))
-                          (datetime- end (attr event 'DTSTART))))]))
-        (if (attr event "RRULE")
-            (recur-event-stream event (parse-recurrence-rule (attr event "RRULE")))
-            ;; TODO some events STANDARD and DAYLIGT doesn't have RRULE's, but rather
-            ;; just mention the current part. Handle this
-            stream-null))))
+  (catch #t
+    (lambda ()
+     (if (not (attr event 'RRULE))
+         (stream event)
+         (begin
+           (set! (attr event 'X-HNH-DURATION)
+             (cond [(attr event 'DURATION) => identity]
+                   [(attr event 'DTEND)
+                    => (lambda (end)
+                         ;; The value type of dtstart and dtend must be the same
+                         ;; according to RFC 5545 3.8.2.2 (Date-Time End).
+                         (if (date? end)
+                             (date- end (attr event 'DTSTART))
+                             (datetime- end (attr event 'DTSTART))))]))
+           (if (attr event "RRULE")
+               (recur-event-stream event (parse-recurrence-rule
+                                          (attr event "RRULE")
+                                          (if (string= "DATE" (and=> (prop (attr* event 'DTSTART) 'VALUE) car))
+                                              parse-date parse-datetime)))
+               ;; TODO some events STANDARD and DAYLIGT doesn't have RRULE's, but rather
+               ;; just mention the current part. Handle this
+               stream-null))))
+    (lambda (err . args)
+      (format (current-error-port)
+              "\x1b[0;31mError\x1b[m while parsing recurrence rule (ignoring and continuing)~%~a ~a~%~a~%~%"
+              err args
+              (attr event 'X-HNH-FILENAME))
+      (stream ; event
+       ))))
diff --git a/module/vcomponent/recurrence/internal.scm b/module/vcomponent/recurrence/internal.scm
index 12cf7a7b..50c44a60 100644
--- a/module/vcomponent/recurrence/internal.scm
+++ b/module/vcomponent/recurrence/internal.scm
@@ -37,7 +37,8 @@
                      (display "=" port)
                      (display
                       (case field
-                        ((until) ((@ (srfi srfi-19 util) time->string) it))
+                        ;; TODO check over date/time/datetime here
+                        ((until) ((@ (srfi srfi-19 alt util) time->string) it))
                         (else it))
                       port)))
          (display ">" port))))))
diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm
index f532987a..1c974727 100644
--- a/module/vcomponent/recurrence/parse.scm
+++ b/module/vcomponent/recurrence/parse.scm
@@ -18,15 +18,20 @@
 ;; (<weekadynum>, ...)
 ;; @end example
 
+;;; weekdaynum can contain ±
+;;; only used in bywdaylist
+;;; only present with by BYDAY
+
 ;; Returns a pair, where the @code{car} is the offset
 ;; and @code{cdr} is the day symbol.
 ;; The @code{car} may be @code{#f}.
+;; str → (<num> . <symb>)
 (define (parse-day-spec str)
-  (let* ((numchars (append '(#\+ #\-) (map integer->char (iota 10 #x30))))
-         (num symb (span (cut memv <> numchars)
-                         (string->list str))))
-    (cons (string->number (list->string num))
-          (apply symbol symb))))
+  (let* ((numerical-characters (append '(#\+ #\-) (map integer->char (iota 10 #x30))))
+         (numbers letters (span (cut memv <> numerical-characters)
+                                (string->list str))))
+    (cons (string->number (list->string numbers))
+          (apply symbol letters))))
 
 (define-macro (quick-case key . cases)
   (let ((else-clause (or (assoc-ref cases 'else)
@@ -43,17 +48,20 @@
                  `(else ,@body)))
               cases))))
 
-(define (parse-recurrence-rule str)
+;; UNTIL must have the exact same value type as the DTSTART of the event from which
+;; this string came. I have however seen exceptions to that rule...
+(define* (parse-recurrence-rule str optional: (datetime-parser parse-datetime))
   (fold
    (lambda (kv o)
      (let* (((key val) kv))
        (let-lazy
         ((symb (string->symbol val))
-         (date (parse-datetime val))
+         (date (datetime-parser val))
          (days (map parse-day-spec (string-split val #\,)))
          (num  (string->number val))
          (nums (map string->number (string-split val #\,))))
 
+        ;; TODO I think it's an error to give BYHOUR and under for dates which aren't datetimes
         (quick-case (string->symbol key)
           (UNTIL (set! (until o) date))