Remove deprecated get-time.

8 files changed, 106 insertions, 89 deletions

diff --git a/module/datetime.scm b/module/datetime.scm
index 2b330a9c..9b0ccd47 100644
--- a/module/datetime.scm
+++ b/module/datetime.scm
@@ -142,8 +142,8 @@
 ;; timezone info it's discarded and a local timestamp produced.
 ;; It's deprecated since the local time of a datetime can be in another date
 ;; than the original. which is fun...
-(define-public (get-time dt)
-  (get-time% (get-datetime dt)))
+;; (define-public (get-time dt)
+;;   (get-time% (get-datetime dt)))
 
 
 ;;; UTIL
@@ -176,7 +176,7 @@
         [else "Object not a date, time, or datetime object ~a" date/-time]))
 
 (define-public (as-time date/-time)
-  (cond [(datetime? date/-time) (get-time date/-time)]
+  (cond [(datetime? date/-time) (get-time% (get-datetime date/-time))]
         [(date? date/-time) (time)]
         [(time? date/-time) date/-time]
         [else "Object not a date, time, or datetime object ~a" date/-time]))
@@ -207,8 +207,10 @@
        (= (second a) (second b))))
 
 (define-public (datetime= a b)
-  (and (date= (get-date a) (get-date b))
-       (time= (get-time a) (get-time b))))
+  (let ((a (get-datetime a))
+        (b (get-datetime b)))
+   (and (date= (get-date a) (get-date b))
+        (time= (get-time% a) (get-time% b)))))
 
 (define-many define-public
   (date=?) date=
@@ -530,12 +532,15 @@
 
 ;;; DATETIME
 
+;; NOTE that base is re-normalized, but change isn't. This is due to base
+;; hopefully being a real date, but change just being a difference.
 (define-public (datetime+ base change)
-  (let* ((time overflow (time+ (get-time base) (get-time change))))
-    (datetime date: (date+ (get-date base)
-                           (get-date change)
-                           (date day: overflow))
-              time: time)))
+  (let ((base (get-datetime base)))
+   (let* ((time overflow (time+ (get-time% base) (get-time% change))))
+     (datetime date: (date+ (get-date base)
+                            (get-date change)
+                            (date day: overflow))
+               time: time))))
 
 ;; (define (datetime->srfi-19-date date)
 ;;   ((@ (srfi srfi-19) make-date)
diff --git a/module/datetime/util.scm b/module/datetime/util.scm
index ff75e86d..d5558aa2 100644
--- a/module/datetime/util.scm
+++ b/module/datetime/util.scm
@@ -150,7 +150,29 @@
             #f
             (string->list fmt)))))
 
-(define*-public (time->string time optional: (fmt "~H:~M:~S") key: allow-unknown?)
+;; (define*-public (time->string time optional: (fmt "~H:~M:~S") key: allow-unknown?)
+;;   (with-output-to-string
+;;     (lambda ()
+;;       (fold (lambda (token state)
+;;               (case state
+;;                 ((#\~)
+;;                  (case token
+;;                    ((#\~) (display "~"))
+;;                    ((#\H) (format #t "~2'0d" (hour time)))
+;;                    ((#\M) (format #t "~2'0d" (minute time)))
+;;                    ((#\S) (format #t "~2'0d" (second time)))
+;;                    ;; ((#\z) (when (utc? time) (display "Z")))
+;;                    (else (unless allow-unknown?
+;;                            (error 'time->string "Invalid format token ~a" token))))
+;;                  #f)
+;;                 (else (unless (char=? #\~ token) (display token)) token)))
+;;             #f
+;;             (string->list fmt)))))
+
+(define*-public (datetime->string datetime optional: (fmt "~Y-~m-~dT~H:~M:~S") key: allow-unknown?)
+  (define dt (get-datetime datetime))
+  (define date (get-date dt))
+  (define time ((@ (datetime) get-time%) dt))
   (with-output-to-string
     (lambda ()
       (fold (lambda (token state)
@@ -161,9 +183,21 @@
                    ((#\H) (format #t "~2'0d" (hour time)))
                    ((#\M) (format #t "~2'0d" (minute time)))
                    ((#\S) (format #t "~2'0d" (second time)))
+                   ;; TODO
                    ;; ((#\z) (when (utc? time) (display "Z")))
+                   ((#\Y) (format #t "~4'0d" (year date)))
+                   ((#\m) (format #t "~2'0d" (month date)))
+                   ((#\d) (format #t "~2'0d" (day date)))
+                   ;; Should be same as ~_d
+                   ((#\e) (format #t "~2' d" (day date)))
+                   ((#\1) (format #t "~4'0d-~2'0d-~2'0d"
+                                  (year date) (month date) (day date)))
+                   ((#\a) (display (week-day-name (week-day date))))
+                   ;; abriviated locale month name
+                   ;; TODO locale
+                   ((#\b) (display (month-name (month date))))
                    (else (unless allow-unknown?
-                           (error 'time->string "Invalid format token ~a" token))))
+                           (error 'datetime->string "Invalid format token ~a" token))))
                  #f)
                 (else (unless (char=? #\~ token) (display token)) token)))
             #f
@@ -171,7 +205,6 @@
 
 
 
-
 ;; @verbatim
 ;;    A          B          C          D          E         ¬F
 ;; |s1|     :     |s2| : |s1|     :     |s2| :          : |s1|
diff --git a/module/output/html.scm b/module/output/html.scm
index 1f4b8e2f..d6a9e8fa 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -28,9 +28,7 @@
 ;; TODO currently not guaranteed to be unique
 (define (UID ev)
   (string-append
-   ;; (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")
+   (datetime->string (as-datetime (attr ev 'DTSTART)) "~Y~m~d~H~M~S")
    (html-attr (attr ev 'UID))))
 
 ;; This should only be used on time intervals, never on absolute times.
@@ -61,12 +59,10 @@
         [else ; guaranteed datetime
          (let ((s (attr ev 'DTSTART))
                (e (attr ev 'DTEND)))
-           (let ((s-str (time->string (get-time s) "~H:~M"))
-                 (e-str (time->string (get-time e) "~H:~M")))
-             (if (date= (get-date s) (get-date e))
-                 (values s-str e-str)
-                 (values (string-append (date->string (get-date s) "~Y-~m-~d ") s-str)
-                         (string-append (date->string (get-date e) "~Y-~m-~d ") e-str)))))]))
+           (let ((fmt-str (if (date= (get-date s) (get-date e))
+                              "~H:~M" "~Y-~m-~d ~H:~M")))
+             (values (datetime->string s fmt-str)
+                     (datetime->string e fmt-str))))]))
 
 
 
diff --git a/module/output/ical.scm b/module/output/ical.scm
index c18a203a..0252320b 100644
--- a/module/output/ical.scm
+++ b/module/output/ical.scm
@@ -16,30 +16,31 @@
 (define (value-format key vline)
   (with-throw-handler 'wrong-type-arg
     (lambda ()
-     (case key
-       ((DTSTART DTEND RECURRENCE-ID)
-        (with-output-to-string
-          (lambda ()
-            (display (date->string (as-date (value vline))
-                                   "~Y~m~d"))
-            (when (eq? 'DATE-TIME (and=> (prop vline 'VALUE) car))
-              (display (time->string (get-time (value vline))
-                                     "T~H~M~S"))
-              (let ((tz (and=> (prop vline 'TZID) car)))
-               (when (and tz (string= tz "UTC"))
-                 (display #\Z))))))
-        )
-       ((DURATION X-HNH-DURATION)
-     #; (time->string value "~H~M~S")
-        (let ((s (second (value vline))))
-          (format #f "~a~a~a"
-                  (floor/ s 3600)
-                  (floor/ (modulo s 3600) 60)
-                  (modulo s 60))
-          ))
-       ((RRULE) (value vline))
-
-       (else (escape-chars (value vline)))))
+      (case key
+        ((DTSTART DTEND RECURRENCE-ID)
+         (with-output-to-string
+           (lambda ()
+             (case (and=> (prop vline 'VALUE) car)
+               [(DATE) (display (date->string (as-date (value vline))
+                                              "~Y~m~d"))]
+               [(DATE-TIME)
+                (display (datetime->string (value vline) "~Y~m~dT~H~M~S"))
+                (let ((tz (and=> (prop vline 'TZID) car)))
+                  (when (and tz (string= tz "UTC"))
+                    (display #\Z)))]
+               [else
+                (error "Unknown VALUE type")]))))
+        ((DURATION X-HNH-DURATION)
+         #; (time->string value "~H~M~S")
+         (let ((s (second (value vline))))
+           (format #f "~a~a~a"
+                   (floor/ s 3600)
+                   (floor/ (modulo s 3600) 60)
+                   (modulo s 60))
+           ))
+        ((RRULE) (value vline))
+
+        (else (escape-chars (value vline)))))
     (lambda (err caller fmt args call-args)
       (format (current-error-port)
               "WARNING: key = ~a, caller = ~s, call-args = ~s~%~k~%" key caller call-args fmt args)
diff --git a/module/output/terminal.scm b/module/output/terminal.scm
index 68e66eb9..cb18649d 100644
--- a/module/output/terminal.scm
+++ b/module/output/terminal.scm
@@ -41,12 +41,10 @@
     (display
      (string-append
       (if (datetime? (attr ev 'DTSTART))
-        (string-append (date->string (get-date (attr ev 'DTSTART)))
-                       " "
-                       (time->string (get-time (attr ev 'DTSTART))))
-        ((@ (texinfo string-utils) center-string)
-         (date->string (attr ev 'DTSTART))
-         19))
+          (datetime->string (attr ev 'DTSTART) "~Y-~m-~d ~H:~M:~S")
+          ((@ (texinfo string-utils) center-string)
+           (date->string (attr ev 'DTSTART))
+           19))
        ; TODO show truncated string
       " │ "
       (if (= i cur-event) "\x1b[7m" "")
@@ -115,15 +113,11 @@
                     ;; another story.
                     (let ((start (attr ev 'DTSTART)))
                       (if (datetime? start)
-                          (string-append (date->string (get-date start))
-                                         " "
-                                         (time->string (get-time start)))
+                          (datetime->string (attr ev 'DTSTART) "~Y-~m-~d ~H:~M:~S")
                           (date->string start)))
                     (let ((end (attr ev 'DTEND)))
                       (if (datetime? end)
-                          (string-append (date->string (get-date end))
-                                         " "
-                                         (time->string (get-time end)))
+                          (datetime->string (attr ev 'DTSTART) "~Y-~m-~d ~H:~M:~S")
                           (date->string end)))
                     (unlines (take-to (flow-text (or (attr ev 'DESCRIPTION) "")
                                                  #:width (min 70 width))
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index ac1402fa..ac8a6ad8 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -50,30 +50,25 @@
              (let ((d (attr e 'DTSTART))
                    (i (interval r)))
 
-               (set! (attr e 'DTSTART)
-                 ((if (date? d)
-                    identity
-                    (lambda (date)
-                      (datetime
-                        date: date
-                        time: (time+ (get-time d)
-                                     (case (freq r)
-                                       ((SECONDLY) (time second: i))
-                                       ((MINUTELY) (time minute: i))
-                                       ((HOURLY)   (time hour:   i))
-                                       (else (time)))))))
-
-                  (date+ (as-date d)
-                         (case (freq r)
-                           ((DAILY)    (date day:    i))
-                           ((WEEKLY)   (date day: (* i 7)))
-                           ((MONTHLY)  (date month:  i))
-                           ((YEARLY)   (date year:   i))
-                           (else (date))))))
+               (let ((date-change (case (freq r)
+                                    ((DAILY)    (date day:    i))
+                                    ((WEEKLY)   (date day: (* i 7)))
+                                    ((MONTHLY)  (date month:  i))
+                                    ((YEARLY)   (date year:   i))
+                                    (else (date))))
+                     (time-change (case (freq r)
+                                    ((SECONDLY) (time second: i))
+                                    ((MINUTELY) (time minute: i))
+                                    ((HOURLY)   (time hour:   i))
+                                    (else (time)))))
+                (set! (attr e 'DTSTART)
+                  (if (date? d)
+                      (date+ d date-change)
+                      (datetime+ d (datetime date: date-change time: time-change)))))
 
                #;
-               (set! (zone-offset d)
-                 (zone-offset (time-utc->date (date->time-utc d))))
+               (set! (zone-offset d)    ;
+               (zone-offset (time-utc->date (date->time-utc d))))
 
 
                (let ((start (attr e 'DTSTART))
diff --git a/module/vcomponent/recurrence/internal.scm b/module/vcomponent/recurrence/internal.scm
index 07fc4cf5..f7b49abc 100644
--- a/module/vcomponent/recurrence/internal.scm
+++ b/module/vcomponent/recurrence/internal.scm
@@ -38,7 +38,7 @@
                      (display
                       (case field
                         ;; TODO check over date/time/datetime here
-                        ((until) ((@ (datetime util) time->string) it))
+                        ;; ((until) ((@ (datetime util) time->string) it))
                         (else it))
                       port)))
          (display ">" port))))))
diff --git a/tests/datetime-util.scm b/tests/datetime-util.scm
index ec5da552..4ba432ca 100644
--- a/tests/datetime-util.scm
+++ b/tests/datetime-util.scm
@@ -1,5 +1,5 @@
 (((datetime) date time)
- ((datetime util) month-stream in-date-range? time->string)
+ ((datetime util) month-stream in-date-range?)
  ((srfi srfi-41) stream->list stream-take
   ))
 
@@ -24,10 +24,3 @@
   (not ((in-date-range? #2020-01-01 #2020-02-29)
         #2018-02-02)))
 
-
-(test-equal "time fmt default"
-  "10:20:30" (time->string #10:20:30))
-
-(test-equal "time fmt custom"
-  "103020" (time->string #10:20:30 "~H~S~M"))
-