aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-04-30 18:35:15 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-04-30 18:35:15 +0200
commit5a4e98ebe9b82c8b4abae3d1e4535fadcfbd8907 (patch)
tree9eb2fe76d13a199b108569293b6d716ecd938841
parentAdd `app' type. (diff)
downloadcalp-5a4e98ebe9b82c8b4abae3d1e4535fadcfbd8907.tar.gz
calp-5a4e98ebe9b82c8b4abae3d1e4535fadcfbd8907.tar.xz
Update vcomponent to load into the app object.
-rw-r--r--module/vcomponent.scm61
-rw-r--r--module/vcomponent/load.scm55
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))