diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2019-04-25 19:05:21 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-04-25 19:05:21 +0200 |
commit | b6d956cc7bc9772302a04b4d609fee664b57a6e3 (patch) | |
tree | 60a3e89a4ec3289bd50dc6571c14e6940a395a97 /module/vcomponent | |
parent | Rename event-in? => event-contains?. (diff) | |
download | calp-b6d956cc7bc9772302a04b4d609fee664b57a6e3.tar.gz calp-b6d956cc7bc9772302a04b4d609fee664b57a6e3.tar.xz |
Move group-stream, add helper methods.
Diffstat (limited to '')
-rw-r--r-- | module/vcomponent/group.scm | 39 |
1 files changed, 39 insertions, 0 deletions
diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm new file mode 100644 index 00000000..c5b6948e --- /dev/null +++ b/module/vcomponent/group.scm @@ -0,0 +1,39 @@ +(define-module (vcomponent group) + #:use-module (vcomponent) + #:use-module (vcomponent datetime) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-19 util) + #:use-module (srfi srfi-41) + #:use-module (srfi srfi-41 util) + #:export (group-stream)) + +(define-stream (group-stream in-stream) + (define (ein? day) (lambda (e) (event-contains? e (date->time-utc day)))) + + (let loop ((days (day-stream (time-utc->date (attr (stream-car in-stream) 'DTSTART)))) + (stream in-stream)) + (if (stream-null? stream) + stream-null + (let* ((day (stream-car days)) + (tomorow (add-day (date->time-utc (drop-time day))))) + (let ((head (stream-take-while (ein? day) stream)) + (tail + (filter-sorted-stream* + (lambda (e) (time<? tomorow (attr e 'DTEND))) + (lambda (e) (time<=? tomorow (attr e 'DTSTART))) + stream))) + + (stream-cons (cons day head) + (loop (stream-cdr days) + tail))))))) + +(define-public (get-groups-between groups start-date end-date) + (filter-sorted-stream + ;; TODO in-date-range? drops the first date + (compose (in-date-range? start-date end-date) + car) + groups)) + + +(define-public (group->event-list group) + (stream->list (cdr group))) |