diff options
Diffstat (limited to 'module')
-rw-r--r-- | module/vcomponent.scm | 61 | ||||
-rw-r--r-- | module/vcomponent/load.scm | 55 |
2 files changed, 63 insertions, 53 deletions
diff --git a/module/vcomponent.scm b/module/vcomponent.scm index 32406f0a..83954f52 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 app 'calendars (load-calendars calendar-files)) + + (setf app 'events + (concatenate + ;; TODO does this drop events? + (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o))) + (children cal))) + (getf app 'calendars)))) + + (setf app 'fixed-and-repeating-events + (let* ((repeating regular (partition repeating? (getf app '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 app 'fixed-events (car (getf app 'fixed-and-repeating-events))) + (setf app 'repeating-events (cadr (getf app 'fixed-and-repeating-events))) + + (setf app 'event-set (calculate-recurrence-set + (getf app 'fixed-events) + (getf app 'repeating-events))) + + (setf app 'uid-map + (let ((ht (make-hash-table))) + (for-each (lambda (event) (hash-set! ht (attr event 'UID) event)) (getf app '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 app 'fixed-events))) + +(define-method (get-event-by-uid uid) + (hash-ref (getf app 'uid-map) uid)) diff --git a/module/vcomponent/load.scm b/module/vcomponent/load.scm index 37d57b56..09dcd3c8 100644 --- a/module/vcomponent/load.scm +++ b/module/vcomponent/load.scm @@ -1,59 +1,10 @@ (define-module (vcomponent load) :export (load-calendars load-calendars*) :use-module (util) - :use-module (util time) :use-module (util config) - :use-module (srfi srfi-1) - :use-module (datetime) - :use-module (datetime util) - :use-module (srfi srfi-41) - :use-module (srfi srfi-41 util) - ;; :use-module (parameters) - ;; :use-module (vcomponent) - :use-module (vcomponent base) - :use-module ((vcomponent parse) :select (parse-cal-path)) - :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?)) - :use-module ((vcomponent datetime) :select (ev-time<?))) + :use-module ((vcomponent parse) :select (parse-cal-path))) (define-config calendar-files '() "" list?) -(define-public (calculate-recurrence-set regular repeating) - (interleave-streams - ev-time<? - (cons (list->stream regular) - (map generate-recurrence-set repeating) - ))) - -;; Reads all calendar files from disk, generate recurence-sets for all repeating events, -;; and returns a list of calendars, and a stream of all events "ready" for display. -(define* (load-calendars #:optional (calendar-files (get-config 'calendar-files))) - (report-time! "Parsing ~a calendars" (length calendar-files)) - (let* ((calendars regular repeating (load-calendars* calendar-files))) - (report-time! "Calendars loaded, interleaving and reccurring") - (values - calendars - (calculate-recurrence-set regular repeating)))) - -;; Basic version, loads calendrs, sorts the events, and returns -;; regular and repeating events separated from each other. -;; -;; (list string) → (list calendar), (list event), (list event) -(define* (load-calendars* #:optional (calendar-files (get-config 'calendar-files))) - - (define calendars (map parse-cal-path calendar-files)) - (define events (concatenate - ;; TODO does this drop events? - (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o))) - (children cal))) - calendars))) - - (report-time! "Parse done, partitioning...") - (let* ((repeating regular (partition repeating? 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. - (values calendars - (sort*! regular date/-time<? (extract 'DTSTART)) - (sort*! repeating date/-time<? (extract 'DTSTART))))) +(define* (load-calendars calendar-files) + (map parse-cal-path calendar-files)) |