diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-04-28 01:40:37 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-04-28 01:40:37 +0200 |
commit | 28a5e8b2a1cbd4fd42658e6e66d9943af6cdaa5e (patch) | |
tree | c6f5ffbdf936cbcbd6d64914a891aff17e20de6f /module/vcomponent | |
parent | Add hover-text to popup buttons. (diff) | |
download | calp-28a5e8b2a1cbd4fd42658e6e66d9943af6cdaa5e.tar.gz calp-28a5e8b2a1cbd4fd42658e6e66d9943af6cdaa5e.tar.xz |
Empty days now work.
Diffstat (limited to '')
-rw-r--r-- | module/vcomponent/group.scm | 31 |
1 files changed, 26 insertions, 5 deletions
diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm index cf0fbe82..1e5728c6 100644 --- a/module/vcomponent/group.scm +++ b/module/vcomponent/group.scm @@ -8,7 +8,6 @@ #:export (group-stream get-groups-between)) ;; TODO templetize this -;; TODO this seems to behave weird if the first day of the week is empty (0 events). (define-stream (group-stream in-stream) (define (ein? day) (lambda (e) (event-contains? e day))) @@ -37,10 +36,32 @@ tail))))))) (define (get-groups-between groups start-date end-date) - (filter-sorted-stream - (compose (in-date-range? start-date end-date) - car) - groups)) + + (define good-part + (filter-sorted-stream + (compose (in-date-range? start-date end-date) + car) + groups)) + + ;; NOTE slightly ugly hack. The first element in the return of group-stream shares + ;; it's date component with the lowest dtstart in the event set. This means that a + ;; group set might start after our start- (and end-!) date. + ;; 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)))] + [(car (stream-car good-part)) + (lambda (d) (date< start-date d)) + => (lambda (d) + (stream-append + (list->stream + (map (lambda (d) (cons d stream-null)) + (date-range start-date + (date- d (date day: 1))))) + good-part))] + [else good-part])) (define-public (group->event-list group) |