blob: 960fb6eb87aa09fdf9794298429a0d2908753db3 (
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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
;;; Commentary:
;; Code for parsing vdir's and icalendar files.
;; This module handles the finding of files, while
;; (vcomponent parse component) handles reading data from icalendar files.
;;; Code:
(define-module (vcomponent parse)
:use-module (rnrs bytevectors)
:use-module (srfi srfi-1)
:use-module ((ice-9 hash-table) :select (alist->hash-table))
:use-module ((ice-9 rdelim) :select (read-line))
:use-module ((ice-9 ftw) :select (scandir ftw))
:use-module (util)
:use-module (util time)
:use-module (util exceptions)
:use-module (vcomponent base)
:use-module (vcomponent parse component)
:re-export (parse-calendar)
)
;; All VTIMEZONE's seem to be in "local" time in relation to
;; themselves. Therefore, a simple comparison should work,
;; and then the TZOFFSETTO attribute can be subtd.
(define (parse-vdir path)
(let ((/ (lambda args (string-join args file-name-separator-string 'infix))))
(let ((color
(catch 'system-error
(lambda () (call-with-input-file (/ path "color") read-line))
(const "#FFFFFF")))
(name
(catch 'system-error
(lambda () (call-with-input-file (/ path "displayname") read-line))
(const #f))))
(reduce (lambda (item calendar)
(define-values (events other) (partition (lambda (e) (eq? 'VEVENT (type e)))
(children item)))
;; (assert (eq? 'VCALENDAR (type calendar)))
(assert (eq? 'VCALENDAR (type item)))
(for child in (children item)
(set! (attr child 'X-HNH-FILENAME)
(attr (parent child) 'X-HNH-FILENAME)))
;; NOTE The vdir standard says that each file should contain
;; EXACTLY one event. It can however contain multiple VEVENT
;; components, but they are still the same event.
;; In our case this means exceptions to reccurence rules, which
;; is set up here, and then later handled in rrule-generate.
;; NOTE These events also share UID, but are diferentiated
;; by RECURRENCE-ID. As far as I can tell this goes against
;; the standard. Section 3.8.4.4.
(case (length events)
[(0) (warning "No events in component~%~a"
(attr item 'X-HNH-FILENAME))]
[(1)
(let ((child (car events)))
(assert (memv (type child) '(VTIMEZONE VEVENT)))
(add-child! calendar child))]
;; two or more
[else
;; Sorting on SEQUENCE here would have been nice.
;; But the patches can apparently share a sequence number
;; of 0 with the original event!
;; (╯°□°）╯ ┻━┻
(let* ((head (find (negate (extract 'RECURRENCE-ID))
events))
(rest (delete head events eq?)))
(set! (attr head 'X-HNH-ALTERNATIVES)
(alist->hash-table
(map cons
(map (extract 'RECURRENCE-ID) rest)
rest))
#;
(sort*! rest ;; HERE
date/-time< (extract 'RECURRENCE-ID)))
(add-child! calendar head))])
;; return
calendar)
(make-vcomponent)
(map #; (@ (ice-9 threads) par-map)
(lambda (fname)
(let ((fullname (/ path fname)))
(let ((cal (call-with-input-file fullname
parse-calendar)))
(set! (attr cal 'COLOR) color
(attr cal 'NAME) name
(attr cal 'X-HNH-FILENAME) fullname)
cal)))
(scandir path (lambda (s) (and (not (string= "." (string-take s 1)))
(string= "ics" (string-take-right s 3))))))))))
;; Parse a vdir or ics file at the given path.
(define-public (parse-cal-path path)
(define st (stat path))
(define cal
(case (stat:type st)
[(regular)
(let ((comp (call-with-input-file path parse-calendar)))
(set! (attr comp 'X-HNH-SOURCETYPE) "file")
comp) ]
[(directory)
(report-time! "Parsing ~a" path)
(let ((comp (parse-vdir path)))
(set! (attr comp 'X-HNH-SOURCETYPE) "vdir")
comp)]
[(block-special char-special fifo socket unknown symlink)
=> (lambda (t) (error "Can't parse file of type " t))]))
(unless (attr cal "NAME")
(set! (attr cal "NAME")
(or (attr cal "X-WR-CALNAME")
(string-append "[" (basename path) "]"))))
cal)
|
