From 0db9f7d8584583202cdd5b28e02d60a7eb3d4fd1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Fri, 19 May 2023 21:11:13 +0200
Subject: [PATCH] Day comparators.

---
 src/cal-day.scm | 45 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 45 insertions(+)

diff --git a/src/cal-day.scm b/src/cal-day.scm
index 2811ffe..99bc377 100644
--- a/src/cal-day.scm
+++ b/src/cal-day.scm
@@ -42,6 +42,12 @@
   string->cal-day
   parse-cal-day/month
 
+  cal-day=?
+  cal-day<?
+  cal-day<=?
+  cal-day>=?
+  cal-day>?
+
   cal-day-tests!
   )
 
@@ -146,6 +152,45 @@
      (or d
 	 (string->cal-month s))))
 
+ ;; Date equality
+ (define (cal-day=? a b)
+   (and (cal-day? a)
+	(cal-day? b)
+	(eq? (cal-day-year a)
+	     (cal-day-year b))
+	(eq? (cal-day-month a)
+	     (cal-day-month b))
+	(eq? (cal-day-day a)
+	     (cal-day-day b))))
+
+ ;; Strict date inequality
+ (define (cal-day<? a b)
+   (and (cal-day? a)
+	(cal-day? b)
+	(or (< (cal-day-year a)
+	       (cal-day-year b))
+	    (and (= (cal-day-year a)
+		    (cal-day-year b))
+		 (or (< (cal-day-month a)
+			(cal-day-month b))
+		     (and (= (cal-day-month a)
+			     (cal-day-month b))
+			  (<  (cal-day-day a)
+			      (cal-day-day b))))))))
+
+ ;; Non-strict inequality
+ (define (cal-day<=? a b)
+   (or (cal-day=? a b)
+       (cal-day<? a b)))
+
+ ;; Inequality the other way
+ (define (cal-day>=? a b)
+   (not (cal-day<? a b)))
+
+ ;; Strict inequality the other way
+ (define (cal-day>? a b)
+   (not (cal-day<=? a b)))
+
  ;; Module self-tests
  (define (cal-day-tests!)
    (run-tests