Rework vcomponent recurrence internals.

3 files changed, 57 insertions, 45 deletions

diff --git a/module/vcomponent/recurrence.scm b/module/vcomponent/recurrence.scm
index f941e7a8..12f901d2 100644
--- a/module/vcomponent/recurrence.scm
+++ b/module/vcomponent/recurrence.scm
@@ -1,12 +1,7 @@
 (define-module (vcomponent recurrence)
-  #:use-module (vcomponent base)
   #:use-module (vcomponent recurrence generate)
-  #:re-export (generate-recurrence-set)
-  #:export (repeating?))
-
-;; EXDATE is also a property linked to recurense rules
-;; but that property alone don't create a recuring event.
-(define (repeating? ev)
-  "Does this event repeat?"
-  (or (attr ev 'RRULE)
-      (attr ev 'RDATE)))
+  #:use-module (vcomponent recurrence parse)
+  #:use-module (vcomponent recurrence internal)
+  #:re-export (generate-recurrence-set
+               parse-recurrence-rule
+               repeating? format-recur-rule make-recur-rule))
diff --git a/module/vcomponent/recurrence/internal.scm b/module/vcomponent/recurrence/internal.scm
index f7095d1d..a7a3ae5e 100644
--- a/module/vcomponent/recurrence/internal.scm
+++ b/module/vcomponent/recurrence/internal.scm
@@ -1,45 +1,60 @@
 (define-module (vcomponent recurrence internal)
+  #:export (repeating? format-recur-rule make-recur-rule)
+
+  #:use-module (srfi srfi-88)           ; better keywords
+  #:use-module ((vcomponent base) :select (attr))
   #:use-module (util)
-  #:use-module ((ice-9 optargs) #:select (define*-public))
-  #:use-module (srfi srfi-88)
-  #:export (make-recur-rule
-            weekdays intervals))
+  )
+
+;; EXDATE is also a property linked to recurense rules
+;; but that property alone don't create a recuring event.
+(define (repeating? ev)
+  "Does this event repeat?"
+  (or (attr ev 'RRULE)
+      (attr ev 'RDATE)))
 
 ;; 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))
+           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>)))))
+  ;; TODO make this part of define-quick-record.
+  ;; Only "hard" part would be to provide type hints for fields for
+  ;; string conversions.
+  (printer:
+   (lambda (r port)
+     (define (get f)
+       ((record-accessor <recur-rule> f) r))
+     (with-output-to-string
+       (lambda ()
+         (display "#<<recur-rule>" port)
+         (for field in (record-type-fields <recur-rule>)
+              (awhen (get field)
+                     (display " ")
+                     (display field port)
+                     (display "=" port)
+                     (display
+                      (case field
+                        ((until) ((@ (srfi srfi-19 util) time->string) it))
+                        (else it))
+                      port)))
+         (display ">" port))))))
 
-(define*-public (print-recur-rule r #:optional (port (current-output-port)))
-  (display (format-recur-rule r) port))
+;; @begin{example}
+;; (mkrule (freq HOURLY) (wkst MO) (interval 1))
+;; @end
+;; TODO field validation here, like in parse-recurrence-rule.
+;; NOTE this shadows built in constructor generated in define-quick-record
+(define-syntax make-recur-rule
+  (syntax-rules ()
+    ((_ (key val) ...)
+     ((record-constructor <recur-rule> (quote (key ...)))
+      val ...))))
 
-(define weekdays
+(define-public weekdays
   '(SU MO TU WE TH FR SA))
 
-(define intervals
+(define-public intervals
   '(SECONDLY MINUTELY HOURLY DAILY WEEKLY MONTHLY YEARLY))
diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm
index 04c785a4..680a818e 100644
--- a/module/vcomponent/recurrence/parse.scm
+++ b/module/vcomponent/recurrence/parse.scm
@@ -1,14 +1,16 @@
 (define-module (vcomponent recurrence parse)
+  #:duplicates (last)                   ; Replace @var{count}
+
+  #:export (parse-recurrence-rule)
+
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)           ; Datetime
   #:use-module (srfi srfi-19 util)
   #:use-module (srfi srfi-26)
   #:use-module ((vcomponent datetime) #:select (parse-datetime))
-  #:duplicates (last)                   ; Replace @var{count}
   #:use-module (vcomponent recurrence internal)
   #:use-module (util)
-  #:use-module (ice-9 match)
-  #:export (parse-recurrence-rule))
+  #:use-module (ice-9 match))
 
 
 ;; @example
@@ -76,7 +78,7 @@
           (else o)))))
 
    ;; obj
-   (make-recur-rule 1 'MO)
+   (make-recur-rule (interval 1) (wkst 'MO))
 
    ;; ((key val) ...)
    (map (cut string-split <> #\=)