Fix normalization in (datetime util).

2 files changed, 21 insertions, 20 deletions

diff --git a/module/datetime/util.scm b/module/datetime/util.scm
index a7af4a5a..8645c9f4 100644
--- a/module/datetime/util.scm
+++ b/module/datetime/util.scm
@@ -351,25 +351,28 @@
 
 
 
-;; TODO normalize if functions floor their arguments or not.
-;; The argument for flooring is that it allows us to only bother with
-;; the higher components we care about.
-;; The argument against would be if we want to start from the middle
-;; of a time span.
-
-
-;; Returns the first instance of the given week-day in the given month.
+;; 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-06
+;; => #2020-04-13
+;; (find-first-week-day mon #2020-04-30)
+;; => #2020-05-04
 ;; @end example
-(define-public (find-first-week-day wday month-date)
-  (let* ((mstart (start-of-month month-date))
-         (start-day (week-day mstart))
+(define-public (find-first-week-day wday d)
+  (let* ((start-day (week-day d))
          (diff (- wday start-day)))
-    (date+ mstart (date day: (modulo diff 7)))))
+    (date+ d (date day: (modulo diff 7)))))
 
-;; returns instances of the given week-day in month.
+;; 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
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index 5a4ef80b..53de1726 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -152,7 +152,7 @@
                (concatenate
                 (map (lambda (wday)
                        (all-wday-in-month
-                        wday (set (month d) value)))
+                        wday (start-of-month (set (month d) value))))
                      (map cdr (byday rrule)))))
 
               ;; else
@@ -168,9 +168,7 @@
                                                 7))))]
 
               [(MONTHLY)
-               ;; TODO should there be a (start-of-month d)
-               ;; istead of juts d
-               (let* ((instances (all-wday-in-month value d)))
+               (let* ((instances (all-wday-in-month value (start-of-month d))))
                  (catch 'out-of-range
                    (lambda ()
                      (cond [(eqv? #f offset)
@@ -312,11 +310,11 @@
     (limiters->predicate (all-limiters rrule))
     date-stream)))
 
-(define-stream (generate-posibilities rrule base-date)
+(define-stream (generate-posibilities rrule start-date)
   (limit-recurrence-set
    rrule
    (extend-recurrence-set
-    rrule base-date)))
+    rrule start-date)))
 
 (define-stream (rrule-instances event)
   (define rrule (attr event 'RRULE))