diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-05-01 13:08:25 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-05-01 13:08:25 +0200 |
commit | 29cb0b9eb8e544d0f2b07eb202d90bed4f20eeea (patch) | |
tree | 92c5f2a5271911930a15e58df862273b3a755e5d /module/vcomponent.scm | |
parent | Server server any subdir under static. (diff) | |
parent | Change call signature for [gs]etf. (diff) | |
download | calp-29cb0b9eb8e544d0f2b07eb202d90bed4f20eeea.tar.gz calp-29cb0b9eb8e544d0f2b07eb202d90bed4f20eeea.tar.xz |
Merge branch 'app'.
The app objects both makes the whole program sort of behave like one
class in some object oriented languages, with an implicitly (actually
hiddenly explicitly) passed 'app' argument to all methods. Multiple
concurrent apps should be supported, but is of now untested.
The app is also configured to lazily bind all its fields, which means
that almost all loading is now lazy!
Diffstat (limited to '')
-rw-r--r-- | module/vcomponent.scm | 61 |
1 files changed, 60 insertions, 1 deletions
diff --git a/module/vcomponent.scm b/module/vcomponent.scm index 32406f0a..aaaf5d36 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -1,10 +1,69 @@ (define-module (vcomponent) + :use-module (util) + :use-module (util app) + :use-module (srfi srfi-1) + :use-module (srfi srfi-41) + :use-module (srfi srfi-41 util) + :use-module (datetime) + :use-module (datetime util) :use-module (vcomponent base) :use-module (vcomponent parse) :use-module (vcomponent load) - :use-module (util) + :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?)) + :use-module ((vcomponent datetime) :select (ev-time<?)) :re-export (make-vcomponent parse-cal-path parse-calendar load-calendars load-calendars*)) (re-export-modules (vcomponent base)) + + +;; TODO rename function +(define (calculate-recurrence-set regular repeating) + (interleave-streams + ev-time<? + (cons (list->stream regular) + (map (@ (vcomponent recurrence) generate-recurrence-set) repeating) + ))) + + +(define-method (init-app calendar-files) + (setf 'calendars (load-calendars calendar-files)) + + (setf 'events + (concatenate + ;; TODO does this drop events? + (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o))) + (children cal))) + (getf 'calendars)))) + + (setf 'fixed-and-repeating-events + (let* ((repeating regular (partition repeating? (getf 'events)))) + + ;; (report-time! "Sorting") + ;; NOTE There might be instances where we don't care if the + ;; collection if sorted, but for the time beieng it's much + ;; easier to always sort it. + (list + (sort*! regular date/-time<? (extract 'DTSTART)) + (sort*! repeating date/-time<? (extract 'DTSTART))))) + + (setf 'fixed-events (car (getf 'fixed-and-repeating-events))) + (setf 'repeating-events (cadr (getf 'fixed-and-repeating-events))) + + (setf 'event-set (calculate-recurrence-set + (getf 'fixed-events) + (getf 'repeating-events))) + + (setf 'uid-map + (let ((ht (make-hash-table))) + (for-each (lambda (event) (hash-set! ht (attr event 'UID) event)) (getf 'events)) + ht))) + +(define-method (fixed-events-in-range start end) + (filter-sorted (lambda (ev) ((in-date-range? start end) + (as-date (attr ev 'DTSTART)))) + (getf 'fixed-events))) + +(define-method (get-event-by-uid uid) + (hash-ref (getf 'uid-map) uid)) |