aboutsummaryrefslogtreecommitdiff
path: root/module/vcomponent/recurrence
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@hornquist.se>2020-01-30 22:51:45 +0100
committerHugo Hörnquist <hugo@hornquist.se>2020-01-30 22:51:45 +0100
commitf852c30bcef530d18a474ab6ab8350a3ef93d563 (patch)
tree00fc29a6ff1a8c842d0a526f04d4124977dd6e46 /module/vcomponent/recurrence
parentUpdate recurrence generate to new date obj. (diff)
downloadcalp-f852c30bcef530d18a474ab6ab8350a3ef93d563.tar.gz
calp-f852c30bcef530d18a474ab6ab8350a3ef93d563.tar.xz
Once again compiles.
Diffstat (limited to 'module/vcomponent/recurrence')
-rw-r--r--module/vcomponent/recurrence/generate.scm46
-rw-r--r--module/vcomponent/recurrence/internal.scm3
-rw-r--r--module/vcomponent/recurrence/parse.scm22
3 files changed, 46 insertions, 25 deletions
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index 938d99f9..8a4eed36 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -142,20 +142,32 @@
;; TODO DURATION might be used for something else, check applicable types
;; TODO Far from all events have DTEND
;; VTIMEZONE's always lack it.
- (if (not (attr event 'RRULE))
- (stream event)
- (begin
- (set! (attr event 'X-HNH-DURATION)
- (cond [(attr event 'DURATION) => identity]
- [(attr event 'DTEND)
- => (lambda (end)
- ;; The value type of dtstart and dtend must be the same
- ;; according to RFC 5545 3.8.2.2 (Date-Time End).
- (if (date? end)
- (date- end (attr event 'DTSTART))
- (datetime- end (attr event 'DTSTART))))]))
- (if (attr event "RRULE")
- (recur-event-stream event (parse-recurrence-rule (attr event "RRULE")))
- ;; TODO some events STANDARD and DAYLIGT doesn't have RRULE's, but rather
- ;; just mention the current part. Handle this
- stream-null))))
+ (catch #t
+ (lambda ()
+ (if (not (attr event 'RRULE))
+ (stream event)
+ (begin
+ (set! (attr event 'X-HNH-DURATION)
+ (cond [(attr event 'DURATION) => identity]
+ [(attr event 'DTEND)
+ => (lambda (end)
+ ;; The value type of dtstart and dtend must be the same
+ ;; according to RFC 5545 3.8.2.2 (Date-Time End).
+ (if (date? end)
+ (date- end (attr event 'DTSTART))
+ (datetime- end (attr event 'DTSTART))))]))
+ (if (attr event "RRULE")
+ (recur-event-stream event (parse-recurrence-rule
+ (attr event "RRULE")
+ (if (string= "DATE" (and=> (prop (attr* event 'DTSTART) 'VALUE) car))
+ parse-date parse-datetime)))
+ ;; TODO some events STANDARD and DAYLIGT doesn't have RRULE's, but rather
+ ;; just mention the current part. Handle this
+ stream-null))))
+ (lambda (err . args)
+ (format (current-error-port)
+ "\x1b[0;31mError\x1b[m while parsing recurrence rule (ignoring and continuing)~%~a ~a~%~a~%~%"
+ err args
+ (attr event 'X-HNH-FILENAME))
+ (stream ; event
+ ))))
diff --git a/module/vcomponent/recurrence/internal.scm b/module/vcomponent/recurrence/internal.scm
index 12cf7a7b..50c44a60 100644
--- a/module/vcomponent/recurrence/internal.scm
+++ b/module/vcomponent/recurrence/internal.scm
@@ -37,7 +37,8 @@
(display "=" port)
(display
(case field
- ((until) ((@ (srfi srfi-19 util) time->string) it))
+ ;; TODO check over date/time/datetime here
+ ((until) ((@ (srfi srfi-19 alt util) time->string) it))
(else it))
port)))
(display ">" port))))))
diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm
index f532987a..1c974727 100644
--- a/module/vcomponent/recurrence/parse.scm
+++ b/module/vcomponent/recurrence/parse.scm
@@ -18,15 +18,20 @@
;; (<weekadynum>, ...)
;; @end example
+;;; weekdaynum can contain ±
+;;; only used in bywdaylist
+;;; only present with by BYDAY
+
;; Returns a pair, where the @code{car} is the offset
;; and @code{cdr} is the day symbol.
;; The @code{car} may be @code{#f}.
+;; str → (<num> . <symb>)
(define (parse-day-spec str)
- (let* ((numchars (append '(#\+ #\-) (map integer->char (iota 10 #x30))))
- (num symb (span (cut memv <> numchars)
- (string->list str))))
- (cons (string->number (list->string num))
- (apply symbol symb))))
+ (let* ((numerical-characters (append '(#\+ #\-) (map integer->char (iota 10 #x30))))
+ (numbers letters (span (cut memv <> numerical-characters)
+ (string->list str))))
+ (cons (string->number (list->string numbers))
+ (apply symbol letters))))
(define-macro (quick-case key . cases)
(let ((else-clause (or (assoc-ref cases 'else)
@@ -43,17 +48,20 @@
`(else ,@body)))
cases))))
-(define (parse-recurrence-rule str)
+;; UNTIL must have the exact same value type as the DTSTART of the event from which
+;; this string came. I have however seen exceptions to that rule...
+(define* (parse-recurrence-rule str optional: (datetime-parser parse-datetime))
(fold
(lambda (kv o)
(let* (((key val) kv))
(let-lazy
((symb (string->symbol val))
- (date (parse-datetime val))
+ (date (datetime-parser val))
(days (map parse-day-spec (string-split val #\,)))
(num (string->number val))
(nums (map string->number (string-split val #\,))))
+ ;; TODO I think it's an error to give BYHOUR and under for dates which aren't datetimes
(quick-case (string->symbol key)
(UNTIL (set! (until o) date))