From 34059d4d71cb8081d065467cd32e31c2aa21c728 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 13 Nov 2023 22:06:13 +0100
Subject: Add vcomponent-equal?.

---
 module/vcomponent.scm                      |  2 ++
 module/vcomponent/base.scm                 | 10 ++++++
 tests/unit/vcomponent/vcomponent-equal.scm | 56 ++++++++++++++++++++++++++++++
 3 files changed, 68 insertions(+)
 create mode 100644 tests/unit/vcomponent/vcomponent-equal.scm

diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index 7930bf92..f5f2583e 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -6,6 +6,8 @@
                :select (parse-cal-path))
   :re-export (
               vcomponent
+              vcomponent?
+              vcomponent-equal?
               set-properties
               properties
               children
diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 2a607fc5..4cacbb46 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -20,6 +20,8 @@
            children type parent
            add-child
 
+           vcomponent-equal?
+
            remove-property
            prop* prop
            extract extract*
@@ -96,6 +98,14 @@
               default: (table) type: table?)
   (parent     default: #f      type: (or false? vcomponent?)))
 
+(define (vcomponent-equal? a b)
+  (and (eqv? (type a) (type b))
+       (= (length (children a)) (length (children b)))
+       (every vcomponent-equal?
+            (sort* (children a) string< (extract 'UID))
+            (sort* (children b) string< (extract 'UID)))
+       (equal? (properties a) (properties b))))
+
 (define prop*
   (case-lambda
     ((object key)
diff --git a/tests/unit/vcomponent/vcomponent-equal.scm b/tests/unit/vcomponent/vcomponent-equal.scm
new file mode 100644
index 00000000..5bae30c2
--- /dev/null
+++ b/tests/unit/vcomponent/vcomponent-equal.scm
@@ -0,0 +1,56 @@
+(define-module (test vcomponent-equal)
+  :use-module (srfi srfi-64)
+  :use-module (srfi srfi-88)
+  :use-module (datetime)
+  :use-module (datetime timespec)
+  :use-module (vcomponent create)
+  :use-module (vcomponent recurrence)
+  :use-module ((vcomponent) :select (vcomponent-equal?))
+  )
+
+;;; Things of note:
+;;; - the childrens are in different order
+;;; - All properties are in a random order
+;;; TODO Add parameters
+(test-assert "vcomponent equal?"
+    (vcomponent-equal?
+     (vtimezone tzid: "Europe/Zurich"
+                (list
+                 (daylight
+                  tzoffsetfrom: (make-timespec (time hour: 0) '+ #\w)
+                  tzoffsetto: (make-timespec (time hour: 2) '+ #\w)
+                  tzname: "CEST"
+                  dtstart: (datetime year: 1981 month: 3 day: 29 hour: 1 tz: "UTC")
+                  uid: "d19c9347-9a85-4432-a876-5fb9c0d24d2b"
+                  rrule: (recur-rule freq: 'YEARLY interval: 1 byday: `((-1 . ,sun))
+                                     bymonth: '(3) wkst: monday))
+                 (standard
+                  tzoffsetfrom: (make-timespec (time hour: 2) '+ #\w)
+                  uid: "7dce30d4-6aaa-4cfb-85dc-813f74d7f4a9"
+                  dtstart: (datetime year: 1996 month: 10 day: 27 hour: 1 tz: "UTC")
+                  rrule: (recur-rule freq: 'YEARLY interval: 1 byday: `((-1 . ,sun))
+                                     bymonth: '(10) wkst: monday)
+                  tzoffsetto: (make-timespec (time hour: 1) '+ #\w)
+                  tzname: "CET")))
+
+     (vtimezone tzid: "Europe/Zurich"
+                (list
+                 (standard
+                  dtstart: (datetime year: 1996 month: 10 day: 27 hour: 1 tz: "UTC")
+                  rrule: (recur-rule freq: 'YEARLY interval: 1 byday: `((-1 . ,sun))
+                                     bymonth: '(10) wkst: monday)
+                  tzname: "CET"
+                  tzoffsetfrom: (make-timespec (time hour: 2) '+ #\w)
+                  tzoffsetto: (make-timespec (time hour: 1) '+ #\w)
+                  uid: "7dce30d4-6aaa-4cfb-85dc-813f74d7f4a9")
+                 (daylight
+                  dtstart: (datetime year: 1981 month: 3 day: 29 hour: 1 tz: "UTC")
+                  rrule: (recur-rule freq: 'YEARLY interval: 1 byday: `((-1 . ,sun))
+                                     bymonth: '(3) wkst: monday)
+                  tzname: "CEST"
+                  tzoffsetfrom: (make-timespec (time hour: 0) '+ #\w)
+                  tzoffsetto: (make-timespec (time hour: 2) '+ #\w)
+                  uid: "d19c9347-9a85-4432-a876-5fb9c0d24d2b")))))
+
+
+'((vcomponent base))
-- 
cgit v1.2.3