From 8f4fbcd493e28c86c598efcecdb6dc79d8fe0bfe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Tue, 23 Apr 2019 18:03:49 +0200
Subject: Rename module vcalendar => vcomponent.

---
 module/vcalendar/recurrence/parse.scm | 131 ----------------------------------
 1 file changed, 131 deletions(-)
 delete mode 100644 module/vcalendar/recurrence/parse.scm

(limited to 'module/vcalendar/recurrence/parse.scm')

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 #\;))))
-- 
cgit v1.2.3