diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-05-21 21:40:52 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-05-21 21:40:52 +0200 |
commit | c7b559946677ad709e207df0893b4c9ebdae49f8 (patch) | |
tree | 1bb57717b64457367585bcbded52932487c32726 | |
parent | Move new recurrence generator to generate.scm. (diff) | |
download | calp-c7b559946677ad709e207df0893b4c9ebdae49f8.tar.gz calp-c7b559946677ad709e207df0893b4c9ebdae49f8.tar.xz |
Add week-start parameter.
Diffstat (limited to '')
-rw-r--r-- | module/datetime/util.scm | 21 |
1 files changed, 11 insertions, 10 deletions
diff --git a/module/datetime/util.scm b/module/datetime/util.scm index 83d93e7f..ed954b43 100644 --- a/module/datetime/util.scm +++ b/module/datetime/util.scm @@ -101,14 +101,18 @@ ) -;; TODO parameter for default week start? +(define-config week-start sun + "First day of week" + (lambda (x) (<= sun x sat))) + +(define-public week-start (make-parameter sun)) ;; 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 sun)) +(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) @@ -117,7 +121,7 @@ ;; (week-number #2020-01-01 mon) ; => 1 ;; (week-number #2019-12-31 mon) ; => 1 -(define*-public (week-number d optional: (wkst sun)) +(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. @@ -136,7 +140,7 @@ 7))) (1+ week))]))) -(define*-public (date-starting-week week-number d optional: (wkst sun)) +(define*-public (date-starting-week week-number d optional: (wkst (week-start))) (date+ (week-1-start d wkst) (date day: (* (1- week-number) 7)))) @@ -261,14 +265,14 @@ ;; 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 mon)) +(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 mon)) +(define*-public (end-of-week d optional: (week-start (week-start))) (date+ (start-of-week d week-start) (date day: 6))) @@ -292,7 +296,7 @@ ;; => (2020-03-01 ... 2020-03-31) ;; => (2020-04-01 ... 2020-04-05) ;; TODO Currently givining a non-start-of-month date for @var{date} is an error. -(define-public (month-days date week-start) +(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))) @@ -350,9 +354,6 @@ (stream-take-while (lambda (d) (date<= d end)) (day-stream start)))) -(define-config week-start sun - "First day of week" - (lambda (x) (<= sun x sat))) ;; TODO normalize if functions floor their arguments or not. |