Remove (add|remove)-day, and month[+-].

Procedures where overly specific, and doing it manually was almost no
more work.

12 files changed, 30 insertions, 79 deletions

diff --git a/doc/ref/guile/datetime.texi b/doc/ref/guile/datetime.texi
index d49c4ada..037ac8d5 100644
--- a/doc/ref/guile/datetime.texi
+++ b/doc/ref/guile/datetime.texi
@@ -282,11 +282,6 @@ Returns a stream of each week from @var{start-day}
 Returns the smaller (or larger) of @var{a} or @var{b}.
 @end defun
 
-@defun month+ date [change=1]
-@defunx month- date [change=1]
-Equivalent to @code{(date+ date (date month: change))}.
-@end defun
-
 @defun week-day date
 Returns an integer representing the week day of @var{date}.
 @ref{sunday}
@@ -355,11 +350,6 @@ month-date and end of month.
 Returns a list of all instances of @var{week-day} in @var{year-date}.
 @end defun
 
-@defun add-day date
-@defunx remove-day date
-@code{@var{date} ± (date day: 1)}
-@end defun
-
 @defun in-date-range? start-date end-date → date → boolean
 Returns a predicate procedure, which checks if a given date is between
 @var{start-date} and @var{end-date}.
diff --git a/module/calp/entry-points/html.scm b/module/calp/entry-points/html.scm
index a324305b..2aa7e0e2 100644
--- a/module/calp/entry-points/html.scm
+++ b/module/calp/entry-points/html.scm
@@ -122,7 +122,8 @@ for embedding in a larger page. Currently only applies to the <i>small</i> style
                                 next-start: (lambda (d) (date+ d chunk-length))
                                 prev-start: (lambda (d) (date- d chunk-length))
                                 start-date: start-date
-                                end-date: (remove-day (date+ start-date chunk-length))
+                                end-date: (date- (date+ start-date chunk-length)
+                                                 (date day: 1))
                                 render-calendar: render-calendar
                                 extra-args))))))
    (stream-take count (date-stream chunk-length start-date))
diff --git a/module/calp/html/caltable.scm b/module/calp/html/caltable.scm
index efaf8871..2c027c35 100644
--- a/module/calp/html/caltable.scm
+++ b/module/calp/html/caltable.scm
@@ -85,7 +85,7 @@
                                 (lambda (d) (date<= d date (next-start d)))
                                 start-date))
                              "#" ,(date-link date)))))
-               (date-range pre-start (remove-day start-date)))
+               (date-range pre-start (date- start-date (date day: 1))))
 
 
         ,@(map (td (lambda (date) `((href "#" ,(date-link date)))))
@@ -101,4 +101,4 @@
                                 (lambda (d) (and (date<= d date)
                                             (date< date (next-start d))))
                                 start-date)) "#" ,(date-link date)))))
-               (date-range (add-day end-date) post-end))))
+               (date-range (date+ end-date (date day: 1)) post-end))))
diff --git a/module/calp/html/view/calendar/month.scm b/module/calp/html/view/calendar/month.scm
index d7cd24ae..1d151c77 100644
--- a/module/calp/html/view/calendar/month.scm
+++ b/module/calp/html/view/calendar/month.scm
@@ -59,7 +59,7 @@
                             (style "grid-area: long " ,i ";"
                                    "grid-column: 1 / span 7;")
                             (data-start ,(date->string s))
-                            (data-end ,(date->string (add-day e))))
+                            (data-end ,(date->string (date+ e (date day: 1)))))
                          ,@(lay-out-long-events
                             s e events))))
                 long-event-groups
@@ -76,7 +76,7 @@
                `(div (@ (style "grid-area:short " ,i)
                         (class "cal-cell cal-cell-short event-container")
                         (data-start ,(date->string day-date))
-                        (data-end ,(date->string (add-day day-date))))
+                        (data-end ,(date->string (date+ day-date (date day: 1)))))
                      (div (@ (style "overflow-y:auto;"))
                       ,@(map make-small-block (stream->list events)))))
              short-event-groups
diff --git a/module/calp/html/view/calendar/week.scm b/module/calp/html/view/calendar/week.scm
index ef630c36..caad8912 100644
--- a/module/calp/html/view/calendar/week.scm
+++ b/module/calp/html/view/calendar/week.scm
@@ -43,7 +43,7 @@
                 ,@(time-marker-div)
                 (div (@ (class "longevents event-container")
                         (data-start ,(date->string start-date) )
-                        (data-end ,(date->string (add-day end-date)) )
+                        (data-end ,(date->string (date+ end-date (date day: 1))) )
                         (style "grid-column-end: span " ,(days-in-interval start-date end-date)))
                      ,@(lay-out-long-events start-date end-date long-events))
                 ,@(map (lambda (day-date)
@@ -139,7 +139,7 @@
 
     `(div (@ (class "events event-container") (id ,(date-link day-date))
              (data-start ,(date->string day-date))
-             (data-end ,(date->string (add-day day-date)) ))
+             (data-end ,(date->string (date+ day-date (date day: 1))) ))
           ,@(map (lambda (time)
                    `(div (@ (class "clock clock-" ,time))))
                  (iota 12 0 2))
diff --git a/module/calp/html/view/small-calendar.scm b/module/calp/html/view/small-calendar.scm
index 4d40c57c..06a3342f 100644
--- a/module/calp/html/view/small-calendar.scm
+++ b/module/calp/html/view/small-calendar.scm
@@ -1,16 +1,17 @@
 (define-module (calp html view small-calendar)
   :use-module ((calp html components) :select (xhtml-doc include-css))
   :use-module ((calp html caltable) :select (cal-table))
-  :use-module ((datetime) :select (month- month+ remove-day date->string))
+  :use-module ((datetime) :select (date date+ date- date->string))
   :export (render-small-calendar)
   )
 
 (define (render-small-calendar month standalone)
   (define table (cal-table
                  start-date: month
-                 end-date: (remove-day (month+ month))
-                 next-start: month+
-                 prev-start: month-
+                 end-date: (date- (date+ month (date month: 1))
+                                  (date day: 1))
+                 next-start: (lambda (d) (date+ d (date day: 7)))
+                 prev-start: (lambda (d) (date- d (date day: 7)))
                  ))
   (if standalone
       (xhtml-doc
diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm
index 1fc31333..44fac7e8 100644
--- a/module/calp/server/routes.scm
+++ b/module/calp/server/routes.scm
@@ -175,10 +175,10 @@
                        (html-generate calendars: (get-calendars global-event-object)
                                       events: (get-event-set global-event-object)
                                       start-date: start-date
-                                      end-date: (date- (month+ start-date)
+                                      end-date: (date- (date+ start-date (date month: 1))
                                                        (date day: 1))
-                                      next-start: month+
-                                      prev-start: month-
+                                      next-start: (lambda (d) (date+ d (date month: 1)))
+                                      prev-start: (lambda (d) (date- d (date month: 1)))
                                       render-calendar: (@ (calp html view calendar month)
                                                           render-calendar-table)
                                       pre-start: (start-of-week start-date)
diff --git a/module/calp/terminal.scm b/module/calp/terminal.scm
index 8f1b7fa9..ee3b7bc4 100644
--- a/module/calp/terminal.scm
+++ b/module/calp/terminal.scm
@@ -191,12 +191,12 @@
 
   (case char
     ((#\L #\l right)
-     (set! (current-page this) = add-day
+     (set! (current-page this) = (date+ (date day: 1))
            (cached-events this) #f
            (active-element this) 0))
 
     ((#\h #\H left)
-     (set! (current-page this) = remove-day
+     (set! (current-page this) = (date- (date day: 1))
            (cached-events this) #f
            (active-element this) 0))
 
diff --git a/module/datetime.scm b/module/datetime.scm
index e3d0a462..de1b3076 100644
--- a/module/datetime.scm
+++ b/module/datetime.scm
@@ -66,9 +66,6 @@
            datetime-min
            datetime-max
 
-           month+
-           month-
-
            week-day
            week-1-start
            week-number
@@ -79,8 +76,6 @@
            find-first-week-day
            all-wday-in-month
            all-wday-in-year
-           add-day
-           remove-day
            in-date-range?
 
            weekday-list
@@ -421,12 +416,6 @@
 (define (datetime-max a b)
   (if (datetime< a b) b a))
 
-(define* (month+ date-object optional: (change 1))
-  (date+ date-object (date month: change)))
-
-(define* (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,
@@ -575,11 +564,6 @@
     (lambda (d) (= (year d) (year year-date)))
     (week-stream (find-first-week-day wday year-date)))))
 
-(define (add-day d)
-  (date+ d (date day: 1)))
-
-(define (remove-day d)
-  (date- d (date day: 1)))
 
 (define (in-date-range? start-date end-date)
   (lambda (date)
@@ -631,15 +615,15 @@
 ;; ; ⇒ (2020-04-01 ... 2020-04-05)
 ;; @end lisp
 ;; Ignores day component of @var{date}.
-(define* (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)))
+(define* (month-days date* optional: (week-start (week-start)))
+  (let* ((month-len (days-in-month date*))
+         (prev-month-len (days-in-month (date- date* (date month: 1))))
+         (month-start (modulo (- (week-day date*) week-start) 7)))
     (values
-     (map (lambda (d) (set (day (month- date)) d))
+     (map (lambda (d) (set (day (date- date* (date month: 1))) 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))
+     (map (lambda (d) (set (day date*) d)) (iota month-len 1))
+     (map (lambda (d) (set (day (date+ date* (date month: 1))) d))
           (iota (modulo (- (* 7 5) month-len month-start) 7) 1)))))
 
 
diff --git a/module/vcomponent/datetime.scm b/module/vcomponent/datetime.scm
index 73d74363..5c83f279 100644
--- a/module/vcomponent/datetime.scm
+++ b/module/vcomponent/datetime.scm
@@ -59,7 +59,7 @@ Event must have the DTSTART and DTEND protperty set."
 (define (event-contains? ev date/-time)
   "Does event overlap the date that contains time."
   (let* ((start (as-date date/-time))
-         (end (add-day start)))
+         (end (date+ start (date day: 1))))
     (event-overlaps? ev start end)))
 
 (define (event-zero-length? ev)
diff --git a/tests/test/datetime.scm b/tests/test/datetime.scm
index b2b97d45..f288bc4c 100644
--- a/tests/test/datetime.scm
+++ b/tests/test/datetime.scm
@@ -380,34 +380,6 @@
   (datetime-max (datetime)
                 (datetime hour: 1)))
 
-;; month± mostly here for coverage,
-;; actual tests are for date±
-(test-equal "month+ dflt"
-  (date month: 3 day: 1)
-  (month+ (date month: 2 day: 1)))
-
-(test-equal "month+ given change"
-  (date month: 4 day: 1)
-  (month+ (date month: 2 day: 1) 2))
-
-(test-equal "month- dflt"
-  (date month: 1 day: 1)
-  (month- (date month: 2 day: 1)))
-
-(test-equal "month- given change"
-  (date month: 2 day: 1)
-  (month- (date month: 4 day: 1) 2))
-
-;; same for {add,remove}-day; mostly here for coverage.
-
-(test-equal "add-day"
-  (date month: 1 day: 2)
-  (add-day (date month: 1 day: 1)))
-
-(test-equal "remove-day"
-  (date month: 1 day: 1)
-  (remove-day (date month: 1 day: 2)))
-
 ;; TODO more week-number tests
 (test-equal "Week 53"
   53 (week-number #2020-12-28 mon))
diff --git a/tests/test/html/caltable.scm b/tests/test/html/caltable.scm
index d9eeca3e..f64f8775 100644
--- a/tests/test/html/caltable.scm
+++ b/tests/test/html/caltable.scm
@@ -101,5 +101,8 @@
            (time (@ (datetime "2022-05-01")) 1)))
 
   (parameterize ((week-start mon))
-    (cal-table start-date: #2022-04-01 end-date: #2022-04-30 next-start: month+ prev-start: month-)))
+    (cal-table start-date: #2022-04-01
+               end-date: #2022-04-30
+               next-start: (lambda (d) (date+ d (date month: 1)))
+               prev-start: (lambda (d) (date- d (date month: 1))))))