aboutsummaryrefslogtreecommitdiff
path: root/module/vcomponent/recurrence/generate.scm
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-05-19 23:14:26 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-05-19 23:21:57 +0200
commite8d7592a421e9cf4f773605de3e309748dbda794 (patch)
treead406b6691bddfa907e79e3392d7e08da5fdf96a /module/vcomponent/recurrence/generate.scm
parentCleanup in datetime. (diff)
downloadcalp-e8d7592a421e9cf4f773605de3e309748dbda794.tar.gz
calp-e8d7592a421e9cf4f773605de3e309748dbda794.tar.xz
Remove old recurrence generator.
Diffstat (limited to 'module/vcomponent/recurrence/generate.scm')
-rw-r--r--module/vcomponent/recurrence/generate.scm171
1 files changed, 0 insertions, 171 deletions
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
deleted file mode 100644
index 70d21be1..00000000
--- a/module/vcomponent/recurrence/generate.scm
+++ /dev/null
@@ -1,171 +0,0 @@
-(define-module (vcomponent recurrence generate)
- #:use-module ((srfi srfi-1) :select (find))
- #:use-module (datetime)
- #:use-module (datetime util)
- #:use-module (srfi srfi-26) ; Cut
- #:use-module (srfi srfi-41) ; Streams
- #:use-module (ice-9 match)
-
- #:use-module (util)
- #:use-module (util exceptions)
- #:use-module (vcomponent base)
- #:use-module (vcomponent recurrence internal)
- #:use-module (vcomponent recurrence parse)
-
- #:export (generate-recurrence-set)
- )
-
-;;; TODO implement
-;;; EXDATE and RDATE
-
-;;; EXDATE (3.8.5.1)
-;;; comma sepparated list of dates or datetimes.
-;;; Can have TZID parameter
-;;; Specifies list of dates that the event should not happen on, even
-;;; if the RRULE say so.
-;;; Can have VALUE field specifiying "DATE-TIME" or "DATE".
-
-;;; RDATE (3.8.5.2)
-;;; Comma sepparated list of dates the event should happen on.
-;;; Can have TZID parameter.
-;;; Can have VALUE parameter, specyfying "DATE-TIME", "DATE" or "PREIOD".
-;;; PERIOD (see 3.3.9)
-
-(define (seconds-in freq)
- (case freq
- ((SECONDLY) 1)
- ((MINUTELY) 60)
- ((HOURLY) (* 60 60))
- ((DAILY) (* 60 60 24))
- ((WEEKLY) (* 60 60 24 7))))
-
-;; Event x Rule → Event
-;; TODO My current naïve aproach to simple adding a constant time to an event
-;; breaks with time-zones. betwen 12:00 two adjacent days might NOT be 24h.
-;; Specifically, 23h or 25h when going between summer and "normal" time.
-
-(define (next-event ev r)
- (let ((e (copy-vcomponent ev)))
- (let-env ((TZ (and=> (prop (attr* e 'DTSTART) 'TZID) car)))
-
- (let ((d (attr e 'DTSTART))
- (i (interval r)))
-
- (let ((date-change (case (freq r)
- ((DAILY) (date day: i))
- ((WEEKLY) (date day: (* i 7)))
- ((MONTHLY) (date month: i))
- ((YEARLY) (date year: i))
- (else (date))))
- (time-change (case (freq r)
- ((SECONDLY) (time second: i))
- ((MINUTELY) (time minute: i))
- ((HOURLY) (time hour: i))
- (else (time)))))
- (set! (attr e 'DTSTART)
- (if (date? d)
- (date+ d date-change)
- (datetime+ d (datetime date: date-change time: time-change)))))
-
- #;
- (set! (zone-offset d) ;
- (zone-offset (time-utc->date (date->time-utc d))))
-
-
- (let ((start (attr e 'DTSTART))
- (end (attr e 'DTEND))
- (change (attr e 'X-HNH-DURATION)))
- (when end
- (set! (attr e 'DTEND)
- (if (date? start)
- (date+ start change)
- (datetime+ start change)))))))
-
- e))
-
-;; BYDAY and the like depend on the freq?
-;; Line 7100
-;; Table @@ 2430
-;;
-;; Event x Rule → Bool (continue?)
-;; Alternative, monadic solution using <optional>.
-;; @example
-;; (optional->bool
-;; (do (<$> (cut time<=? (attr last 'DTSTART)) (until r))
-;; (<$> (negate zero?) (count r))
-;; (just #t)))
-;; @end example
-(define-stream (recur-event-stream event rule-obj)
- (stream-unfold
-
- ;; Event x Rule → Event
- (match-lambda
- ((e _)
- (let ((expected-start (attr e 'DTSTART)))
- ;; If we have alternatives, check them
- (or (and=> (attr e 'X-HNH-ALTERNATIVES)
- (lambda (alternatives)
- ;; A recurrence id matching the expected time means that
- ;; we have an actuall alternative/exception, use that
- ;; instead of the regular event.
- ;; RFC 5545 3.8.4.4
- (find (lambda (alt) ((if (datetime? expected-start)
- datetime= date=)
- expected-start (attr alt 'RECURRENCE-ID)))
- alternatives)))
- ;; If we did't have an exception just return the regular event.
- e))))
-
- ;; Event x Rule → Bool (continue?)
- (match-lambda
- ((e r)
- (or (and (not (until r)) (not (count r))) ; Never ending
- (and=> (count r) (negate zero?)) ; COUNT
- (and=> (until r) (lambda (dt) ((if (date? dt) date<= datetime<=) ; UNTIL
- (attr e 'DTSTART) dt))))))
-
- ;; Event x Rule → next (Event, Rule)
- (match-lambda
- ((e r)
- (list (next-event e r)
- (if (count r)
- (set (count r) = (- 1))
- r ))))
-
- ;; Seed
- (list event rule-obj)))
-
-
-(define (generate-recurrence-set event)
- ;; TODO DURATION might be used for something else, check applicable types
- ;; TODO Far from all events have DTEND
- ;; VTIMEZONE's always lack it.
- (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-difference end (attr event 'DTSTART))
- (datetime-difference end (attr event 'DTSTART))))]))
- (if (attr event "RRULE")
- (recur-event-stream
- event (parse-recurrence-rule
- (attr event "RRULE")
- (if (date? (attr event 'DTSTART))
- parse-ics-date parse-ics-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)
- (warning "while parsing recurrence rule ~%~a ~s~%~a"
- err args (attr event 'X-HNH-FILENAME))
- (stream ; event
- )
- )))