Fix modularization of recurrence display.

4 files changed, 285 insertions, 145 deletions

diff --git a/module/vcomponent/recurrence/display.scm b/module/vcomponent/recurrence/display.scm
index f5ce1c57..8a9f33e6 100644
--- a/module/vcomponent/recurrence/display.scm
+++ b/module/vcomponent/recurrence/display.scm
@@ -1,146 +1,10 @@
-;;; Commentary:
-;; Pretty print a recurrence rule (in Swedish). Is currently missing a
-;; number of ;; edge cases, and even more concerning limited events.
-;; NOTE It would be preferable if this could share as much logic as possible
-;; with the "real" generator.
-;;; Code:
-
 (define-module (vcomponent recurrence display)
-  :use-module (hnh util)
-  :use-module (vcomponent recurrence internal)
-  :use-module (text util)
-  :use-module (text numbers sv)
-  :use-module ((datetime) :select (time time->string
-                                        datetime->string
-                                        week-day-name
-                                        locale-month
-                                        ))
-  )
-
-
-(define (rrule-month->string n)
-  (locale-month n))
-
-;; TODO this currently only groups on offsets, but not on days.
-;; So 1MO, 1TU becomes "första måndagen och tisdagen", which is good
-;; but 1MO, -1MO doesn't become "första och sista måndagen".
-;; TODO also, grouping of -dagen. e.g. "första mån- och tisdagen"
-(define (format-byday-list lst)
-  (let* ((groups (group-by car lst)))
-    (intersperse
-     " samt "
-     (map (lambda (group)
-            ;; TODO sort week days
-            (case (car group)
-              [(#f)
-               (list "varje "
-                     (add-enumeration-punctuation
-                      (map (lambda (d) (list (week-day-name (cdr d))))
-                           (cadr group)
-                           )))]
-              [else
-               (list (number->string-ordinal
-                      (car group)
-                      a-form?: #t)
-                     " "
-                     (add-enumeration-punctuation
-                      (map (lambda (d) (list (week-day-name (cdr d)) "en"))
-                           (cadr group))))])
-            )
-          groups))))
-
-(define* (format-bymonth-day lst optional: (final-delim "&"))
-  (list "den "
-        (add-enumeration-punctuation
-         (map number->string-ordinal lst)
-         final-delim)))
-
-
-(define-public (format-recurrence-rule rrule)
-  (string-trim
-   (string-flatten
-    (list
-     (case (freq rrule)
-       [(YEARLY)
-        (list (awhen (byday rrule) (list " " (format-byday-list it)))
-              (awhen (bymonthday rrule) (list " " (format-bymonth-day it "eller")))
-              (awhen (byyearday rrule)
-                     (list " dag " (add-enumeration-punctuation it)))
-              (awhen (bymonth rrule)
-                     ;; only `i' here if we have output something else beforehand
-                     (list (when (or (byday rrule)
-                                     (bymonthday rrule)
-                                     (byyearday rrule))
-                             " i ")
-                           (add-enumeration-punctuation
-                            (map rrule-month->string it))))
-              (awhen (byweekno rrule)
-                     (map (lambda (v) (format #f " v.~a" v)) it))
-              )]
-       [(MONTHLY)
-        (list
-         (awhen (byday rrule) (list (format-byday-list it)))
-         (awhen (bymonthday rrule) (cons " " (format-bymonth-day it))))]
-       [else '()])
-
-     ;; TODO my parser adds an implicit interval to every object
-     ;; this might be wrong
-     (cond [(and (eq? 'DAILY (freq rrule)) (= 1 (interval rrule)))
-            " dagligen"]
-           [(and (eq? 'YEARLY (freq rrule)) (= 1 (interval rrule)))
-            ", årligen"]
-           [(and (eq? 'MINUTELY (freq rrule))
-                 (zero? (modulo (interval rrule) 15)))
-            (list " "
-                  (each-string (/ (interval rrule) 15))
-                  " kvart")]
-           [else
-            (list
-             " "
-             (each-string (interval rrule) (eq? 'YEARLY (freq rrule)))
-             " "
-             (case (freq rrule)
-               ;; p.44 RFC 5545
-               [(SECONDLY) "sekund"]
-               [(MINUTELY) "minut"]
-               [(HOURLY) "timme"]
-               [(DAILY) "dag"]
-
-               ;; day offsets CAN ONLY be present when FREQ is
-               ;; either MONTHLY or YEARLY
-               [(WEEKLY) (aif (byday rrule)
-                              (add-enumeration-punctuation
-                               (map (compose week-day-name cdr) it))
-                              "vecka")]
-               [(MONTHLY) "månad"]
-               [(YEARLY) "år"]
-               [else "ERROR"]
-               ))])
-
-     (cond [(and (byminute rrule)
-                 (byhour rrule))
-            (list
-             " kl. "
-             (add-enumeration-punctuation
-              (map (lambda (pair)
-                     (time->string
-                      (time hour: (car pair)
-                            minute: (cadr pair))
-                      "~H:~M"))
-                   (cross-product (byhour rrule)
-                                  (byminute rrule)))))]
-           [(byhour rrule)
-            => (lambda (hours)
-                 (list " kl. " (add-enumeration-punctuation hours)))]
-           [else '()])
-
-     (awhen (until rrule)
-            (format #f ", till och med ~a"
-                    (datetime->string
-                     ;; TODO ordinal on ~d?
-                     it "den ~d ~B, ~Y kl. ~k:~M")
-                    ))
-     (cond [(not (count rrule)) ""]
-           [(= 1 (count rrule)) (list ", totalt " (count rrule) " gång")]
-           [(count rrule) (list ", totalt " (count rrule) " gånger")]
-           [else "ERROR"])))))
+  :use-module (vcomponent recurrence display common)
+  :use-module (hnh util language)
+  :re-export (rrule-month->string)
+  :export (format-recurrence-rule))
+
+(define* (format-recurrence-rule rrule #:optional (language (resolve-language)))
+  ((module-ref (resolve-interface `(vcomponent recurrence display ,language))
+               'format-recurrence-rule)
+   rrule))
diff --git a/module/vcomponent/recurrence/display/common.scm b/module/vcomponent/recurrence/display/common.scm
new file mode 100644
index 00000000..c9d0f5e1
--- /dev/null
+++ b/module/vcomponent/recurrence/display/common.scm
@@ -0,0 +1,6 @@
+(define-module (vcomponent recurrence display common)
+  :use-module ((datetime) :select (locale-month))
+  :export (rrule-month->string))
+
+(define (rrule-month->string n)
+  (locale-month n))
diff --git a/module/vcomponent/recurrence/display/en.scm b/module/vcomponent/recurrence/display/en.scm
new file mode 100644
index 00000000..be9bdf53
--- /dev/null
+++ b/module/vcomponent/recurrence/display/en.scm
@@ -0,0 +1,131 @@
+(define-module (vcomponent recurrence display en)
+  :use-module (hnh util)
+  :use-module (vcomponent recurrence internal)
+  :use-module (text util)
+  :use-module (text numbers)
+  :use-module (vcomponent recurrence display common)
+  :use-module ((datetime) :select (time time->string
+                                        datetime->string
+                                        week-day-name)))
+
+
+
+;; TODO this currently only groups on offsets, but not on days.
+;; So 1MO, 1TU becomes "första måndagen och tisdagen", which is good
+;; but 1MO, -1MO doesn't become "första och sista måndagen".
+;; TODO also, grouping of -dagen. e.g. "första mån- och tisdagen"
+(define (format-byday-list lst)
+  (let* ((groups (group-by car lst)))
+    (intersperse
+     " as well as "
+     (map (lambda (group)
+            ;; TODO sort week days
+            (case (car group)
+              [(#f)
+               (list "every "
+                     (add-enumeration-punctuation
+                      (map (lambda (d) (list (week-day-name (cdr d))))
+                           (cadr group)
+                           )))]
+              [else
+               (list (number->string-ordinal (car group)) " "
+                     (add-enumeration-punctuation
+                      (map (lambda (d) (list (week-day-name (cdr d)) "en"))
+                           (cadr group))))])
+            )
+          groups))))
+
+(define (format-bymonth-day lst)
+  (list "the "
+        (add-enumeration-punctuation
+         (map number->string-ordinal lst))))
+
+
+(define-public  (format-recurrence-rule rrule)
+  (string-trim
+   (string-flatten
+    (list
+     (case (freq rrule)
+       [(YEARLY)
+        (list (awhen (byday rrule) (list " " (format-byday-list it)))
+              (awhen (bymonthday rrule) (list " " (format-bymonth-day it)))
+              (awhen (byyearday rrule)
+                     (list " day " (add-enumeration-punctuation it)))
+              (awhen (bymonth rrule)
+                     ;; only `i' here if we have output something else beforehand
+                     (list (when (or (byday rrule)
+                                     (bymonthday rrule)
+                                     (byyearday rrule))
+                             " in ")
+                           (add-enumeration-punctuation
+                            (map rrule-month->string it))))
+              (awhen (byweekno rrule)
+                     (map (lambda (v) (format #f " v.~a" v)) it))
+              )]
+       [(MONTHLY)
+        (list
+         (awhen (byday rrule) (list (format-byday-list it)))
+         (awhen (bymonthday rrule) (format-bymonth-day it)))]
+       [else '()])
+
+     ;; TODO my parser adds an implicit interval to every object
+     ;; this might be wrong
+     (cond [(and (eq? 'DAILY (freq rrule)) (= 1 (interval rrule)))
+            " daily"]
+           [(and (eq? 'YEARLY (freq rrule)) (= 1 (interval rrule)))
+            ", yearly"]
+           [(and (eq? 'MINUTELY (freq rrule))
+                 (zero? (modulo (interval rrule) 15)))
+            (list " "
+                  (each-string (/ (interval rrule) 15))
+                  " 15 minutes")]
+           [else
+            (list
+             " "
+             (each-string (interval rrule) (eq? 'YEARLY (freq rrule)))
+             " "
+             (case (freq rrule)
+               ;; p.44 RFC 5545
+               [(SECONDLY) "second"]
+               [(MINUTELY) "minute"]
+               [(HOURLY) "hour"]
+               [(DAILY) "day"]
+
+               ;; day offsets CAN ONLY be present when FREQ is
+               ;; either MONTHLY or YEARLY
+               [(WEEKLY) (aif (byday rrule)
+                              (add-enumeration-punctuation
+                               (map (compose week-day-name cdr) it))
+                              "week")]
+               [(MONTHLY) "month"]
+               [(YEARLY) "year"]
+               [else "ERROR"]
+               ))])
+
+     (cond [(and (byminute rrule)
+                 (byhour rrule))
+            (list
+             " at "
+             (add-enumeration-punctuation
+              (map (lambda (pair)
+                     (time->string
+                      (time hour: (car pair)
+                            minute: (cdr pair))
+                      "~H:~M"))
+                   (cross-product (byhour rrule)
+                                  (byminute rrule)))))]
+           [(byhour rrule)
+            => (lambda (hours)
+                 (list " at " (add-enumeration-punctuation hours)))]
+           [else '()])
+
+     (awhen (until rrule)
+            (format #f ", until ~a"
+                    (datetime->string
+                     ;; TODO ordinal on ~d?
+                     it "~B ~d, ~Y at ~k:~M")
+                    ))
+     (cond [(not (count rrule)) ""]
+           [(= 1 (count rrule)) (list ", " (count rrule) " time in total")]
+           [(count rrule) (list ", " (count rrule) " times in total")]
+           [else "ERROR"])))))
diff --git a/module/vcomponent/recurrence/display/sv.scm b/module/vcomponent/recurrence/display/sv.scm
new file mode 100644
index 00000000..fe580474
--- /dev/null
+++ b/module/vcomponent/recurrence/display/sv.scm
@@ -0,0 +1,139 @@
+;;; Commentary:
+;; Pretty print a recurrence rule (in Swedish). Is currently missing a
+;; number of ;; edge cases, and even more concerning limited events.
+;; NOTE It would be preferable if this could share as much logic as possible
+;; with the "real" generator.
+;;; Code:
+
+(define-module (vcomponent recurrence display sv)
+  :use-module (hnh util)
+  :use-module (vcomponent recurrence internal)
+  :use-module (text util)
+  :use-module (text numbers sv)
+  :use-module (vcomponent recurrence display common)
+  :use-module ((datetime) :select (time time->string
+                                        datetime->string
+                                        week-day-name)))
+
+;; TODO this currently only groups on offsets, but not on days.
+;; So 1MO, 1TU becomes "första måndagen och tisdagen", which is good
+;; but 1MO, -1MO doesn't become "första och sista måndagen".
+;; TODO also, grouping of -dagen. e.g. "första mån- och tisdagen"
+(define (format-byday-list lst)
+  (let* ((groups (group-by car lst)))
+    (intersperse
+     " samt "
+     (map (lambda (group)
+            ;; TODO sort week days
+            (case (car group)
+              [(#f)
+               (list "varje "
+                     (add-enumeration-punctuation
+                      (map (lambda (d) (list (week-day-name (cdr d))))
+                           (cadr group)
+                           )))]
+              [else
+               (list (number->string-ordinal
+                      (car group)
+                      a-form?: #t)
+                     " "
+                     (add-enumeration-punctuation
+                      (map (lambda (d) (list (week-day-name (cdr d)) "en"))
+                           (cadr group))))])
+            )
+          groups))))
+
+(define* (format-bymonth-day lst optional: (final-delim "&"))
+  (list "den "
+        (add-enumeration-punctuation
+         (map number->string-ordinal lst)
+         final-delim)))
+
+(define-public (format-recurrence-rule rrule)
+  (string-trim
+   (string-flatten
+    (list
+     (case (freq rrule)
+       [(YEARLY)
+        (list (awhen (byday rrule) (list " " (format-byday-list it)))
+              (awhen (bymonthday rrule) (list " " (format-bymonth-day it "eller")))
+              (awhen (byyearday rrule)
+                     (list " dag " (add-enumeration-punctuation it)))
+              (awhen (bymonth rrule)
+                     ;; only `i' here if we have output something else beforehand
+                     (list (when (or (byday rrule)
+                                     (bymonthday rrule)
+                                     (byyearday rrule))
+                             " i ")
+                           (add-enumeration-punctuation
+                            (map rrule-month->string it))))
+              (awhen (byweekno rrule)
+                     (map (lambda (v) (format #f " v.~a" v)) it))
+              )]
+       [(MONTHLY)
+        (list
+         (awhen (byday rrule) (list (format-byday-list it)))
+         (awhen (bymonthday rrule) (cons " " (format-bymonth-day it))))]
+       [else '()])
+
+     ;; TODO my parser adds an implicit interval to every object
+     ;; this might be wrong
+     (cond [(and (eq? 'DAILY (freq rrule)) (= 1 (interval rrule)))
+            " dagligen"]
+           [(and (eq? 'YEARLY (freq rrule)) (= 1 (interval rrule)))
+            ", årligen"]
+           [(and (eq? 'MINUTELY (freq rrule))
+                 (zero? (modulo (interval rrule) 15)))
+            (list " "
+                  (each-string (/ (interval rrule) 15))
+                  " kvart")]
+           [else
+            (list
+             " "
+             (each-string (interval rrule) (eq? 'YEARLY (freq rrule)))
+             " "
+             (case (freq rrule)
+               ;; p.44 RFC 5545
+               [(SECONDLY) "sekund"]
+               [(MINUTELY) "minut"]
+               [(HOURLY) "timme"]
+               [(DAILY) "dag"]
+
+               ;; day offsets CAN ONLY be present when FREQ is
+               ;; either MONTHLY or YEARLY
+               [(WEEKLY) (aif (byday rrule)
+                              (add-enumeration-punctuation
+                               (map (compose week-day-name cdr) it))
+                              "vecka")]
+               [(MONTHLY) "månad"]
+               [(YEARLY) "år"]
+               [else "ERROR"]
+               ))])
+
+     (cond [(and (byminute rrule)
+                 (byhour rrule))
+            (list
+             " kl. "
+             (add-enumeration-punctuation
+              (map (lambda (pair)
+                     (time->string
+                      (time hour: (car pair)
+                            minute: (cadr pair))
+                      "~H:~M"))
+                   (cross-product (byhour rrule)
+                                  (byminute rrule)))))]
+           [(byhour rrule)
+            => (lambda (hours)
+                 (list " kl. " (add-enumeration-punctuation hours)))]
+           [else '()])
+
+     (awhen (until rrule)
+            (format #f ", till och med ~a"
+                    (datetime->string
+                     ;; TODO ordinal on ~d?
+                     it "den ~d ~B, ~Y kl. ~k:~M")
+                    ))
+     (cond [(not (count rrule)) ""]
+           [(= 1 (count rrule)) (list ", totalt " (count rrule) " gång")]
+           [(count rrule) (list ", totalt " (count rrule) " gånger")]
+           [else "ERROR"])))))