From e8d7592a421e9cf4f773605de3e309748dbda794 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 19 May 2020 23:14:26 +0200 Subject: Remove old recurrence generator. --- module/vcomponent/recurrence/generate.scm | 171 ------------------------------ 1 file changed, 171 deletions(-) delete mode 100644 module/vcomponent/recurrence/generate.scm (limited to 'module/vcomponent/recurrence/generate.scm') 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 . -;; @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 - ) - ))) -- cgit v1.2.3