Add tests for vcomponent grouping utilities.

2 files changed, 174 insertions, 3 deletions

diff --git a/module/vcomponent/util/group.scm b/module/vcomponent/util/group.scm
index 4001c590..6029f70c 100644
--- a/module/vcomponent/util/group.scm
+++ b/module/vcomponent/util/group.scm
@@ -54,9 +54,10 @@
   ;; To combat this I simple create a bunch of dummy groups below.
 
   (cond [(stream-null? good-part)
-         (list->stream
-          (map (lambda (d) (cons d stream-null))
-               (date-range start-date end-date)))]
+         ;; This case is checked, but streams lazy evaluation means that ther are missed.
+         (list->stream                             ; NOCOV
+          (map (lambda (d) (cons d stream-null))        ; NOCOV
+               (date-range start-date end-date)))] ; NOCOV
         [(car (stream-car good-part))
          (lambda (d) (date< start-date d))
          => (lambda (d)
diff --git a/tests/unit/vcomponent/util-group.scm b/tests/unit/vcomponent/util-group.scm
new file mode 100644
index 00000000..b32689ac
--- /dev/null
+++ b/tests/unit/vcomponent/util-group.scm
@@ -0,0 +1,170 @@
+(define-module (test vcomponent-util-group)
+  :use-module (srfi srfi-41)
+  :use-module (srfi srfi-64)
+  :use-module (srfi srfi-88)
+  :use-module (datetime)
+  :use-module ((vcomponent) :select (vcomponent-equal?))
+  :use-module (vcomponent create)
+  :use-module (vcomponent util group))
+
+(define (force-groups groups)
+  (stream-map (lambda (p) (cons (car p) (stream->list (cdr p))))
+              groups))
+
+(test-equal "group-stream"
+    (list (list (date year: 2020 month: jan day: 1)
+                (vevent
+                 dtstart: (datetime year: 2020 month: jan day: 1 hour: 0)
+                 dtend:   (datetime year: 2020 month: jan day: 1 hour: 10)))
+          (list (date year: 2020 month: jan day: 02))
+          (list (date year: 2020 month: jan day: 03))
+          (list (date year: 2020 month: jan day: 04))
+          (list (date year: 2020 month: jan day: 05))
+          (list (date year: 2020 month: jan day: 06))
+          (list (date year: 2020 month: jan day: 07))
+          (list (date year: 2020 month: jan day: 08))
+          (list (date year: 2020 month: jan day: 09))
+          (list (date year: 2020 month: jan day: 10)
+                (vevent
+                 dtstart: (datetime year: 2020 month: jan day: 10 hour: 0)
+                 dtend:   (datetime year: 2020 month: jan day: 10 hour: 10))
+                (vevent
+                 dtstart: (datetime year: 2020 month: jan day: 10 hour: 0)
+                 dtend:   (datetime year: 2020 month: jan day: 14 hour: 10)))
+          (list (date year: 2020 month: jan day: 11)
+                (vevent
+                 dtstart: (datetime year: 2020 month: jan day: 10 hour: 0)
+                 dtend:   (datetime year: 2020 month: jan day: 14 hour: 10)))
+          (list (date year: 2020 month: jan day: 12)
+                (vevent
+                 dtstart: (datetime year: 2020 month: jan day: 10 hour: 0)
+                 dtend:   (datetime year: 2020 month: jan day: 14 hour: 10))
+                (vevent
+                 dtstart: (date     year: 2020 month: jan day: 12)))
+          (list (date year: 2020 month: jan day: 13)
+                (vevent
+                 dtstart: (datetime year: 2020 month: jan day: 10 hour: 0)
+                 dtend:   (datetime year: 2020 month: jan day: 14 hour: 10))
+                )
+          (list (date year: 2020 month: jan day: 14)
+                (vevent
+                 dtstart: (datetime year: 2020 month: jan day: 10 hour: 0)
+                 dtend:   (datetime year: 2020 month: jan day: 14 hour: 10))
+                )
+          (list (date year: 2020 month: jan day: 15)
+                (vevent
+                 dtstart: (datetime year: 2020 month: jan day: 15 hour: 0)
+                 dtend:   (datetime year: 2020 month: jan day: 15 hour: 10)))
+          (list (date year: 2020 month: jan day: 16)))
+
+    (stream->list
+     16 (force-groups
+         (group-stream
+          (stream (vevent dtstart: (datetime year: 2020 month: jan day: 1 hour: 0)
+                          dtend:   (datetime year: 2020 month: jan day: 1 hour: 10))
+                  (vevent dtstart: (datetime year: 2020 month: jan day: 10 hour: 0)
+                          dtend:   (datetime year: 2020 month: jan day: 10 hour: 10))
+                  (vevent dtstart: (datetime year: 2020 month: jan day: 10 hour: 0)
+                          dtend:   (datetime year: 2020 month: jan day: 14 hour: 10))
+                  (vevent dtstart: (date     year: 2020 month: jan day: 12))
+                  (vevent dtstart: (datetime year: 2020 month: jan day: 15 hour: 0)
+                          dtend:   (datetime year: 2020 month: jan day: 15 hour: 10)))))))
+
+(define (test-groups expected actual)
+  (for-each (lambda (group-e group-a)
+              (test-equal (car group-e) (car group-a))
+              (test-equal (length (cdr group-e)) (length (cdr group-a)))
+              (for-each (lambda (e a) (test-assert (vcomponent-equal? e a)))
+                        (cdr group-e) (cdr group-a)))
+            expected actual))
+
+(test-group "get-groups-between"
+  (let ((groups
+         (group-stream
+          (stream (vevent dtstart: (datetime year: 2020 month: jan day: 1 hour: 0)
+                          dtend:   (datetime year: 2020 month: jan day: 1 hour: 10))
+                  (vevent dtstart: (datetime year: 2020 month: jan day: 10 hour: 0)
+                          dtend:   (datetime year: 2020 month: jan day: 10 hour: 10))
+                  (vevent dtstart: (datetime year: 2020 month: jan day: 10 hour: 0)
+                          dtend:   (datetime year: 2020 month: jan day: 14 hour: 10))
+                  (vevent dtstart: (date     year: 2020 month: jan day: 12))
+                  (vevent dtstart: (datetime year: 2020 month: jan day: 15 hour: 0)
+                          dtend:   (datetime year: 2020 month: jan day: 15 hour: 10))))))
+    (test-equal "Subset of all events"
+        (list (list (date year: 2020 month: jan day: 05))
+              (list (date year: 2020 month: jan day: 06))
+              (list (date year: 2020 month: jan day: 07))
+              (list (date year: 2020 month: jan day: 08))
+              (list (date year: 2020 month: jan day: 09))
+              (list (date year: 2020 month: jan day: 10)
+                    (vevent
+	             dtstart: (datetime year: 2020 month: jan day: 10 hour: 0)
+	             dtend:   (datetime year: 2020 month: jan day: 10 hour: 10))
+
+                    (vevent
+	             dtstart: (datetime year: 2020 month: jan day: 10 hour: 0)
+	             dtend:   (datetime year: 2020 month: jan day: 14 hour: 10))))
+
+      (stream->list
+       (force-groups (get-groups-between groups
+                                         (date year: 2020 month: jan day: 5)
+                                         (date year: 2020 month: jan day: 10)))))
+
+    (test-equal "Subset not containing any events"
+        (list (list (date year: 2020 month: feb day: 5))
+              (list (date year: 2020 month: feb day: 6))
+              (list (date year: 2020 month: feb day: 7))
+              (list (date year: 2020 month: feb day: 8))
+              (list (date year: 2020 month: feb day: 9)))
+      (stream->list (force-groups
+                     (get-groups-between groups
+                                         (date year: 2020 month: feb day: 5)
+                                         (date year: 2020 month: feb day: 9)))))
+
+    (test-group "Subset overlapping start of events"
+      (test-groups
+       (list (list (date year: 2019 month: dec day: 31))
+             (list (date year: 2020 month: jan day: 1)
+                   (vevent dtend: #2020-01-01T10:00:00 dtstart: #2020-01-01T00:00:00))
+             (list (date year: 2020 month: jan day: 2))
+             (list (date year: 2020 month: jan day: 3))
+             (list (date year: 2020 month: jan day: 4))
+             (list (date year: 2020 month: jan day: 5)))
+
+       (stream->list (force-groups
+                      (get-groups-between groups
+                                          (date year: 2019 month: dec day: 31)
+                                          (date year: 2020 month: jan day: 5))))))
+
+    (test-group "Subset overlapping end of events"
+      (test-groups
+       (list (list (date year: 2020 month: jan day: 11)
+                   (vevent dtend:   (datetime year: 2020 month: jan day: 14 hour: 10)
+                           dtstart: (datetime year: 2020 month: jan day: 10 hour: 00)))
+             (list (date year: 2020 month: jan day: 12)
+                   (vevent dtend:   (datetime year: 2020 month: jan day: 14 hour: 10)
+                           dtstart: (datetime year: 2020 month: jan day: 10 hour: 00))
+                   (vevent dtstart: (date year: 2020 month: jan day: 12)))
+             (list (date year: 2020 month: jan day: 13)
+                   (vevent dtend:   (datetime year: 2020 month: jan day: 14 hour: 10)
+                           dtstart: (datetime year: 2020 month: jan day: 10 hour: 00)))
+             (list (date year: 2020 month: jan day: 14)
+                   (vevent dtend:   (datetime year: 2020 month: jan day: 14 hour: 10)
+                           dtstart: (datetime year: 2020 month: jan day: 10 hour: 00)))
+             (list (date year: 2020 month: jan day: 15)
+                   (vevent dtend:   (datetime year: 2020 month: jan day: 15 hour: 10)
+                           dtstart: (datetime year: 2020 month: jan day: 15 hour: 00)))
+             (list (date year: 2020 month: jan day: 16))
+             (list (date year: 2020 month: jan day: 17))
+             (list (date year: 2020 month: jan day: 18))
+             (list (date year: 2020 month: jan day: 19))
+             (list (date year: 2020 month: jan day: 20)))
+
+       (stream->list (force-groups
+                      (get-groups-between groups
+                                          (date year: 2020 month: jan day: 11)
+                                          (date year: 2020 month: jan day: 20))))))))
+
+;;; TODO group->event-list
+
+'((vcomponent util group))