blob: aaaf5d3632177eb00fbe14eddfe772331b54a364 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
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 ((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))
|
