1 files changed, 14 insertions, 0 deletions
diff --git a/module/srfi/srfi-19/util.scm b/module/srfi/srfi-19/util.scm
index f5bd1964..96f19dc2 100644
--- a/module/srfi/srfi-19/util.scm
+++ b/module/srfi/srfi-19/util.scm
@@ -166,3 +166,17 @@ attribute set to 0. Can also be seen as \"Start of day\""
        )
   ;; ( (nsecs b) (zone b))
   )
+
+;; Rounds a date towards the closest midnight
+;; TODO more general rounding
+(define-public (date-round date)
+  (set->
+   (if (< 12 (date-hour date))
+       ;; round up
+       (set (date-day date) = (+ 1))
+       ;; round down
+       date)
+   (date-day  = (+ 1))
+   (date-hour   0)
+   (date-minute 0)
+   (date-second 0)))