diff options
-rw-r--r-- | module/vcomponent/util/group.scm | 7 | ||||
-rw-r--r-- | tests/unit/vcomponent/util-group.scm | 170 |
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)) |