Once again compiles.

27 files changed, 747 insertions, 263 deletions

diff --git a/TODO.org b/TODO.org
index 43c03d6f..5ea592de 100644
--- a/TODO.org
+++ b/TODO.org
@@ -1,3 +1,12 @@
+"Veckovy", månader efter sommartid saknar den förste.
+Lill-kallendern har inte det problemet
+
+Heldagsevents visa inte 00:00 - 00:00
+
+Omnormalizera alla tidsfällt överallt till att vara rimligga
+date := <year, month, date ?tz>
+time := <hour, minute, second>
+datetime := <date, time>
 
 * Att göra
 ** Tester
diff --git a/module/entry-points/html.scm b/module/entry-points/html.scm
index 82f972ae..16306031 100644
--- a/module/entry-points/html.scm
+++ b/module/entry-points/html.scm
@@ -3,8 +3,8 @@
   :use-module (output html)
   :use-module (util)
   :use-module (vcomponent)
-  :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 (ice-9 getopt-long)
 
   :use-module (parameters)
@@ -22,13 +22,15 @@
   (define start (cond [(option-ref opts 'from #f) => parse-freeform-date]
                       [else (start-of-month (current-date))]))
   (define end (cond [(option-ref opts 'to  #f) => parse-freeform-date]
-                    [else (normalize-date* (set (date-month start) = (+ 1)))]))
+                    [else (date+ start (date month: 1)) ]))
 
   (define-values (calendars events)
     (load-calendars
      calendar-files: (cond [(option-ref opts 'file #f) => list]
                            [else (calendar-files)]) ))
 
+  ((@ (srfi srfi-41) stream->list) events)
+
   (if (option-ref opts 'chunked #f)
       (html-chunked-main calendars events start)
       (html-generate calendars events start end)))
diff --git a/module/entry-points/terminal.scm b/module/entry-points/terminal.scm
index df15116c..e53a3d05 100644
--- a/module/entry-points/terminal.scm
+++ b/module/entry-points/terminal.scm
@@ -20,9 +20,9 @@
      calendar-files: (cond [(option-ref opts 'file #f) => list]
                            [else (calendar-files)]) ))
 
-  (let ((time (drop-time (or (and=> (option-ref opts 'date #f) parse-freeform-date)
-                             (current-date)))))
+  (let ((date (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))))
+     (lambda () (main-loop date events))))
 )
diff --git a/module/main.scm b/module/main.scm
index 92df5e20..1765ef43 100755
--- a/module/main.scm
+++ b/module/main.scm
@@ -7,7 +7,7 @@ exec guile -e main -s $0 "$@"
 !#
 
 (use-modules (srfi srfi-1)
-             (srfi srfi-19)
+             ;; (srfi srfi-19)
              (srfi srfi-41)
              (srfi srfi-41 util)
              (srfi srfi-88)             ; keyword syntax
@@ -40,7 +40,7 @@ exec guile -e main -s $0 "$@"
   (if (null? a)
       b a))
 
-(define (main args)
+(define (wrapped-main args)
   (define opts (getopt-long args options #:stop-at-first-non-option #t))
   (define stprof (option-ref opts 'statprof #f))
 
@@ -80,3 +80,28 @@ exec guile -e main -s $0 "$@"
                       style: (if (boolean? stprof)
                                  'flat
                                  (string->symbol stprof)))))
+
+
+(use-modules (system vm frame))
+
+(define (main args)
+  (with-throw-handler #t
+    (lambda () (wrapped-main args))
+    (lambda (err . args)
+      (define stack (make-stack #t))
+      (format
+       (current-error-port)
+       "bindings = (~a)~%"
+       (with-output-to-string
+         (lambda ()
+           (let loop ((frame (stack-ref stack 0)))
+             (when frame
+               (format #t "~{~a~^ ~}" (map binding-name (frame-bindings frame)))
+               (let ((event (and=> (frame-lookup-binding frame 'event)
+                                   binding-ref)))
+                 (when event
+                   (format (current-error-port) "event = ~a~%" event)
+                   ((@ (vcomponent output) serialize-vcomponent)
+                    event (current-error-port))))
+
+               (loop (frame-previous frame))))))))))
diff --git a/module/output/general.scm b/module/output/general.scm
index 526c449e..4d9b4ce8 100644
--- a/module/output/general.scm
+++ b/module/output/general.scm
@@ -3,12 +3,18 @@
 
 ;; Returns a color with good contrast to the given background color.
 (define-public (calculate-fg-color c)
-  (define (str->num c n) (string->number (substring/shared c n (+ n 2)) 16))
-  (let ((r (str->num c 1))
-        (g (str->num c 3))
-        (b (str->num c 5)))
-    (if (< 1/2 (/ (+ (* 0.299 r)
-                     (* 0.587 g)
-                     (* 0.144 b))
-                  #xFF))
-        "#000000" "#e5e8e6")))
+  (catch #t
+    (lambda ()
+      (define (str->num c n) (string->number (substring/shared c n (+ n 2)) 16))
+      (let ((r (str->num c 1))
+            (g (str->num c 3))
+            (b (str->num c 5)))
+        (if (< 1/2 (/ (+ (* 0.299 r)
+                         (* 0.587 g)
+                         (* 0.144 b))
+                      #xFF))
+            "#000000" "#e5e8e6")))
+    (lambda args
+      (format (current-error-port) "Error calculating foreground color?~%~a~%" args)
+      "#FF0000"
+      )))
diff --git a/module/output/html.scm b/module/output/html.scm
index 16520f0b..cd3e2974 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -8,8 +8,8 @@
   #:use-module (vcomponent datetime)
   #:use-module (util)
   #:use-module (util tree)
-  #: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 (output general)
 
 
@@ -26,15 +26,14 @@
 (define (date-link date)
   (date->string date "~Y-~m-~d"))
 
-(define (time-link time)
-  (time->string time "~Y-~m-~d"))
-
 (define x-pos (make-object-property))
 (define width (make-object-property))
 
 (define (UID ev)
   (string-append
-   (time->string (attr ev 'DTSTART) "~s")
+   ;; (date/-time->string (attr ev 'DTSTART) "~s")
+   (date->string (as-date (attr ev 'DTSTART)) "~Y~m~d")
+   (time->string (as-time (attr ev 'DTSTART)) "~H~M~S")
    (html-attr (attr ev 'UID))))
 
 ;; Takes a list of vcomponents, sets their widths and x-positions to optimally
@@ -49,7 +48,7 @@
   ;; @var{x} is how for left in the container we are.
   (let inner ((x 0)
               (tree (make-tree overlapping?
-                               (sort* lst time>? (lambda (e) (event-length/day e start-of-day))))))
+                               (sort* lst time>? (lambda (e) (event-length/day e))))))
     (unless (null? tree)
       (let ((w (/ (- 1 x)
                   (+ 1 (length-of-longst-branch (left-subtree tree))))))
@@ -60,16 +59,17 @@
 
 ;; This should only be used on time intervals, never on absolute times.
 ;; For that see @var{date->decimal-hour}.
+;; NOTE Above comment probably deprecated
 (define (time->decimal-hour time)
-  (exact->inexact (/ (time-second time)
-                     3600)))
+  (exact->inexact (+ (/ (minute time) 60)
+                     (/ (second time) 3600))))
 
 (define (html-attr str)
   (define cs (char-set-adjoin char-set:letter+digit #\- #\_))
   (string-filter (lambda (c) (char-set-contains? cs c)) str))
 
-(define (create-block-general day ev fmt)
- (define time (date->time-utc day))
+(define (create-block-general date ev fmt)
+ ;; (define time (date->time-utc day))
   (define style
     (format #f fmt
 
@@ -77,22 +77,24 @@
             (* 100 (width ev))          ; width
 
             ;; top
-            (if (in-day? day (attr ev 'DTSTART))
+            (if (in-day? date (attr ev 'DTSTART))
                 (* 100/24
                    (time->decimal-hour
-                    (time-difference (attr ev 'DTSTART)
-                                     (start-of-day* (attr ev 'DTSTART)))))
+                    (as-time (attr ev 'DTSTART))
+                    #;
+                    (time- (as-time (attr ev 'DTSTART))
+                           (start-of-day* (attr ev 'DTSTART)))))
                 0)
 
             ;; height
-            (* 100/24 (time->decimal-hour (event-length/day ev time)))))
+            (* 100/24 (time->decimal-hour (event-length/day ev)))))
 
   `(a (@ (href "#" ,(UID ev))
          (class "hidelink"))
       (div (@ (class "event CAL_" ,(html-attr (attr (parent ev) 'NAME))
-                ,(when (time<? (attr ev 'DTSTART) time)
+                ,(when (date<? (as-date (attr ev 'DTSTART)) date)
                    " continued")
-                ,(when (time<? (add-day time) (attr ev 'DTEND))
+                ,(when (date<? (add-day date) (as-date (attr ev 'DTEND)))
                    " continuing"))
               (style ,style))
            ,((summary-filter) ev (attr ev 'SUMMARY))))
@@ -100,25 +102,26 @@
   )
 
 ;; Format single event for graphical display
-(define (create-block day ev)
-  (create-block-general day ev "left:~,3f%;width:~,3f%;top:~,3f%;height:~,3f%;"))
+(define (create-block date ev)
+  (create-block-general date ev "left:~,3f%;width:~,3f%;top:~,3f%;height:~,3f%;"))
 
-(define (create-top-block day ev)
-  (create-block-general day ev "top:~,3f%;height:~,3f%;left:~,3f%;width:~,3f%;"))
+(define (create-top-block date ev)
+  (create-block-general date ev "top:~,3f%;height:~,3f%;left:~,3f%;width:~,3f%;"))
 
 ;; Lay out complete day (graphical)
 ;; (date . (events)) -> sxml
 (define (lay-out-day day)
   (let* (((date . events) day)
-         (time (date->time-utc date))
+         (time-obj (datetime date: date))
          (long-events short-events
                       (partition (lambda (ev)
-                                   (time<=? (make-duration (* 3600 24))
-                                            (time-difference (attr ev 'DTEND)
-                                                             (attr ev 'DTSTART))))
+                                   (or (date? (attr ev 'DTSTART))
+                                       (datetime<=? (datetime time: (time hour: 24))
+                                                    (datetime- (attr ev 'DTEND)
+                                                               (attr ev 'DTSTART)))))
                                  (stream->list events))))
-    (fix-event-widths! time short-events)
-    (fix-event-widths! time long-events)
+    (fix-event-widths! time-obj short-events)
+    (fix-event-widths! time-obj long-events)
     `(div (@ (class "day"))
           (div (@ (class "meta"))
                ,(let ((str (date-link date)))
@@ -154,12 +157,27 @@
 
 
 (define (fmt-time-span ev)
-  (let* ((fmt (if (time<? (time-difference (attr ev 'DTEND) (attr ev 'DTSTART))
-                          (make-duration (* 3600 24)))
-                  "~H:~M" "~Y-~m-~d ~H:~M"))
-         (start (time->string (attr ev 'DTSTART) fmt))
-         (end (time->string (attr ev 'DTEND) fmt)))
-    (values start end)))
+  (cond [(attr ev 'DTSTART) date?
+         => (lambda (s)
+              (cond [(attr ev 'DTEND)
+                     => (lambda (e)
+                          (if (date= e (date+ s (date day: 1)))
+                              (values (date->string s) "")
+                              (values (date->string s)
+                                      (date->string e))))]
+                    [else (date->string s)]))]
+        [else ; guaranteed datetime
+         ;; TODO rewrite this
+         (values (time->string (get-time (attr ev 'DTSTART)))
+                 (time->string (get-time (attr ev 'DTEND))))
+         #;
+         (let* ((fmt (if (date/-time<? (time- (attr ev 'DTEND) (attr ev 'DTSTART))
+                                       (time hour: 24))
+                         "~H:~M" "~Y-~m-~d ~H:~M"))
+                ;; TODO write these
+                (start (date/-time->string (attr ev 'DTSTART) fmt))
+                (end (date/-time->string (attr ev 'DTEND) fmt)))
+           (values start end))]))
 
 
 ;; For sidebar, just text
@@ -167,7 +185,7 @@
   `(article (@ (id ,(UID ev))
                (class "eventtext CAL_bg_"
                  ,(html-attr (attr (parent ev) 'NAME))))
-            (h3 (a (@ (href "#" ,(time-link (attr ev 'DTSTART)))
+            (h3 (a (@ (href "#" ,(date-link (as-date (attr ev 'DTSTART))))
                       (class "hidelink"))
                    ,(attr ev 'SUMMARY)))
             (div
@@ -192,35 +210,17 @@
                                 ;; This removes all descriptions from
                                 ;; events for previous days,
                                 ;; solving duplicates.
-                                (time<=? (date->time-utc date)
-                                         (attr ev 'DTSTART)))
+                                (date/-time<=? date
+                                               (attr ev 'DTSTART)))
                               events))))))
 
-(define (days-in-month date)
-  (define rem=0? (compose zero? remainder))
-  (let ((m (date-month date)))
-   (cond ((memv m '(1 3 5 7 8 10 12)) 31)
-         ((memv m '(4 6 9 11)) 30)
-         (else
-          ;; Please don't mention non-gregorian calendars.
-          (let ((y (date-year date)))
-            (if (and (rem=0? y 4)
-                     (or (not (rem=0? y 100))
-                         (rem=0? y 400)))
-                29 28))))))
-
-(define (previous-month n)
-  (1+ (modulo (- n 2) 12)))
-
-;; 0 indexed, starting at monday.
-(define (week-day date)
-  (modulo (1- (date-week-day date)) 7))
-
-(define* (month+ date #:optional (change 1))
-  (normalize-date* (set (date-month date) = (+ change))))
+(define* (month+ date-object #:optional (change 1))
+  ;; (normalize-date* (set (date-month date) = (+ change)))
+  (date+ date-object (date month: change))
+  )
 
-(define* (month- date #:optional (change -1))
-  (month+ date change))
+(define* (month- date-object #:optional (change 1))
+  (date- date-object (date month: change)))
 
 ;; date should be start of month
 ;; @example
@@ -245,16 +245,15 @@
     `(table (@ (class "small-calendar"))
             (thead (tr ,@(map (lambda (d) `(td ,d)) '(MÅ TI ON TO FR LÖ SÖ))))
             (tbody ,@(let recur
-                         ((lst (let* ((month (date-month date))
+                         ((lst (let* ((month (month date))
                                       (month-len (days-in-month date))
-                                      (prev-month-len (days-in-month (month- date) #; (previous-month month)
-                                                       ))
+                                      (prev-month-len (days-in-month (month- date)))
                                       (month-start (week-day date)))
                                  (append (map (td '(class "prev") (month- date))
                                               (iota month-start (1+ (- prev-month-len month-start))))
                                          (map (lambda (p) `(td (@ ,@(assq-merge '((class " cur ")) (cdar p)))
                                                           ,@(cdr p)))
-                                              (map (lambda (d) `((@ (class ,(when (date=? today (set (date-day date) d))
+                                              (map (lambda (d) `((@ (class ,(when (date=? today (set (day date) d))
                                                                          "today")))
                                                             (a (@ (href "#" ,(date->string date "~Y-~m-")
                                                                         ,(pad0 d))
@@ -274,9 +273,9 @@
 ;;; and the html-generate procedure also filters, but instead to find earlier eventns.
 ;;; All this filtering is probably slow, and should be looked into.
 
-(define-public (html-generate calendars events start end)
+(define-public (html-generate calendars events start-date end-date)
   (define evs (get-groups-between (group-stream events)
-                                  start end))
+                                  start-date end-date))
 
   ;; (display "<!doctype HTML>") (newline)
   (define (nav-link display date)
@@ -295,8 +294,8 @@
            (meta (@ (name viewport)
                     (content "width=device-width, initial-scale=0.5")))
            (meta (@ (name description)
-                    (content "Calendar for the dates between " ,(date->string start)
-                             " and " ,(date->string end))))
+                    (content "Calendar for the dates between " ,(date->string start-date)
+                             " and " ,(date->string end-date))))
            ,(include-css "static/style.css")
            (script (@ (src "static/script.js")) "")
            (style ,(format #f "~:{.CAL_~a { background-color: ~a; color: ~a }~%.CAL_bg_~a { border-color: ~a }~%~}"
@@ -332,14 +331,14 @@
                        ;; Small calendar and navigation
                        (div (@ (class "about"))
                             ;; prev button
-                            ,(nav-link "«" (month- start))
+                            ,(nav-link "«" (month- start-date))
 
                             ;; calendar table
-                            (div ,(cal-table (start-of-month start)
+                            (div ,(cal-table (start-of-month start-date)
                                              (current-date)))
 
                             ;; next button
-                            ,(nav-link "»" (month+ start)))
+                            ,(nav-link "»" (month+ start-date)))
 
                        ;; List of events
                        (div (@ (class "eventlist"))
@@ -348,25 +347,25 @@
                                      (header (h2 "Tidigare"))
                                      ,@(stream->list
                                         (stream-map fmt-single-event
-                                                    (stream-take-while (compose (cut time<? <> (date->time-utc start))
+                                                    (stream-take-while (compose (cut date/-time<? <> start-date)
                                                                                 (extract 'DTSTART))
                                                                        (cdr (stream-car evs))))))
                             ,@(stream->list (stream-map fmt-day evs)))))))))
 
 
-(define-public (html-chunked-main calendars events start)
+(define-public (html-chunked-main calendars events start-date)
   ;; NOTE Something here isn't thread safe.
   ;; TODO make it thread safe
-  (stream-for-each (lambda (pair)
-                     (format (current-error-port) "d = ~a~%u = ~a~%" (car pair) (cadr pair))
-                     (let ((fname (format #f "./html/~a.html" (date->string (car pair) "~1"))))
-                       (format (current-error-port) "Writing to [~a]~%" fname)
-                       (with-output-to-file fname
-                         (lambda () (apply html-generate calendars events pair)))))
-                   (let ((ms (month-stream start)))
-                     (stream-take
-                      12 (stream-zip
-                          ms (stream-map (lambda (d) (normalize-date
-                                                 (set (date-day d) = (- 1))))
-                                         (stream-cdr ms))))
-                     )))
+  (stream-for-each
+   (lambda (pair)
+     (format (current-error-port) "d = ~a~%u = ~a~%" (car pair) (cadr pair))
+     (let ((fname (format #f "./html/~a.html" (date->string (car pair) "~1"))))
+       (format (current-error-port) "Writing to [~a]~%" fname)
+       (with-output-to-file fname
+         (lambda () (apply html-generate calendars events pair)))))
+   (let ((ms (month-stream start-date)))
+     (stream-take
+      12 (stream-zip
+          ms (stream-map (lambda (d) (date- d (date day: 1))) ; last in month
+                         (stream-cdr ms))))
+     )))
diff --git a/module/srfi/srfi-19/alt.scm b/module/srfi/srfi-19/alt.scm
index eda1b1f3..a9359a32 100644
--- a/module/srfi/srfi-19/alt.scm
+++ b/module/srfi/srfi-19/alt.scm
@@ -71,9 +71,6 @@
                (hour r) (minute r) (second r)
                (if (utc r) "Z" "")))))
 
-(define-public (time->string time _)
-  (with-output-to-string (lambda () (display time))))
-
 (define*-public (time key: (hour 0) (minute 0) (second 0) (utc #f))
   (make-time hour minute second utc))
 
@@ -113,12 +110,23 @@
          ((apr jun sep nov) 30)
          ((feb)
           (if (leap-year? (year date))
-              29 28))))
+              29 28))
+         (else (error "No month ~a (~a)" (month date) date))))
 
 (define-public (days-in-year date)
   (if (leap-year? (year date))
       366 365))
+
 
+(define-public (as-date date/-time)
+  (if (date? date/-time)
+      date/-time
+      (get-date date/-time)))
+
+(define-public (as-time date/-time)
+  (if (datetime? date/-time)
+      (get-time date/-time)
+      (time)))
 
 ;;; EQUIALENCE
 
@@ -147,7 +155,7 @@
   (time=?) time=
   (datetime=?) datetime=)
 
-(define-public (date< a b)
+(define (date<% a b)
   (let ((ay (year a))
         (by (year b)))
     (if (= ay ay)
@@ -158,6 +166,14 @@
               (< am bm)))
         (< ay by))))
 
+(define-public date<
+  (match-lambda*
+    [() #t]
+    [(_) #t]
+    [(first second . rest)
+     (and (date<% first second)
+          (apply date< second rest))]))
+
 
 (define-public (time< a b)
   (let ((ah (hour a))
@@ -176,25 +192,39 @@
       (time< (get-time a) (get-time b))
       (date< (get-date a) (get-date b))))
 
+(define-public (date/-time< a b)
+  (if (date< (as-date a) (as-date b))
+      #t
+      (time< (as-time a) (as-time b))))
 
 (define-many define-public
   (date<?) date<
   (date> date>?) (swap date<)
+  (date<= date<=?) (negate date>)
+  (date>= date>=?) (negate date<)
 
   (time<?) time<
   (time> time>?) (swap time<)
-
   (time<= time<=?) (negate time>)
   (time>= time>=?) (negate time<)
 
   (datetime<?) datetime<
-  (datetime> datetime>?) (swap datetime<))
+  (datetime> datetime>?) (swap datetime<)
+  (datetime<= datetime<=?) (negate datetime>)
+  (datetime>= datetime>=?) (negate datetime<)
+
+  (date/-time<?) date/-time<
+  (date/-time> date/-time>?) (swap date/-time<)
+  (date/-time<= date/-time<=?) (negate date/-time>)
+  (date/-time>= date/-time>=?) (negate date/-time<)
+  )
 
 
 
 ;;; OPERATIONS
 
 ;; Base and change inverted to better work with fold in the exported date+
+#;
 (define (date+% change base)
 
   ;; while (day base) > (days-in-month base)
@@ -219,18 +249,82 @@
 
   (set (year months-fixed) = (+ (year change))))
 
+(define-public (date-zero? date)
+  (= 0 (year date) (month date) (day date)))
+
+(define (date+%% change base)
+
+  (define-values (days-fixed change*)
+    (let loop ((target base) (change change))
+      ;; (format (current-error-port) "1 ~s : ~s~%" target change)
+      (if (> (days-in-month target) (+ (day change) (day target)))
+          ;; No date overflow, just add the change
+          (values (set-> target (day = (+ (day change))))
+                  (set-> change (day 0)))
+          ;; Date (and possibly year) overflow
+          (loop (if (= 12 (month target))
+                    (set-> target
+                           (year = (+ 1))
+                           (month 1)
+                           (day 1))
+                    (set-> target
+                           (month = (+ 1))
+                           (day 1)))
+                (set-> change (day = (- (1+ (- (days-in-month target) (day target))))))))))
+
+  (define-values (month-fixed change**)
+    (if (date-zero? change*)
+        (values days-fixed change*)
+     (let loop ((target days-fixed) (change change*))
+       ;; (format (current-error-port) "2 ~s : ~s~%" target change)
+       (if (>= 12 (+ (month change) (month target)))
+           (values (set (month target) = (+ (month change)))
+                   (set (month change) 0))
+
+           (loop (set-> target
+                        (year = (+ 1))
+                        (month 1))
+                 (set (month change) = (- 12 (month target))))
+           ))))
+
+  ;; change** should here should have both month and date = 0
+
+  (set (year month-fixed) = (+ (year change**))))
+
+(define (date+% change base)
+
+  (when (or (negative? (year change))
+            (negative? (month change))
+            (negative? (day change)))
+    (error "Change can't be negative"))
+
+  (when (or (negative? (month base))
+            (negative? (day base)))
+    (error "Base month or day can't be negative"))
+
+  (date+%% change base)
+  )
+
+;; @var{base} MUST be a valid real date. all rest arguments can however
+;; be "invalid" dates, such as 0000-00-10
 (define-public (date+ base . rest)
   (fold date+% base rest))
 
-(define (date-% change base)
-
+(define (date-%% change base)
   (define-values (days-fixed change*)
     (let loop ((target base) (change change))
       (if (>= (day change) (day target))
-          (loop (set-> target
-                       (month = (- 1))
-                       (day (days-in-month (set (month target) = (- 1)))))
-                (set (day change) = (- (day target))))
+          (let ((new-change (set (day change) = (- (day target)))))
+            (loop (if (= 1 (month target))
+                      (set-> target
+                             (year = (- 1))
+                             (month 12)
+                             (day 31)              ; days in december
+                             )
+                      (set-> target
+                             (month = (- 1))
+                             (day (days-in-month (set (month target) = (- 1))))))
+                  new-change))
           (values (set (day target) = (- (day change)))
                   (set (day change) 0)))))
 
@@ -246,7 +340,21 @@
 
   ;; change** should here should have both month and date = 0
 
-  (set (year month-fixed) = (- (year change))))
+  (set (year month-fixed) = (- (year change**))))
+
+(define (date-% change base)
+
+  (when (or (negative? (year change))
+            (negative? (month change))
+            (negative? (day change)))
+    (error "Change can't be negative"))
+
+  (when (or (negative? (month base))
+            (negative? (day base)))
+    (error "Base month or day can't be negative"))
+
+  (date-%% change base)
+  )
 
 (define-public (date- base . rest)
   (fold date-% base rest))
@@ -384,7 +492,6 @@
           day:   ((@ (srfi srfi-19) date-day) d))))
 
 
-
 
 
 ;; Reader extensions
diff --git a/module/srfi/srfi-19/alt/util.scm b/module/srfi/srfi-19/alt/util.scm
index 877da69f..3310df85 100644
--- a/module/srfi/srfi-19/alt/util.scm
+++ b/module/srfi/srfi-19/alt/util.scm
@@ -1,6 +1,6 @@
 (define-module (srfi srfi-19 alt util)
   :use-module (srfi srfi-19 alt)
-  :use-module (srfi srfi-1)
+  :use-module ((srfi srfi-1) :select (fold))
   :use-module (srfi srfi-26)
   :use-module (srfi srfi-41)
   :use-module (util)
@@ -19,24 +19,64 @@
   (stream-iterate (cut date+ <> #0-0-1)
                   start-day))
 
-(define-public (as-date date/-time)
-  (if (date? date/-time)
-      date/-time
-      (get-date date/-time)))
-
-(define-public (as-time date/-time)
-  (if (datetime? date/-time)
-      (get-time date/-time)
-      #00:00:00))
-
-(define-public (date/-time< a b)
-  (if (date< (as-date a) (as-date b))
-      #t
-      (time< (as-time a) (as-time b))))
+(define-public (month-stream start-day)
+  (stream-iterate (cut date+ <> #0-1-0)
+                  start-day))
 
-(define-public date/-time<? date/-time<)
+(define-public (time-min a b)
+  (if (time<? a b) a b))
+
+(define-public (time-max a b)
+  (if (time<? a b) b a))
+
+
+;; https://projecteuclid.org/euclid.acta/1485888738
+;; 1. Begel.
+;; J sei die Zahl des Jahrhunderts,
+;; K die Jahrszahl innerhalb desselben,
+;; m die Zahl des Monats,
+;; q die Zahl des Monatstags,
+;; h die Zahl des Wochentags;
+(define (zeller J K m q)
+  (modulo (+ q
+             (floor-quotient (* 13 (1+ m))
+                             5)
+             K
+             (floor-quotient K 4)
+             5
+             (- J))
+          7))
+
+;; 0 indexed, starting at sunday.
+(define-public (week-day date)
+  (let* ((J K (floor/ (year date) 100))
+         (m (month date)))
+    (if (memv m '(1 2))
+        (zeller J (1- K) (+ m 12) (day date))
+        (zeller J K (month date) (day date)))))
+
+(define-many define-public
+  (sun) 0
+  (mon) 1
+  (tue) 2
+  (wed) 3
+  (thu) 4
+  (fri) 5
+  (sat) 6
+  )
 
-(define*-public (date->string date optional: (fmt "~Y-~m-~d"))
+(define-public (week-day-name week-day-number)
+  ;; TODO internationalization
+  (case* week-day-number
+         [(sun 7) "Sön"]
+         [(mon) "Mån"]
+         [(tue) "Tis"]
+         [(wed) "Ons"]
+         [(thu) "Tor"]
+         [(fri) "Fre"]
+         [(sat) "Lör"]))
+
+(define*-public (date->string date optional: (fmt "~Y-~m-~d") key: allow-unknown?)
   (with-output-to-string
     (lambda ()
       (fold (lambda (token state)
@@ -47,13 +87,17 @@
                    ((#\Y) (format #t "~4'0d" (year date)))
                    ((#\m) (format #t "~2'0d" (month date)))
                    ((#\d) (format #t "~2'0d" (day date)))
-                   (else (error "Invalid format token ~a" token)))
+                   ((#\1) (format #t "~4'0d-~2'0d-~2'0d"
+                                  (year date) (month date) (day date)))
+                   ((#\a) (display (week-day-name (week-day date))))
+                   (else (unless allow-unknown?
+                           (error 'date->string "Invalid format token ~a" token))))
                  #f)
                 (else (unless (char=? #\~ token) (display token)) token)))
             #f
             (string->list fmt)))))
 
-(define*-public (time->string time optional: (fmt "~H:~M:~S"))
+(define*-public (time->string time optional: (fmt "~H:~M:~S") key: allow-unknown?)
   (with-output-to-string
     (lambda ()
       (fold (lambda (token state)
@@ -61,16 +105,19 @@
                 ((#\~)
                  (case token
                    ((#\~) (display "~"))
-                   ((#\H) (format #t "~2'0d" (hour date)))
-                   ((#\M) (format #t "~2'0d" (minute date)))
-                   ((#\S) (format #t "~2'0d" (second date)))
-                   (else (error "Invalid format token ~a" token)))
+                   ((#\H) (format #t "~2'0d" (hour time)))
+                   ((#\M) (format #t "~2'0d" (minute time)))
+                   ((#\S) (format #t "~2'0d" (second time)))
+                   (else (unless allow-unknown?
+                           (error 'time->string "Invalid format token ~a" token))))
                  #f)
                 (else (unless (char=? #\~ token) (display token)) token)))
             #f
             (string->list fmt)))))
 
 
+
+
 ;; @verbatim
 ;;    A          B          C          D          E         ¬F
 ;; |s1|     :     |s2| : |s1|     :     |s2| :          : |s1|
@@ -100,8 +147,20 @@
    (and (date/-time<? s2-begin s1-begin)
         (date/-time<? s1-end s2-end))))
 
-(define-public (add-day date)
-  (date+ date (date day: 1)))
+(define-public (add-day d)
+  (date+ d (date day: 1)))
+
+(define-public (remove-day d)
+  (date- d (date day: 1)))
+
+
+;; Checks if @var{datetime} is within the date
+;; given by @var{base-date}.
+;; TODO test time zones
+;; date x datetime → bool
+(define-public (in-day? base-date date/-time)
+  (date< base-date (as-date date/-time) (date+ base-date (date day: 1))))
 
-(define-public (remove-day date)
-  (date- date (date day: 1)))
+(define-public (in-date-range? start-date end-date)
+  (lambda (date)
+    (date<= start-date date end-date)))
diff --git a/module/srfi/srfi-19/setters.scm b/module/srfi/srfi-19/setters.scm
index 45876382..7a13c654 100644
--- a/module/srfi/srfi-19/setters.scm
+++ b/module/srfi/srfi-19/setters.scm
@@ -1,7 +1,7 @@
-(define-module (srfi srfi-19 setters) 
+(define-module (srfi srfi-19 setters)
   #:use-module (srfi srfi-19)           ; Date/Time
   ;; (record-type-fields (@@ (srfi srfi-19) date))
-  #:export (nanosecond second minute hour day month year zone-offset))
+  #:export (nanosecond second minute hour day month year zone-offset tz))
 
 
 (define nanosecond (make-procedure-with-setter date-nanosecond (@@ (srfi srfi-19) set-date-nanosecond!)))
@@ -12,4 +12,4 @@
 (define month (make-procedure-with-setter date-month (@@ (srfi srfi-19) set-date-month!)))
 (define year (make-procedure-with-setter date-year (@@ (srfi srfi-19) set-date-year!)))
 (define zone-offset (make-procedure-with-setter date-zone-offset (@@ (srfi srfi-19) set-date-zone-offset!)))
-
+(define tz zone-offset)
diff --git a/module/srfi/srfi-19/util.scm b/module/srfi/srfi-19/util.scm
index f5bd1964..96f19dc2 100644
--- a/module/srfi/srfi-19/util.scm
+++ b/module/srfi/srfi-19/util.scm
@@ -166,3 +166,17 @@ attribute set to 0. Can also be seen as \"Start of day\""
        )
   ;; ( (nsecs b) (zone b))
   )
+
+;; Rounds a date towards the closest midnight
+;; TODO more general rounding
+(define-public (date-round date)
+  (set->
+   (if (< 12 (date-hour date))
+       ;; round up
+       (set (date-day date) = (+ 1))
+       ;; round down
+       date)
+   (date-day  = (+ 1))
+   (date-hour   0)
+   (date-minute 0)
+   (date-second 0)))
diff --git a/module/util.scm b/module/util.scm
index a2ab43c3..717c61d8 100644
--- a/module/util.scm
+++ b/module/util.scm
@@ -193,11 +193,22 @@
 (define-public (swap f)
   (lambda args (apply f (reverse args))))
 
+
+(define-syntax case*%
+  (syntax-rules (else)
+    [(_ _ else)
+     #t]
+    [(_ invalue (value ...))
+     (memv invalue (list value ...))]
+    #;
+    [(_ invalue target)
+     (eq? invalue target)]))
+
 ;; Like `case', but evals the case parameters
 (define-syntax case*
   (syntax-rules (else)
-    [(_ invalue ((value ...) body ...) ...)
-     (cond ((memv invalue (list value ...))
+    [(_ invalue (cases body ...) ...)
+     (cond ((case*% invalue cases)
             body ...)
            ...)]))
 
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))
 
diff --git a/module/vulgar/components.scm b/module/vulgar/components.scm
index 640d4747..e0467a52 100644
--- a/module/vulgar/components.scm
+++ b/module/vulgar/components.scm
@@ -1,5 +1,5 @@
 (define-module (vulgar components)
-  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-19 alt)
   #:use-module (util)
   #:export ())
 
diff --git a/tests/entry.scm b/tests/entry.scm
new file mode 100644
index 00000000..dddcb99c
--- /dev/null
+++ b/tests/entry.scm
@@ -0,0 +1,7 @@
+(((parameters) calendar-files)
+ ((vcomponent load) load-calendars)
+ )
+
+(test-assert (load-calendars calendar-files: (calendar-files)))
+
+
diff --git a/tests/recurrence-rule.scm b/tests/recurrence-rule.scm
new file mode 100644
index 00000000..0edfc0a1
--- /dev/null
+++ b/tests/recurrence-rule.scm
@@ -0,0 +1,14 @@
+(((vcomponent recurrence parse) parse-recurrence-rule)
+ ((vcomponent recurrence internal)
+  make-recur-rule weekdays intervals))
+
+
+(test-equal
+    (make-recur-rule (freq 'DAILY) (wkst 'MO) (interval 1))
+  (parse-recurrence-rule "FREQ=DAILY"))
+
+(test-equal
+    (make-recur-rule (freq 'WEEKLY) (wkst 'MO) (interval 1))
+  (parse-recurrence-rule "FREQ=WEEKLY"))
+
+;; TODO more tests
diff --git a/tests/recurring.scm b/tests/recurring.scm
index b32759ba..da6e18a8 100644
--- a/tests/recurring.scm
+++ b/tests/recurring.scm
@@ -1,6 +1,7 @@
-(((srfi srfi-41) stream-take stream-map stream->list)
- ((srfi srfi-19) date->time-utc time-utc->date)
- ((srfi srfi-19 util) day-stream)
+(((srfi srfi-41) stream-take stream-map stream->list stream-car)
+ ;; ((srfi srfi-19) date->time-utc time-utc->date)
+ ;; ((srfi srfi-19 util) day-stream)
+ ((srfi srfi-19 alt util) day-stream)
  ((vcomponent base) extract attr)
 
  ((vcomponent) parse-calendar)
@@ -11,12 +12,15 @@
 (define ev
   (call-with-input-string
       "BEGIN:VEVENT
-DTSTART;20190302
+DTSTART:20190302
 RRULE:FREQ=DAILY
 END:VEVENT"
     parse-calendar))
 
 (test-assert "Generate at all"
+  (stream-car (generate-recurrence-set ev)))
+
+(test-assert "Generate some"
   (stream->list (stream-take 5 (generate-recurrence-set ev))))
 
 (test-equal "Generate First"
@@ -26,9 +30,8 @@ END:VEVENT"
                   (generate-recurrence-set ev))))
   (stream->list
    (stream-take
-    5 (stream-map date->time-utc
-                  (day-stream
-                   (time-utc->date (attr ev 'DTSTART)))))))
+    5 (day-stream
+       (attr ev 'DTSTART)))))
 
 ;; We run the exact same thing a secound time, since I had an error with
 ;; that during development.
@@ -40,11 +43,125 @@ END:VEVENT"
                   (generate-recurrence-set ev))))
   (stream->list
    (stream-take
-    5 (stream-map date->time-utc
-                  (day-stream
-                   (time-utc->date (attr ev 'DTSTART)))))))
+    5 (day-stream
+       (attr ev 'DTSTART)))))
+
+
+(define ev
+  (call-with-input-string
+      "BEGIN:VEVENT
+DTSTART:20190302T100000
+RRULE:FREQ=DAILY
+END:VEVENT"
+    parse-calendar) )
+
+(test-assert "daily 10:00"
+  (stream-car (generate-recurrence-set ev)))
+
+(define ev
+  (call-with-input-string
+      "BEGIN:VEVENT
+DTSTART:20190302T100000
+DTEND:20190302T120000
+RRULE:FREQ=DAILY
+END:VEVENT"
+    parse-calendar))
+
+(test-assert "daily 10-12"
+  (stream-car (generate-recurrence-set ev)))
+
+(define ev
+  (call-with-input-string
+      "BEGIN:VEVENT
+DTSTART:20190302T100000
+DTEND:20190302T120000
+RRULE:FREQ=WEEKLY
+END:VEVENT"
+    parse-calendar))
 
+(test-assert "weekly 10-12"
+  (stream-car (generate-recurrence-set ev)))
 
 ;;; TODO, also test:
 ;;; - limited repetition
 ;;; - weird rules
+
+(define ev
+  (call-with-input-string
+      "BEGIN:VEVENT
+DTSTART;TZID=Europe/Stockholm:20190302T100000
+DTEND;TZID=Europe/Stockholm:20190302T120000
+RRULE:FREQ=WEEKLY
+END:VEVENT"
+    parse-calendar))
+
+(test-assert "weekly TZ 10-12"
+  (stream-car (generate-recurrence-set ev)))
+
+(define ev
+  (call-with-input-string
+      "BEGIN:VEVENT
+DTSTART;TZID=Europe/Stockholm:20190302T100000
+DTEND;TZID=Europe/Stockholm:20190302T120000
+RRULE:FREQ=WEEKLY
+SEQUENCE:1
+END:VEVENT"
+    parse-calendar))
+
+(test-assert "weekly TZ SEQUENCE 10-12"
+  (stream-car (generate-recurrence-set ev)))
+
+(define ev
+  (call-with-input-string
+      "BEGIN:VEVENT
+DTSTART;TZID=Europe/Stockholm:20190302T100000
+RRULE:FREQ=WEEKLY
+DTEND;TZID=Europe/Stockholm:20190302T120000
+SEQUENCE:1
+LOCATION:Here
+END:VEVENT"
+    parse-calendar))
+
+(test-assert "weekly TZ SEQUENCE LOCATION 10-12"
+  (stream-car (generate-recurrence-set ev)))
+
+(define ev
+  (call-with-input-string
+     "BEGIN:VEVENT
+DTSTART:20180117T170000
+RRULE:FREQ=WEEKLY
+LOCATION:~
+END:VEVENT"
+   parse-calendar))
+
+(test-assert "Just location"
+  (stream-car (generate-recurrence-set ev)))
+
+
+(define ev
+ (call-with-input-string
+     "BEGIN:VEVENT
+DTSTART;TZID=Europe/Stockholm:20180117T170000
+DTEND;TZID=Europe/Stockholm:20180117T200000
+RRULE:FREQ=WEEKLY
+END:VEVENT"
+   parse-calendar))
+
+(test-assert "Same times"
+  (stream-car (generate-recurrence-set ev)))
+
+(define ev
+ (call-with-input-string
+     "BEGIN:VEVENT
+DTSTART;TZID=Europe/Stockholm:20180117T170000
+RRULE:FREQ=WEEKLY
+DTEND;TZID=Europe/Stockholm:20180117T200000
+SEQUENCE:1
+LOCATION:~
+END:VEVENT"
+   parse-calendar))
+
+;; errer in dtend ?
+
+(test-assert "Full test"
+  (stream-car (generate-recurrence-set ev)))
diff --git a/tests/run-tests.scm b/tests/run-tests.scm
index 613b89df..4ffe6d4e 100755
--- a/tests/run-tests.scm
+++ b/tests/run-tests.scm
@@ -14,8 +14,9 @@
 
 (use-modules (ice-9 ftw)
              (ice-9 sandbox)
-             (srfi srfi-64)
-             ((util) :select (for)))
+             (srfi srfi-64)             ; test suite
+             (srfi srfi-88)             ; suffix keywords
+             ((util) :select (for awhen)))
 
 (define files
   (scandir here
@@ -35,10 +36,16 @@
         (reverse done)
         (loop (cons sexp done))))))
 
+
 ;; TODO test-group fails if called before any test begin, since
 ;; (test-runner-current) needs to be a test-runner (dead or not),
 ;; but is initially bound to #f.
 (test-begin "tests")
+
+(awhen (member "--skip" (command-line))
+       (for skip in (cdr it)
+            (test-skip skip)))
+
 (for fname in files
      (format (current-error-port) "Running test ~a~%" fname)
      (test-group
diff --git a/tests/srfi-19-alt.scm b/tests/srfi-19-alt.scm
index 1fad2fa5..9e03bf53 100644
--- a/tests/srfi-19-alt.scm
+++ b/tests/srfi-19-alt.scm
@@ -1,5 +1,113 @@
-((srfi srfi-19 alt) date+ date- date)
+(((srfi srfi-19 alt) date+ date-
+  year month day
+  date time
+  date<
+  datetime
+  datetime+
+  datetime-
+  datetime<=?
+  )
+ ((ice-9 format) format)
+ )
+
+(test-assert "Synatx date"
+  #2020-01-01)
+
+(test-assert "Test year type"
+  (integer? (year (date year: 2020))))
+
+(test-assert "Test month type"
+  (integer? (month (date month: 1))))
+
+(test-assert "Test day type"
+  (integer? (day (date day: 1))))
+
+(test-equal "Manual print (any)"
+  "2020-10-10"
+  (let ((d (date year: 2020 month: 10 day: 10)))
+    (format #f "~a-~a-~a"
+            (year d) (month d) (day d))))
+
+(test-equal "Manual print (number)"
+  "2020-10-10"
+  (let ((d (date year: 2020 month: 10 day: 10)))
+    (format #f "~d-~d-~d"
+            (year d) (month d) (day d))))
+
+(test-equal "Date print"
+  "2020-01-01"
+  (format #f "~a" (date year: 2020 month: 1 day: 1)))
+
+(test-equal "Syntax date="
+  (date year: 2020 month: 1 day: 1)
+  #2020-01-01)
+
+(test-equal "Syntax time="
+  (time hour: 13 minute: 37 second: 0)
+  #13:37:00)
+
+(test-equal "Syntax Datetime="
+  (datetime year: 2020 month: 1 day: 1 hour: 13 minute: 37 second: 0)
+  #2020-01-01T13:37:00)
 
 (test-equal #2020-02-28 (date- #2020-03-05 (date day: 6)))
 (test-equal #2020-02-29 (date- #2020-03-05 (date day: 5)))
 (test-equal #2020-03-01 (date- #2020-03-05 (date day: 4)))
+
+(test-equal "date+ day" #2020-10-10 (date+ #2020-10-01 (date day: 9)))
+(test-equal "date+ month" #2020-10-10 (date+ #2020-01-10 (date month: 9)))
+(test-equal "date+ day/month" #2020-10-10 (date+ #2020-01-01 (date day: 9 month: 9)))
+;; (test-equal "date+ year" #4040-10-10 (date+ #2020-10-10 (date year: 2020)))
+
+(test-assert "date+ first literal" (date+ #2020-01-01 (date day: 0)))
+(test-assert "date+ second literal" (date+ (date year: 1 month: 1 day: 1) #0001-00-00))
+(test-assert "date+ both literal" (date+ #2020-01-01 #0000-00-00))
+
+(test-equal "date+ year overflow" #2019-01-01 (date+ #2018-12-31 (date day: 1)))
+(test-equal "date- year overflow" #2018-12-31 (date- #2019-01-01 (date day: 1)))
+
+;; (test-equal "date+ large" #4040-10-10 (date+ #2020-05-03 #2020-05-07))
+
+(test-equal "date- large" #0001-01-01 (date- #2020-01-01 #2019-00-00))
+
+;; Datum är spännande
+(test-equal "date- equal" (date year: -1 month: 11 day: 31)
+            (date- #2020-01-01 #2020-01-01))
+
+(test-equal #2020-01-01T10:00:00 (datetime date: #2020-01-01
+                                           time: #10:00:00))
+(test-equal #2020-01-01T10:00:00
+  (datetime+ (datetime date: #2020-01-01)
+             (datetime time: #10:00:00)))
+
+
+(test-equal #2020-03-10
+  (date+ #2020-03-01
+         (date day: 4)
+         (date day: 5)))
+
+
+(test-assert "date< empty"
+  (date<))
+
+(test-assert "date< single"
+  (date< #2020-01-10))
+
+(test-assert "date< double"
+  (date< #2020-01-10 #2020-01-11))
+
+(test-assert "date< tripple"
+  (date< #2020-01-10 #2020-01-11 #2020-01-12))
+
+(test-assert "date< tripple negate"
+  (not (date< #2020-01-10 #2020-01-12 #2020-01-11)))
+
+(test-assert
+    (datetime- #2018-01-17T10:00:00
+               #2018-01-17T08:00:00))
+
+
+(test-assert
+    (datetime<=? (datetime time: (time hour: 24))
+                 (datetime- #2018-01-17T10:00:00
+                            #2018-01-17T08:00:00)))
diff --git a/tests/time.scm b/tests/time.scm
deleted file mode 100644
index 65edfcbd..00000000
--- a/tests/time.scm
+++ /dev/null
@@ -1,58 +0,0 @@
-(((srfi srfi-19 util)
-  date day-stream normalize-date
-  drop-time normalize-date/tz
-  )
- ((util) set let-env)
- ((srfi srfi-19) date-day)
- )
-
-(test-equal "Trivial normalize case"
-  (date year: 2020 month: 1 day: 1 tz: 0)
-  (normalize-date (date year: 2020 month: 1 day: 1 tz: 0)))
-
-(test-equal "Trivial case, with timezone"
-  (date year: 2020 month: 1 day: 1 tz: 3600)
-  (normalize-date (date year: 2020 month: 1 day: 1 tz: 3600)))
-
-;;; summer time begins 02:00 (becomes 03:00) during the night
-;;; between the 28 and 29 of mars 2020, for Europe/Stockholm.
-;;; (CET → CEST alt. UTC+1 → UTC+2)
-
-(test-equal "Time zone spill over"
-  (date year: 2020 month: 3 day: 29 tz: 3600)
-  (normalize-date (set (date-day (date year: 2020 month: 3 day: 28 tz: 3600))
-                       = (+ 1))))
-
-;;; TODO normalize-date*
-
-
-
-;;; !!! TODO !!!
-
-(test-assert "normalize-date/tz"
-  (not (unspecified? (normalize-date/tz (date)))))
-
-(test-equal "Trivial normalize case"
-  (date year: 2020 month: 1 day: 1 hour: 1 tz: 3600)
-  (normalize-date/tz (date year: 2020 month: 1 day: 1 tz: 0)
-                     "Europe/Stockholm"))
-
-(test-equal "Trivial case, with timezone"
-  (date year: 2020 month: 1 day: 1 tz: 3600)
-  (normalize-date/tz (date year: 2020 month: 1 day: 1 tz: 3600)
-                     "Europe/Stockholm"))
-
-(test-equal "Time zone spill over"
-  (date year: 2020 month: 3 day: 30 hour: 1 tz: 7200)
-  (normalize-date/tz (set (date-day (date year: 2020 month: 3 day: 29 tz: 3600))
-                          = (+ 1))
-                     "Europe/Stockholm"))
-
-
-
-
-(test-equal "drop time"
-  (date)
-  (drop-time (date hour: 10 minute: 70 second: 100)))
-
-
diff --git a/tests/vcomponent.scm b/tests/vcomponent.scm
new file mode 100644
index 00000000..c64f1a9b
--- /dev/null
+++ b/tests/vcomponent.scm
@@ -0,0 +1,12 @@
+(((vcomponent base) attr)
+ ((vcomponent) parse-calendar))
+
+(define ev (call-with-input-string
+               "BEGIN:VEVENT
+KEY:value
+END:VEVENT"
+             parse-calendar))
+
+(test-assert (eq? #f (attr ev 'MISSING)) )
+(test-assert (attr ev 'KEY))
+(test-equal "value" (attr ev 'KEY))