Rename module vcalendar => vcomponent.

3 files changed, 0 insertions, 313 deletions

diff --git a/module/vcalendar/recurrence/generate.scm b/module/vcalendar/recurrence/generate.scm
deleted file mode 100644
index 3baaa6eb..00000000
--- a/module/vcalendar/recurrence/generate.scm
+++ /dev/null
@@ -1,137 +0,0 @@
-(define-module (vcalendar recurrence generate)
-  #:use-module (srfi srfi-19)           ; Datetime
-  #:use-module (srfi srfi-19 util)
-  #:use-module (srfi srfi-19 setters)
-  #:use-module (srfi srfi-26)           ; Cut
-  #:use-module (srfi srfi-41)           ; Streams
-  #:use-module (ice-9 match)
-
-  #:use-module (util)
-  #:use-module (vcalendar)
-  #:use-module (vcalendar timezone)
-  #:use-module (vcalendar recurrence internal)
-  #:use-module (vcalendar 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))
-         (d (time-utc->date
-             (attr e 'DTSTART)
-             (if (prop (attr* ev 'DTSTART) 'TZID)
-                 (get-tz-offset e)
-                 0))))
-
-    (let ((i (interval r)))
-     (case (freq r)
-       ((SECONDLY) (mod! (second d) = (+ i)))
-       ((MINUTELY) (mod! (minute d) = (+ i)))
-       ((HOURLY)   (mod! (hour   d) = (+ i)))
-       ((DAILY)    (mod! (day    d) = (+ i)))
-       ((WEEKLY)   (mod! (day    d) = (+ (* i 7))))
-       ((MONTHLY)  (mod! (month  d) = (+ i)))
-       ((YEARLY)   (mod! (year   d) = (+ i)))))
-
-    (set! (attr e 'DTSTART)
-          (date->time-utc d))
-
-    (when (prop (attr* e 'DTSTART) 'TZID)
-      (let ((of (get-tz-offset e)))
-        ;; This addition works, but we still get lunch at 13
-        (set! (zone-offset d) of)))
-
-    (set! (attr e 'DTSTART)
-          (date->time-utc d))
-
-    (when (attr e 'DTEND)
-     (set! (attr e 'DTEND)
-           (add-duration (attr e 'DTSTART) (attr e 'DURATION))))
-
-    ;; Return
-    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
-   car
-
-   ;; 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) (cut time<=? (attr e 'DTSTART) <>))))) ; UNTIL
-
-   ;; Event x Rule → next (Event, Rule)
-   (match-lambda
-     ((e r)
-      (list (next-event e r)
-            (if (count r)
-                ;; Note that this doesn't modify, since r is immutable.
-                (mod! (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.
-  (if (not (attr event 'RRULE))
-      (stream event)
-      (begin
-        (when (and (attr event 'DTEND)
-                   (not (attr event 'DURATION)))
-          (set! (attr event "DURATION")
-                (time-difference
-                 (attr event "DTEND")
-                 (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))))
diff --git a/module/vcalendar/recurrence/internal.scm b/module/vcalendar/recurrence/internal.scm
deleted file mode 100644
index 7a81b2db..00000000
--- a/module/vcalendar/recurrence/internal.scm
+++ /dev/null
@@ -1,45 +0,0 @@
-(define-module (vcalendar recurrence internal)
-  #:use-module (util)
-  #:use-module ((ice-9 optargs) #:select (define*-public))
-  #:use-module (srfi srfi-88)
-  #:export (make-recur-rule
-            weekdays intervals))
-
-;; Immutable, since I easily want to be able to generate the recurence set for
-;; the same event multiple times.
-(define-quick-record recur-rule
-  (public: freq until count interval bysecond byminute byhour
-           byday bymonthday byyearday byweekno bymonth bysetpos
-           wkst))
-
-(define (make-recur-rule interval wkst)
-  ((record-constructor <recur-rule> '(interval wkst)) interval wkst))
-
-;; TODO make this part of define-quick-record.
-;; Only "hard" part would be to provide type hints for fields for
-;; string conversions.
-(define-public (format-recur-rule r)
-  (define (a f)
-    ((record-accessor <recur-rule> f) r))
-  (with-output-to-string
-    (lambda ()
-      (format #t "#<recur-rule>~%")
-      (for-each
-       (lambda (field)
-         (when (a field)
-           (format #t "   ~8@a: ~a~%"
-                   field
-                   ((case field
-                      ((until) (@ (srfi srfi-19 util) time->string))
-                      (else identity))
-                    (a field)))))
-       (record-type-fields <recur-rule>)))))
-
-(define*-public (print-recur-rule r #:optional (port (current-output-port)))
-  (display (format-recur-rule r) port))
-
-(define weekdays
-  '(SU MO TU WE TH FR SA))
-
-(define intervals
-  '(SECONDLY MINUTELY HOURLY DAILY WEEKLY MONTHLY YEARLY))
diff --git a/module/vcalendar/recurrence/parse.scm b/module/vcalendar/recurrence/parse.scm
deleted file mode 100644
index 50d0e0a8..00000000
--- a/module/vcalendar/recurrence/parse.scm
+++ /dev/null
@@ -1,131 +0,0 @@
-(define-module (vcalendar recurrence parse)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-19)           ; Datetime
-  #:use-module (srfi srfi-19 util)
-  #:use-module (srfi srfi-26)
-  #:use-module ((vcalendar datetime) #:select (parse-datetime))
-  #:duplicates (last)                   ; Replace @var{count}
-  #:use-module (vcalendar recurrence internal)
-  #:use-module (util)
-  #:use-module (exceptions)
-  #:use-module (ice-9 curried-definitions)
-  #:export (parse-recurrence-rule))
-
-
-(define (printerr fmt . args)
-  (apply format (current-error-port)
-          fmt args))
-
-(define (parse-recurrence-rule str)
-  (catch-multiple
-    (lambda () (%build-recur-rules str))
-
-    [unfulfilled-constraint
-     (cont obj key val . rest)
-     (printerr "ERR ~a [~a] doesn't fulfill constraint of type [~a], ignoring~%"
-               err val key)
-     (cont #f)]
-
-    [invalid-value
-     (cont obj key val . rest)
-     (printerr "ERR ~a [~a] for key [~a], ignoring.~%"
-               err val key)
-     (cont #f)]))
-
-(eval-when (expand)
- (define ((handle-case stx obj) key val proc)
-   (with-syntax ((skey (datum->syntax
-                        stx (symbol-downcase (syntax->datum key)))))
-     #`((#,key)
-        (let ((v #,val))
-          (cond ((not v) (throw-returnable 'invalid-value #,obj (quote #,key) v))
-                ((#,proc #,val) (set! (skey #,obj) v))
-                (else (set! (skey #,obj)
-                            (throw-returnable 'unfulfilled-constraint
-                                              #,obj (quote #,key) v)))))))))
-
-
-;; A special form of case only useful in parse-recurrence-rules above.
-;; Each case is on the form (KEY val check-proc) where:
-;; `key` is what should be matched against, and what is used for the setter
-;; `val` is the value to bind to the loop object and
-;; `check` is something the object must conform to
-(define-syntax quick-case
-  (lambda (stx)
-   (syntax-case stx ()
-     ((_ var-key obj (key val proc) ...)
-      #`(case var-key
-          #,@(map (handle-case stx #'obj)
-                  #'(key ...)
-                  #'(val ...)
-                  #'(proc ...))
-        (else obj))))))
-
-(define-syntax all-in
-  (syntax-rules ()
-    ((_ var rules ...)
-     (cut every (lambda (var) (and rules ...)) <>))))
-
-(define (string->number-list val delim)
-  (map string->number (string-split val delim)))
-
-(define (string->symbols val delim)
-  (map string->symbol (string-split val delim)))
-
-;; @example
-;; <weekday> ∈ weekdays
-;; <weekdaynum> ::= [[±] <num>] <weekday> ;; +3MO
-;; (<weekadynum>, ...)
-;; @end example
-
-;; Returns a pair, where the @code{car} is the offset
-;; and @code{cdr} is the day symbol.
-;; The @code{car} may be @code{#f}.
-(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))))
-
-(define (%build-recur-rules str)
-  (fold
-   (lambda (kv obj)
-     (let* (((key val) kv)
-            ;; Lazy fields for the poor man.
-            (symb (lambda () (string->symbol val)))
-            (date (lambda () (date->time-utc (parse-datetime val))))
-            (days (lambda () (map parse-day-spec (string-split val #\,))))
-            (num  (lambda () (string->number val)))
-            (nums (lambda () (string->number-list val #\,))))
-       (quick-case (string->symbol key) obj
-                   (FREQ     (symb) (cut memv <> intervals)) ; Required
-                   (UNTIL    (date) identity)
-                   (COUNT    (num)  (cut <= 0 <>))
-                   (INTERVAL (num)  (cut <= 0 <>))
-                   (BYSECOND (nums) (all-in n (<= 0 n 60)))
-                   (BYMINUTE (nums) (all-in n (<= 0 n 59)))
-                   (BYHOUR   (nums) (all-in n (<= 0 n 23)))
-
-                   (BYDAY (days)
-                          (lambda (p*)
-                            (map (lambda (p)
-                                   (let* (((num . symb) p))
-                                     (memv symb weekdays)))
-                                 p*)))
-
-                   (BYMONTHDAY (nums) (all-in n (<=  -31 n  31) (!= n 0)))
-                   (BYYEARDAY  (nums) (all-in n (<= -366 n 366) (!= n 0)))
-                   (BYWEEKNO   (nums) (all-in n (<=  -53 n  53) (!= n 0)))
-                   (BYMONTH    (nums) (all-in n (<=    1 n  12)))
-                   (BYSETPOS   (nums) (all-in n (<= -366 n 366) (!= n 0)))
-
-                   (WKST (symb) (cut memv <> weekdays))
-                   )))
-
-   ;; obj
-   (make-recur-rule 1 'MO)
-
-   ;; ((key val) ...)
-   (map (cut string-split <> #\=)
-        (string-split str #\;))))