aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-07-04 06:34:52 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-07-07 13:10:38 +0200
commit4f75d945436d8c6ddc2deb5936a22bffe94b7ccc (patch)
tree7b12655ffb4fc9b5c05f0e260af61a35a9366fc1
parentAdd script for generating dependency graphs. (diff)
downloadcalp-4f75d945436d8c6ddc2deb5936a22bffe94b7ccc.tar.gz
calp-4f75d945436d8c6ddc2deb5936a22bffe94b7ccc.tar.xz
Merge (datetime util) into (datetime).
-rw-r--r--config.scm4
-rw-r--r--module/datetime.scm387
-rw-r--r--module/datetime/timespec.scm1
-rw-r--r--module/datetime/util.scm389
-rw-r--r--module/datetime/zic.scm1
-rw-r--r--module/entry-points/html.scm1
-rw-r--r--module/entry-points/ical.scm1
-rw-r--r--module/entry-points/server.scm1
-rw-r--r--module/entry-points/terminal.scm1
-rw-r--r--module/main.scm2
-rw-r--r--module/output/html.scm1
-rw-r--r--module/output/ical.scm1
-rw-r--r--module/output/sxml-types.scm1
-rw-r--r--module/output/terminal.scm1
-rw-r--r--module/output/types.scm3
-rw-r--r--module/output/xcal.scm1
-rw-r--r--module/vcomponent.scm1
-rw-r--r--module/vcomponent/datetime.scm1
-rw-r--r--module/vcomponent/group.scm1
-rw-r--r--module/vcomponent/recurrence/display.scm7
-rw-r--r--module/vcomponent/recurrence/generate.scm1
-rw-r--r--module/vcomponent/recurrence/internal.scm1
-rw-r--r--module/vcomponent/recurrence/parse.scm1
-rw-r--r--module/vulgar/termios.scm2
-rw-r--r--tests/datetime-util.scm4
-rw-r--r--tests/recurrence-rule.scm2
-rw-r--r--tests/recurrence.scm3
-rw-r--r--tests/recurring.scm2
-rw-r--r--tests/rrule-parse.scm2
29 files changed, 405 insertions, 419 deletions
diff --git a/config.scm b/config.scm
index 460f678e..e74f9541 100644
--- a/config.scm
+++ b/config.scm
@@ -11,6 +11,8 @@
(glob)
(util config)
+
+ (datetime)
)
(set-config! 'calendar-files (glob "~/.local/var/cal/*"))
@@ -68,4 +70,4 @@
'pre "<br/>" 'post))]
[else (parse-links str)])))
-(set-config! 'week-start (@ (datetime util) mon))
+(set-config! 'week-start mon)
diff --git a/module/datetime.scm b/module/datetime.scm
index 2c0972ea..eff3fdba 100644
--- a/module/datetime.scm
+++ b/module/datetime.scm
@@ -10,6 +10,13 @@
:use-module (srfi srfi-9 gnu)
:use-module (util)
+
+ :use-module (srfi srfi-41)
+ :use-module (srfi srfi-41 util)
+ :use-module (ice-9 i18n)
+ :use-module (ice-9 format)
+ :use-module (util config)
+ :re-export (locale-month)
)
(define-many define-public
@@ -726,3 +733,383 @@
(read-hash-extend #\0 date-reader)
(read-hash-extend #\1 date-reader)
(read-hash-extend #\2 date-reader)
+
+
+
+
+(define-public (start-of-month date)
+ (set (day date) 1))
+
+(define-public (end-of-month date)
+ (set (day date) (days-in-month date)))
+
+(define-public (start-of-year date)
+ (set-> date
+ (day 1)
+ (month 1)))
+
+(define-public (parse-freeform-date str)
+ (let* (((year month day) (map string->number (string-split str #\-))))
+ (date year: year month: month day: day)
+ ))
+
+(define-public (date-stream date-increment start-day)
+ (stream-iterate (lambda (d) (date+ d date-increment))
+ start-day))
+
+(define-public (day-stream start-day)
+ (date-stream (date day: 1) start-day))
+
+(define-public (month-stream start-day)
+ (date-stream (date month: 1) start-day))
+
+(define-public (week-stream start-day)
+ (date-stream (date day: 7) start-day))
+
+(define-public (time-min a b)
+ (if (time<? a b) a b))
+
+(define-public (time-max a b)
+ (if (time<? a b) b a))
+
+(define-public (date-min a b)
+ (if (date< a b) a b))
+
+(define-public (date-max a b)
+ (if (date< a b) b a))
+
+(define-public (datetime-min a b)
+ (if (datetime< a b) a b))
+
+(define-public (datetime-max a b)
+ (if (datetime< a b) b a))
+
+(define*-public (month+ date-object #:optional (change 1))
+ (date+ date-object (date month: change)))
+
+(define*-public (month- date-object #:optional (change 1))
+ (date- date-object (date month: change)))
+
+;; 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 week-start (make-parameter sun))
+
+(define-config week-start sun
+ "First day of week"
+ pre: (ensure (lambda (x) (<= sun x sat)))
+ post: week-start)
+
+;; given a date, returns the date the first week of that year starts on.
+;; @example
+;; (week-1-start #2020-01-01 mon)
+;; ⇒ 2019-12-30
+;; @end example
+(define*-public (week-1-start d optional: (wkst (week-start)))
+ (let* ((ystart (start-of-year d))
+ (day-index (modulo (- (week-day ystart) wkst) 7)))
+ (if (> day-index 3)
+ (date+ ystart (date day: (- 7 day-index)))
+ (date- ystart (date day: day-index)))))
+
+;; (week-number #2020-01-01 mon) ; => 1
+;; (week-number #2019-12-31 mon) ; => 1
+(define*-public (week-number d optional: (wkst (week-start)))
+ ;; Calculating week number for starts of week was much simpler.
+ ;; We can both skip the special cases for Jan 1, 2 & 3. It also
+ ;; solved some weird bug that was here before.
+
+ (let ((d (start-of-week d wkst)))
+ (cond
+ [(and (= 12 (month d))
+ (memv (day d) '(29 30 31))
+ (< (year d) (year (date+ (start-of-week d wkst)
+ (date day: 3)))))
+ 1]
+
+ [else
+ (let* ((w1-start (week-1-start d wkst))
+ (week day (floor/ (days-in-interval w1-start d)
+ 7)))
+ (1+ week))])))
+
+(define*-public (date-starting-week week-number d optional: (wkst (week-start)))
+ (date+ (week-1-start d wkst)
+ (date day: (* (1- week-number) 7))))
+
+
+(define*-public (week-day-name week-day-number optional: truncate-to
+ key: (locale %global-locale))
+
+ ;; NOTE this allows days larger than 7 (sunday if counting from monday).
+ (let ((str (catch 'out-of-range
+ (lambda () (locale-day (1+ (modulo week-day-number 7)) locale))
+ (lambda (oor str num) (scm-error 'out-of-range 'week-day-name
+ "~a == (~a % 7) + 1"
+ (list num week-day-number) (list week-day-number))))))
+ ;; I also know about the @var{locale-day-short} method, but I need
+ ;; strings of length 2.
+ (if truncate-to
+ (string-take str truncate-to)
+ str)))
+
+(define*-public (datetime->string datetime optional: (fmt "~Y-~m-~dT~H:~M:~S") key: allow-unknown?)
+ (define date (get-date datetime))
+ (define time ((@ (datetime) get-time%) datetime))
+ (with-output-to-string
+ (lambda ()
+ (fold (lambda (token state)
+ (case state
+ ((#\~)
+ (case token
+ ((#\~) (display "~"))
+ ((#\H) (format #t "~2'0d" (hour time)))
+ ((#\k) (format #t "~2' d" (hour time)))
+ ((#\M) (format #t "~2'0d" (minute time)))
+ ((#\S) (format #t "~2'0d" (second time)))
+ ((#\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
+ ((#\s) (display (datetime->unix-time datetime))) ; epoch time!
+ ((#\e) (format #t "~2' d" (day date)))
+ ((#\1) (format #t "~4'0d-~2'0d-~2'0d"
+ (year date) (month date) (day date)))
+ ((#\3) (format #t "~2'0d:~2'0d:~2'0d"
+ (hour time) (minute time) (second time)))
+ ((#\A) (display (week-day-name (week-day date))))
+ ((#\a) (display (week-day-name (week-day date) 3)))
+ ((#\b) (display (locale-month-short (month date))))
+ ((#\B) (display (locale-month (month date))))
+ ((#\Z) (when (equal? "UTC" (get-timezone datetime)) (display "Z")))
+ (else (unless allow-unknown?
+ (error 'datetime->string "Invalid format token ~a" token))))
+ #f)
+ (else (unless (char=? #\~ token) (display token)) token)))
+ #f
+ (string->list fmt)))))
+
+(define*-public (date->string date optional: (fmt "~Y-~m-~d") key: allow-unknown?)
+ (datetime->string (datetime date: date) fmt allow-unknown?: allow-unknown?))
+
+(define*-public (time->string time optional: (fmt "~H:~M:~S") key: allow-unknown?)
+ (datetime->string (datetime time: time) fmt allow-unknown?: allow-unknown?))
+
+
+;; @verbatim
+;; A B C D E ¬F
+;; |s1| : |s2| : |s1| : |s2| : : |s1|
+;; | | : | | : | ||s2| : |s1|| | : |s1||s2| : | |
+;; | ||s2| : |s1|| | : | || | : | || | : | || | :
+;; | | : | | : | || | : | || | : | || | : |s2|
+;; | | : | | : | | : | | : : | |
+;;
+;; Infinitely short ---+|s2| : |s1|+--- : two instants don't overlap
+;; events, overlap s1 : s2 :
+;; @end verbatim
+;;
+;; E is covered by both case A and B.
+(define-public (timespan-overlaps? s1-begin s1-end s2-begin s2-end)
+ "Return whetever or not two timespans overlap."
+ (or
+ ;; A
+ (and (date/-time<? s2-begin s1-end)
+ (date/-time<? s1-begin s2-end))
+
+ ;; B
+ (and (date/-time<? s1-begin s2-end)
+ (date/-time<? s2-begin s1-end))
+
+ ;; C
+ (and (date/-time<=? s1-begin s2-begin)
+ (date/-time<? s2-end s1-end))
+
+ ;; D
+ (and (date/-time<=? s2-begin s1-begin)
+ (date/-time<? s1-end s2-end))))
+
+(define-public (add-day d)
+ (date+ d (date day: 1)))
+
+(define-public (remove-day d)
+ (date- d (date day: 1)))
+
+(define-public (in-date-range? start-date end-date)
+ (lambda (date)
+ (date<= start-date date end-date)))
+
+;; Returns a list of the seven week days, with @var{week-start}
+;; as the beginning of the week.
+;; @example
+;; (weekday-list sun)
+;; => (0 1 2 3 4 5 6)
+;; @end example
+(define-public (weekday-list week-start)
+ (take (drop (apply circular-list (iota 7))
+ week-start)
+ 7))
+
+;; returns the date the week containing d started.
+;; (start-of-week #2020-04-02 sun) ; => 2020-03-29
+(define*-public (start-of-week d optional: (week-start (week-start)))
+ (date- d (date day: (modulo (- (week-day d)
+ week-start)
+ 7))))
+
+;; (end-of-week #2020-04-01 mon)
+;; => 2020-04-05
+(define*-public (end-of-week d optional: (week-start (week-start)))
+ (date+ (start-of-week d week-start)
+ (date day: 6)))
+
+
+;; Given a month and and which day the week starts on,
+;; returns three lists, which are:
+;; The days leading up to the current month, but share a week
+;; The days in the current month
+;; The days after the current month, but which shares a week.
+;;
+;; mars 2020
+;; må ti on to fr lö sö
+;; 1
+;; 2 3 4 5 6 7 8
+;; 9 10 11 12 13 14 15
+;; 16 17 18 19 20 21 22
+;; 23 24 25 26 27 28 29
+;; 30 31
+;; @lisp
+;; (month-days #2020-03-01 mon)
+;; ; ⇒ (2020-02-24 ... 2020-02-29)
+;; ; ⇒ (2020-03-01 ... 2020-03-31)
+;; ; ⇒ (2020-04-01 ... 2020-04-05)
+;; @end lisp
+;; Ignores day component of @var{date}.
+(define*-public (month-days date optional: (week-start (week-start)))
+ (let* ((month-len (days-in-month date))
+ (prev-month-len (days-in-month (month- date)))
+ (month-start (modulo (- (week-day date) week-start) 7)))
+ (values
+ (map (lambda (d) (set (day (month- date)) d))
+ (iota month-start (1+ (- prev-month-len month-start))))
+ (map (lambda (d) (set (day date) d)) (iota month-len 1))
+ (map (lambda (d) (set (day (month+ date)) d))
+ (iota (modulo (- (* 7 5) month-len month-start) 7) 1)))))
+
+
+
+
+(define-public (days-in-interval start-date end-date)
+ (let ((diff (date-difference (date+ end-date (date day: 1)) start-date)))
+ (with-streams
+ (fold + (day diff)
+ (map days-in-month
+ (take (+ (month diff)
+ (* 12 (year diff)))
+ (month-stream start-date)))))))
+
+;; Day from start of the year, so 1 feb would be day 32.
+;; Also known as Julian day.
+(define-public (year-day date)
+ (days-in-interval (start-of-year date) date))
+
+
+;; @example
+;; (time->decimal-hour #10:30:00) ; => 10.5
+;; @end example
+(define-public (time->decimal-hour time)
+ (exact->inexact (+ (hour time)
+ (/ (minute time) 60)
+ (/ (second time) 3600))))
+
+(define*-public (datetime->decimal-hour dt optional: start-date)
+
+ (let ((date-diff
+ (cond [start-date
+ (let* ((end-date (date+ start-date (get-date dt))))
+ (days-in-interval start-date end-date)) ]
+ [(or (not (zero? (month (get-date dt))))
+ (not (zero? (year (get-date dt)))))
+ (error "Multi-month intervals only supported when start-date is given" dt)]
+ [else (day (get-date dt))])))
+ (+ (time->decimal-hour ((@ (datetime) get-time%) dt))
+ (* (1- date-diff) 24))))
+
+;; Returns a list of all dates from start to end.
+;; both inclusive
+;; date, date → [list date]
+(define-public (date-range start end)
+ (stream->list
+ (stream-take-while (lambda (d) (date<= d end))
+ (day-stream start))))
+
+
+
+;; Returns the first instance of the given week-day after @var{d}.
+;; @example
+;; (find-first-week-day mon #2020-04-01)
+;; => #2020-04-06
+;; (find-first-week-day mon #2020-04-10)
+;; => #2020-04-13
+;; (find-first-week-day mon #2020-04-30)
+;; => #2020-05-04
+;; @end example
+(define-public (find-first-week-day wday d)
+ (let* ((start-day (week-day d))
+ (diff (- wday start-day)))
+ (date+ d (date day: (modulo diff 7)))))
+
+;; returns instances of the given week-day in month between
+;; month-date and end of month.
+;; @example
+;; (all-wday-in-month mon #2020-06-01)
+;; => (#2020-06-01 #2020-06-08 #2020-06-15 #2020-06-22 #2020-06-29)
+;; (all-wday-in-month mon #2020-06-10)
+;; => (#2020-06-15 #2020-06-22 #2020-06-29)
+;; @end example
+;; week-day, date → (list date)
+(define-public (all-wday-in-month wday month-date)
+ (stream->list
+ (stream-take-while
+ (lambda (d) (= (month d) (month month-date)))
+ (week-stream (find-first-week-day wday month-date)))))
+
+
+(define-public (all-wday-in-year wday year-date)
+ (stream->list
+ (stream-take-while
+ (lambda (d) (= (year d) (year year-date)))
+ (week-stream (find-first-week-day wday year-date)))))
diff --git a/module/datetime/timespec.scm b/module/datetime/timespec.scm
index ae8b3d9b..ddd8a164 100644
--- a/module/datetime/timespec.scm
+++ b/module/datetime/timespec.scm
@@ -7,7 +7,6 @@
:use-module (util)
:use-module (util exceptions)
:use-module (datetime)
- :use-module (datetime util)
:use-module (srfi srfi-1)
:use-module (srfi srfi-9 gnu)
)
diff --git a/module/datetime/util.scm b/module/datetime/util.scm
deleted file mode 100644
index f525f680..00000000
--- a/module/datetime/util.scm
+++ /dev/null
@@ -1,389 +0,0 @@
-(define-module (datetime util)
- :use-module (datetime)
- :use-module (srfi srfi-1)
- :use-module (srfi srfi-26)
- :use-module (srfi srfi-41)
- :use-module (srfi srfi-41 util)
- :use-module (ice-9 i18n)
- :use-module (ice-9 format)
- :use-module (util)
- :use-module (util config)
- :re-export (locale-month)
- )
-
-(define-public (start-of-month date)
- (set (day date) 1))
-
-(define-public (end-of-month date)
- (set (day date) (days-in-month date)))
-
-(define-public (start-of-year date)
- (set-> date
- (day 1)
- (month 1)))
-
-(define-public (parse-freeform-date str)
- (let* (((year month day) (map string->number (string-split str #\-))))
- (date year: year month: month day: day)
- ))
-
-(define-public (date-stream date-increment start-day)
- (stream-iterate (cut date+ <> date-increment)
- start-day))
-
-(define-public (day-stream start-day)
- (date-stream (date day: 1) start-day))
-
-(define-public (month-stream start-day)
- (date-stream (date month: 1) start-day))
-
-(define-public (week-stream start-day)
- (date-stream (date day: 7) start-day))
-
-(define-public (time-min a b)
- (if (time<? a b) a b))
-
-(define-public (time-max a b)
- (if (time<? a b) b a))
-
-(define-public (date-min a b)
- (if (date< a b) a b))
-
-(define-public (date-max a b)
- (if (date< a b) b a))
-
-(define-public (datetime-min a b)
- (if (datetime< a b) a b))
-
-(define-public (datetime-max a b)
- (if (datetime< a b) b a))
-
-(define*-public (month+ date-object #:optional (change 1))
- (date+ date-object (date month: change)))
-
-(define*-public (month- date-object #:optional (change 1))
- (date- date-object (date month: change)))
-
-;; 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 week-start (make-parameter sun))
-
-(define-config week-start sun
- "First day of week"
- pre: (ensure (lambda (x) (<= sun x sat)))
- post: week-start)
-
-;; given a date, returns the date the first week of that year starts on.
-;; @example
-;; (week-1-start #2020-01-01 mon)
-;; ⇒ 2019-12-30
-;; @end example
-(define*-public (week-1-start d optional: (wkst (week-start)))
- (let* ((ystart (start-of-year d))
- (day-index (modulo (- (week-day ystart) wkst) 7)))
- (if (> day-index 3)
- (date+ ystart (date day: (- 7 day-index)))
- (date- ystart (date day: day-index)))))
-
-;; (week-number #2020-01-01 mon) ; => 1
-;; (week-number #2019-12-31 mon) ; => 1
-(define*-public (week-number d optional: (wkst (week-start)))
- ;; Calculating week number for starts of week was much simpler.
- ;; We can both skip the special cases for Jan 1, 2 & 3. It also
- ;; solved some weird bug that was here before.
-
- (let ((d (start-of-week d wkst)))
- (cond
- [(and (= 12 (month d))
- (memv (day d) '(29 30 31))
- (< (year d) (year (date+ (start-of-week d wkst)
- (date day: 3)))))
- 1]
-
- [else
- (let* ((w1-start (week-1-start d wkst))
- (week day (floor/ (days-in-interval w1-start d)
- 7)))
- (1+ week))])))
-
-(define*-public (date-starting-week week-number d optional: (wkst (week-start)))
- (date+ (week-1-start d wkst)
- (date day: (* (1- week-number) 7))))
-
-
-(define*-public (week-day-name week-day-number optional: truncate-to
- key: (locale %global-locale))
-
- ;; NOTE this allows days larger than 7 (sunday if counting from monday).
- (let ((str (catch 'out-of-range
- (lambda () (locale-day (1+ (modulo week-day-number 7)) locale))
- (lambda (oor str num) (scm-error 'out-of-range 'week-day-name
- "~a == (~a % 7) + 1"
- (list num week-day-number) (list week-day-number))))))
- ;; I also know about the @var{locale-day-short} method, but I need
- ;; strings of length 2.
- (if truncate-to
- (string-take str truncate-to)
- str)))
-
-(define*-public (datetime->string datetime optional: (fmt "~Y-~m-~dT~H:~M:~S") key: allow-unknown?)
- (define date (get-date datetime))
- (define time ((@ (datetime) get-time%) datetime))
- (with-output-to-string
- (lambda ()
- (fold (lambda (token state)
- (case state
- ((#\~)
- (case token
- ((#\~) (display "~"))
- ((#\H) (format #t "~2'0d" (hour time)))
- ((#\k) (format #t "~2' d" (hour time)))
- ((#\M) (format #t "~2'0d" (minute time)))
- ((#\S) (format #t "~2'0d" (second time)))
- ((#\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
- ((#\s) (display (datetime->unix-time datetime))) ; epoch time!
- ((#\e) (format #t "~2' d" (day date)))
- ((#\1) (format #t "~4'0d-~2'0d-~2'0d"
- (year date) (month date) (day date)))
- ((#\3) (format #t "~2'0d:~2'0d:~2'0d"
- (hour time) (minute time) (second time)))
- ((#\A) (display (week-day-name (week-day date))))
- ((#\a) (display (week-day-name (week-day date) 3)))
- ((#\b) (display (locale-month-short (month date))))
- ((#\B) (display (locale-month (month date))))
- ((#\Z) (when (equal? "UTC" (get-timezone datetime)) (display "Z")))
- (else (unless allow-unknown?
- (error 'datetime->string "Invalid format token ~a" token))))
- #f)
- (else (unless (char=? #\~ token) (display token)) token)))
- #f
- (string->list fmt)))))
-
-(define*-public (date->string date optional: (fmt "~Y-~m-~d") key: allow-unknown?)
- (datetime->string (datetime date: date) fmt allow-unknown?: allow-unknown?))
-
-(define*-public (time->string time optional: (fmt "~H:~M:~S") key: allow-unknown?)
- (datetime->string (datetime time: time) fmt allow-unknown?: allow-unknown?))
-
-
-;; @verbatim
-;; A B C D E ¬F
-;; |s1| : |s2| : |s1| : |s2| : : |s1|
-;; | | : | | : | ||s2| : |s1|| | : |s1||s2| : | |
-;; | ||s2| : |s1|| | : | || | : | || | : | || | :
-;; | | : | | : | || | : | || | : | || | : |s2|
-;; | | : | | : | | : | | : : | |
-;;
-;; Infinitely short ---+|s2| : |s1|+--- : two instants don't overlap
-;; events, overlap s1 : s2 :
-;; @end verbatim
-;;
-;; E is covered by both case A and B.
-(define-public (timespan-overlaps? s1-begin s1-end s2-begin s2-end)
- "Return whetever or not two timespans overlap."
- (or
- ;; A
- (and (date/-time<? s2-begin s1-end)
- (date/-time<? s1-begin s2-end))
-
- ;; B
- (and (date/-time<? s1-begin s2-end)
- (date/-time<? s2-begin s1-end))
-
- ;; C
- (and (date/-time<=? s1-begin s2-begin)
- (date/-time<? s2-end s1-end))
-
- ;; D
- (and (date/-time<=? s2-begin s1-begin)
- (date/-time<? s1-end s2-end))))
-
-(define-public (add-day d)
- (date+ d (date day: 1)))
-
-(define-public (remove-day d)
- (date- d (date day: 1)))
-
-(define-public (in-date-range? start-date end-date)
- (lambda (date)
- (date<= start-date date end-date)))
-
-;; Returns a list of the seven week days, with @var{week-start}
-;; as the beginning of the week.
-;; @example
-;; (weekday-list sun)
-;; => (0 1 2 3 4 5 6)
-;; @end example
-(define-public (weekday-list week-start)
- (take (drop (apply circular-list (iota 7))
- week-start)
- 7))
-
-;; returns the date the week containing d started.
-;; (start-of-week #2020-04-02 sun) ; => 2020-03-29
-(define*-public (start-of-week d optional: (week-start (week-start)))
- (date- d (date day: (modulo (- (week-day d)
- week-start)
- 7))))
-
-;; (end-of-week #2020-04-01 mon)
-;; => 2020-04-05
-(define*-public (end-of-week d optional: (week-start (week-start)))
- (date+ (start-of-week d week-start)
- (date day: 6)))
-
-
-;; Given a month and and which day the week starts on,
-;; returns three lists, which are:
-;; The days leading up to the current month, but share a week
-;; The days in the current month
-;; The days after the current month, but which shares a week.
-;;
-;; mars 2020
-;; må ti on to fr lö sö
-;; 1
-;; 2 3 4 5 6 7 8
-;; 9 10 11 12 13 14 15
-;; 16 17 18 19 20 21 22
-;; 23 24 25 26 27 28 29
-;; 30 31
-;; @lisp
-;; (month-days #2020-03-01 mon)
-;; ; ⇒ (2020-02-24 ... 2020-02-29)
-;; ; ⇒ (2020-03-01 ... 2020-03-31)
-;; ; ⇒ (2020-04-01 ... 2020-04-05)
-;; @end lisp
-;; Ignores day component of @var{date}.
-(define*-public (month-days date optional: (week-start (week-start)))
- (let* ((month-len (days-in-month date))
- (prev-month-len (days-in-month (month- date)))
- (month-start (modulo (- (week-day date) week-start) 7)))
- (values
- (map (lambda (d) (set (day (month- date)) d))
- (iota month-start (1+ (- prev-month-len month-start))))
- (map (lambda (d) (set (day date) d)) (iota month-len 1))
- (map (lambda (d) (set (day (month+ date)) d))
- (iota (modulo (- (* 7 5) month-len month-start) 7) 1)))))
-
-
-
-
-(define-public (days-in-interval start-date end-date)
- (let ((diff (date-difference (date+ end-date (date day: 1)) start-date)))
- (with-streams
- (fold + (day diff)
- (map days-in-month
- (take (+ (month diff)
- (* 12 (year diff)))
- (month-stream start-date)))))))
-
-;; Day from start of the year, so 1 feb would be day 32.
-;; Also known as Julian day.
-(define-public (year-day date)
- (days-in-interval (start-of-year date) date))
-
-
-;; @example
-;; (time->decimal-hour #10:30:00) ; => 10.5
-;; @end example
-(define-public (time->decimal-hour time)
- (exact->inexact (+ (hour time)
- (/ (minute time) 60)
- (/ (second time) 3600))))
-
-(define*-public (datetime->decimal-hour dt optional: start-date)
-
- (let ((date-diff
- (cond [start-date
- (let* ((end-date (date+ start-date (get-date dt))))
- (days-in-interval start-date end-date)) ]
- [(or (not (zero? (month (get-date dt))))
- (not (zero? (year (get-date dt)))))
- (error "Multi-month intervals only supported when start-date is given" dt)]
- [else (day (get-date dt))])))
- (+ (time->decimal-hour ((@ (datetime) get-time%) dt))
- (* (1- date-diff) 24))))
-
-;; Returns a list of all dates from start to end.
-;; both inclusive
-;; date, date → [list date]
-(define-public (date-range start end)
- (stream->list
- (stream-take-while (lambda (d) (date<= d end))
- (day-stream start))))
-
-
-
-;; Returns the first instance of the given week-day after @var{d}.
-;; @example
-;; (find-first-week-day mon #2020-04-01)
-;; => #2020-04-06
-;; (find-first-week-day mon #2020-04-10)
-;; => #2020-04-13
-;; (find-first-week-day mon #2020-04-30)
-;; => #2020-05-04
-;; @end example
-(define-public (find-first-week-day wday d)
- (let* ((start-day (week-day d))
- (diff (- wday start-day)))
- (date+ d (date day: (modulo diff 7)))))
-
-;; returns instances of the given week-day in month between
-;; month-date and end of month.
-;; @example
-;; (all-wday-in-month mon #2020-06-01)
-;; => (#2020-06-01 #2020-06-08 #2020-06-15 #2020-06-22 #2020-06-29)
-;; (all-wday-in-month mon #2020-06-10)
-;; => (#2020-06-15 #2020-06-22 #2020-06-29)
-;; @end example
-;; week-day, date → (list date)
-(define-public (all-wday-in-month wday month-date)
- (stream->list
- (stream-take-while
- (lambda (d) (= (month d) (month month-date)))
- (week-stream (find-first-week-day wday month-date)))))
-
-
-(define-public (all-wday-in-year wday year-date)
- (stream->list
- (stream-take-while
- (lambda (d) (= (year d) (year year-date)))
- (week-stream (find-first-week-day wday year-date)))))
diff --git a/module/datetime/zic.scm b/module/datetime/zic.scm
index 8035570a..37051945 100644
--- a/module/datetime/zic.scm
+++ b/module/datetime/zic.scm
@@ -12,7 +12,6 @@
:use-module (util)
:use-module (util exceptions)
:use-module (datetime)
- :use-module (datetime util)
:use-module (datetime timespec)
:use-module (ice-9 rdelim)
:use-module (srfi srfi-1)
diff --git a/module/entry-points/html.scm b/module/entry-points/html.scm
index e58cbddd..e30dc7c1 100644
--- a/module/entry-points/html.scm
+++ b/module/entry-points/html.scm
@@ -7,7 +7,6 @@
:use-module (util options)
;; :use-module (vcomponent)
:use-module (datetime)
- :use-module (datetime util)
:use-module (ice-9 getopt-long)
)
diff --git a/module/entry-points/ical.scm b/module/entry-points/ical.scm
index 0583be49..997621b2 100644
--- a/module/entry-points/ical.scm
+++ b/module/entry-points/ical.scm
@@ -5,7 +5,6 @@
:use-module (output ical)
:use-module (ice-9 getopt-long)
:use-module (datetime)
- :use-module (datetime util)
)
(define opt-spec
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm
index aaff398e..bd30033b 100644
--- a/module/entry-points/server.scm
+++ b/module/entry-points/server.scm
@@ -29,7 +29,6 @@
:use-module (vcomponent)
:use-module (datetime)
- :use-module (datetime util)
:use-module (output html)
:use-module (output ical)
diff --git a/module/entry-points/terminal.scm b/module/entry-points/terminal.scm
index 7f816e94..d44fb1e8 100644
--- a/module/entry-points/terminal.scm
+++ b/module/entry-points/terminal.scm
@@ -4,7 +4,6 @@
:use-module (vcomponent)
:use-module (ice-9 getopt-long)
:use-module (datetime)
- :use-module (datetime util)
:use-module (vulgar)
:use-module (util options)
)
diff --git a/module/main.scm b/module/main.scm
index 4067bd82..9fe9d8c6 100644
--- a/module/main.scm
+++ b/module/main.scm
@@ -194,7 +194,7 @@
(format (logport) "<?xml version=\"1.0\" encoding=\"UTF-8\"?>~%"))
(format (logport) "<run><start>~a</start>~%"
- ((@ (datetime util) datetime->string)
+ ((@ (datetime) datetime->string)
((@ (datetime) current-datetime))))
(report-time! "Program start")
;; ((@ (util config) print-configuration-documentation))
diff --git a/module/output/html.scm b/module/output/html.scm
index f462db56..df255a25 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -13,7 +13,6 @@
#:use-module (util tree)
#:duplicates (last)
#:use-module (datetime)
- #:use-module (datetime util)
#:use-module (output general)
#:use-module (ice-9 curried-definitions)
#:use-module (ice-9 match)
diff --git a/module/output/ical.scm b/module/output/ical.scm
index 7e514c99..4822bf4a 100644
--- a/module/output/ical.scm
+++ b/module/output/ical.scm
@@ -8,7 +8,6 @@
:use-module (vcomponent datetime)
:use-module (srfi srfi-1)
:use-module (datetime)
- :use-module (datetime util)
:use-module (srfi srfi-41)
:use-module (srfi srfi-41 util)
:use-module (datetime zic)
diff --git a/module/output/sxml-types.scm b/module/output/sxml-types.scm
index bd7253fd..86859ce1 100644
--- a/module/output/sxml-types.scm
+++ b/module/output/sxml-types.scm
@@ -2,7 +2,6 @@
:use-module (util)
:use-module (output types)
:use-module (datetime)
- :use-module (datetime util)
:use-module (output common)
)
diff --git a/module/output/terminal.scm b/module/output/terminal.scm
index 14777437..c5c1323d 100644
--- a/module/output/terminal.scm
+++ b/module/output/terminal.scm
@@ -2,7 +2,6 @@
#:use-module (output general)
#:use-module (srfi srfi-1)
#:use-module (datetime)
- #:use-module (datetime util)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-41)
#:use-module (srfi srfi-41 util)
diff --git a/module/output/types.scm b/module/output/types.scm
index e5829ccf..8eff2ee6 100644
--- a/module/output/types.scm
+++ b/module/output/types.scm
@@ -3,8 +3,7 @@
:use-module (util)
:use-module (util exceptions)
:use-module (util base64)
- :use-module (datetime)
- :use-module (datetime util))
+ :use-module (datetime))
(define (write-binary _ value)
diff --git a/module/output/xcal.scm b/module/output/xcal.scm
index eb244921..425865a5 100644
--- a/module/output/xcal.scm
+++ b/module/output/xcal.scm
@@ -7,7 +7,6 @@
:use-module (ice-9 match)
:use-module (output common)
:use-module (datetime)
- :use-module (datetime util)
:use-module (srfi srfi-1)
)
diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index 0020b864..f9d04d35 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -6,7 +6,6 @@
:use-module (srfi srfi-41)
:use-module (srfi srfi-41 util)
:use-module (datetime)
- :use-module (datetime util)
:use-module (vcomponent base)
:use-module (vcomponent parse)
:use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?))
diff --git a/module/vcomponent/datetime.scm b/module/vcomponent/datetime.scm
index 85b37d6d..3f81c359 100644
--- a/module/vcomponent/datetime.scm
+++ b/module/vcomponent/datetime.scm
@@ -3,7 +3,6 @@
#:use-module (vcomponent base)
#:use-module (datetime)
#:use-module (datetime timespec)
- #:use-module (datetime util)
#:use-module (datetime zic)
#:use-module (util)
diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm
index 76aed2fd..d23787ef 100644
--- a/module/vcomponent/group.scm
+++ b/module/vcomponent/group.scm
@@ -2,7 +2,6 @@
#:use-module (vcomponent)
#:use-module (vcomponent datetime)
#:use-module (datetime)
- #:use-module (datetime util)
#:use-module (srfi srfi-41)
#:use-module (srfi srfi-41 util)
#:export (group-stream get-groups-between))
diff --git a/module/vcomponent/recurrence/display.scm b/module/vcomponent/recurrence/display.scm
index ff47d104..1df95d0b 100644
--- a/module/vcomponent/recurrence/display.scm
+++ b/module/vcomponent/recurrence/display.scm
@@ -10,8 +10,11 @@
:use-module (vcomponent recurrence internal)
:use-module (text util)
:use-module (text numbers)
- :use-module ((datetime) :select (time))
- :use-module (datetime util)
+ :use-module ((datetime) :select (time time->string
+ datetime->string
+ week-day-name
+ locale-month
+ ))
)
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index 3da26272..711f51ec 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -10,7 +10,6 @@
:use-module (vcomponent recurrence parse)
:use-module (datetime)
- :use-module (datetime util)
:use-module (ice-9 curried-definitions) )
diff --git a/module/vcomponent/recurrence/internal.scm b/module/vcomponent/recurrence/internal.scm
index 40195895..ec8c10d4 100644
--- a/module/vcomponent/recurrence/internal.scm
+++ b/module/vcomponent/recurrence/internal.scm
@@ -3,7 +3,6 @@
#:use-module (srfi srfi-88) ; better keywords
#:use-module ((vcomponent base) :select (prop))
- #:use-module (datetime util)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (util)
diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm
index efcf984c..a6a3ef9c 100644
--- a/module/vcomponent/recurrence/parse.scm
+++ b/module/vcomponent/recurrence/parse.scm
@@ -5,7 +5,6 @@
#:use-module (srfi srfi-1)
#:use-module (datetime)
- #:use-module (datetime util)
#:use-module (srfi srfi-26)
#:use-module (vcomponent recurrence internal)
#:use-module (util)
diff --git a/module/vulgar/termios.scm b/module/vulgar/termios.scm
index 554e09da..3fe82f92 100644
--- a/module/vulgar/termios.scm
+++ b/module/vulgar/termios.scm
@@ -132,7 +132,7 @@
(define-once lib (dynamic-link))
-(define-foreign (tcsetattr int *) → int
+(define-foreign (tcsetattr int int *) → int
(dynamic-func "tcsetattr" lib))
(define* (tcsetattr! termios #:optional
diff --git a/tests/datetime-util.scm b/tests/datetime-util.scm
index 80a8df5e..123229c7 100644
--- a/tests/datetime-util.scm
+++ b/tests/datetime-util.scm
@@ -1,5 +1,5 @@
-(((datetime) date time datetime)
- ((datetime util) month-stream in-date-range? timespan-overlaps?)
+(((datetime) date time datetime
+ month-stream in-date-range? timespan-overlaps?)
((srfi srfi-41) stream->list stream-take
))
diff --git a/tests/recurrence-rule.scm b/tests/recurrence-rule.scm
index 303b4547..58daaa9b 100644
--- a/tests/recurrence-rule.scm
+++ b/tests/recurrence-rule.scm
@@ -1,7 +1,7 @@
(((vcomponent recurrence parse) parse-recurrence-rule)
((vcomponent recurrence internal)
make-recur-rule weekdays intervals)
- ((datetime util) mon))
+ ((datetime) mon))
(test-equal
diff --git a/tests/recurrence.scm b/tests/recurrence.scm
index fad8e7dc..a3720ce8 100644
--- a/tests/recurrence.scm
+++ b/tests/recurrence.scm
@@ -10,7 +10,8 @@
((vcomponent recurrence display) format-recurrence-rule)
((vcomponent recurrence internal) count until)
((vcomponent base) make-vcomponent prop prop* extract)
- ((datetime) parse-ics-datetime datetime time date)
+ ((datetime) parse-ics-datetime datetime time date
+ datetime->string)
((util) -> mod!)
((guile) set!)
((srfi srfi-41) stream->list)
diff --git a/tests/recurring.scm b/tests/recurring.scm
index 3922f1b6..a6b60dc7 100644
--- a/tests/recurring.scm
+++ b/tests/recurring.scm
@@ -1,5 +1,5 @@
(((srfi srfi-41) stream-take stream-map stream->list stream-car)
- ((datetime util) day-stream)
+ ((datetime) day-stream)
((vcomponent base) extract prop)
((vcomponent) parse-calendar)
diff --git a/tests/rrule-parse.scm b/tests/rrule-parse.scm
index 12ba93fd..c10266aa 100644
--- a/tests/rrule-parse.scm
+++ b/tests/rrule-parse.scm
@@ -1,7 +1,7 @@
(((vcomponent recurrence parse)
parse-recurrence-rule)
((vcomponent recurrence) make-recur-rule)
- ((datetime util) mon)
+ ((datetime) mon)
((util exceptions) warnings-are-errors warning-handler)
)