Add datetime-difference.

3 files changed, 55 insertions, 5 deletions

diff --git a/module/output/html.scm b/module/output/html.scm
index f30e6338..42290ed9 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -120,8 +120,8 @@
                       (partition (lambda (ev)
                                    (or (date? (attr ev 'DTSTART))
                                        (datetime<=? (datetime time: (time hour: 24))
-                                                    (datetime- (attr ev 'DTEND)
-                                                               (attr ev 'DTSTART)))))
+                                                    (datetime-difference (attr ev 'DTEND)
+                                                                         (attr ev 'DTSTART)))))
                                  (stream->list events))))
     ;; (format (current-error-port) "lay-out-day: ~a~%" (date->string date))
     (format (current-error-port) "long=~a, short=~a~%"
diff --git a/module/srfi/srfi-19/alt.scm b/module/srfi/srfi-19/alt.scm
index 09f70190..33a1bc1f 100644
--- a/module/srfi/srfi-19/alt.scm
+++ b/module/srfi/srfi-19/alt.scm
@@ -487,6 +487,40 @@
                            (date day: overflow))
               time: time)))
 
+(define (datetime->srfi-19-date date)
+  ((@ (srfi srfi-19) make-date)
+    0
+    (second (get-time date))
+    (minute (get-time date))
+    (hour (get-time date))
+    (day (get-date date))
+    (month (get-date date))
+    (year (get-date date))
+    0                                   ; TODO TZ
+    ))
+
+(define (srfi-19-date->datetime o)
+  (let ((y ((@ (srfi srfi-19) date-year)   o)))
+    ;; TODO find better way to translate from 1970 to 0, since this WILL
+    ;; cause problems sooner or later.
+   (datetime year:   (if (= 1970 y) 0 y)
+             month:  (let ((m ((@ (srfi srfi-19) date-month) o)))
+                       (if (and (= 1970 y) (= 1 m)) 0 m))
+             day:    (let ((d ((@ (srfi srfi-19) date-day) o)))
+                       (if (and (= 1970 y) (= 1 d)) 0 d))
+             hour:   ((@ (srfi srfi-19) date-hour)   o)
+             minute: ((@ (srfi srfi-19) date-minute) o)
+             second: ((@ (srfi srfi-19) date-second) o)
+             )))
+
+
+(define-public (datetime-difference end start)
+  (let ((t
+         ((@ (srfi srfi-19) time-difference)
+          ((@ (srfi srfi-19) date->time-utc) (datetime->srfi-19-date end))
+          ((@ (srfi srfi-19) date->time-utc) (datetime->srfi-19-date start)))))
+    ((@ (srfi srfi-19) set-time-type!) t (@ (srfi srfi-19) time-utc))
+    (srfi-19-date->datetime ((@ (srfi srfi-19) time-utc->date) t 0))))  ; TODO tz offset
 
 
 ;;; Parsers for vcomponent usage
diff --git a/tests/srfi-19-alt.scm b/tests/srfi-19-alt.scm
index 1a351992..51419fcc 100644
--- a/tests/srfi-19-alt.scm
+++ b/tests/srfi-19-alt.scm
@@ -6,10 +6,15 @@
   datetime+
   datetime-
   datetime<=?
+  datetime-difference
+  leap-year?
   )
  ((ice-9 format) format)
  )
 
+(test-equal "empty time"
+  (time) #00:00:00)
+
 (test-assert "Synatx date"
   #2020-01-01)
 
@@ -91,9 +96,9 @@
   #00:00:00
   (time- #10:20:30 #10:20:30))
 
-(test-equal "date- self"
-  #0000-00-00
-  (date- #2020-01-01 #2020-01-01))
+(test-equal "datetime-difference self"
+  #0000-00-00T00:00:00
+  (datetime-difference (datetime date: #2020-01-01) (datetime date: #2020-01-01)))
 
 ;; (test-assert
 ;;     (datetime- #2018-01-17T10:00:00
@@ -105,3 +110,14 @@
 ;;                  (datetime- #2018-01-17T10:00:00
 ;;                             #2018-01-17T08:00:00)))
 
+
+;; TODO
+;; at the time of writing this returns #2020-02-00
+;; The general question is, how is the last in a month handled?
+;; (test-equal
+;;     (date+ #2019-12-31 (date month: 1)))
+
+(test-assert (leap-year? 2020))
+
+(test-equal "Add to Leap day"
+    #2020-02-29 (date+ #2020-02-28 (date day: 1)))