Added pretty formatter for RRULE:s.

2 files changed, 380 insertions, 0 deletions

diff --git a/module/vcomponent/recurrence/display.scm b/module/vcomponent/recurrence/display.scm
new file mode 100644
index 00000000..beb89277
--- /dev/null
+++ b/module/vcomponent/recurrence/display.scm
@@ -0,0 +1,144 @@
+(define-module (vcomponent recurrence display)
+  :use-module (vcomponent recurrence internal)
+  :use-module (util)
+  :use-module (output text)
+  :use-module ((datetime) :select (time))
+  :use-module (datetime util)
+  )
+
+
+(define (rrule-month->string n)
+  (locale-month n))
+
+(define (rrule-week->string symb )
+  (week-day-name
+   (case symb
+     [(SU) sun]
+     [(MO) mon]
+     [(TU) tue]
+     [(WE) wed]
+     [(TH) thu]
+     [(FR) fri]
+     [(SA) sat]
+     [else (error "Invalid day symbol")])))
+
+
+;; 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)))
+    (intersperce
+     " samt "
+     (map (lambda (group)
+            ;; TODO sort week days
+            (case (car group)
+              [(#f)
+               (list "varje "
+                     (add-enumeration-punctuation
+                      (map (lambda (d) (list (rrule-week->string (cdr d))))
+                           (cadr group)
+                           )))]
+              [else
+               (list (number->string-ordinal (car group)) " "
+                     (add-enumeration-punctuation
+                      (map (lambda (d) (list (rrule-week->string (cdr d)) "en"))
+                           (cadr group))))])
+            )
+          groups))))
+
+(define (format-bymonth-day lst)
+  (list "den "
+        (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 " 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) (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 rrule-week->string 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: (cdr 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"])))))
diff --git a/module/vcomponent/recurrence/display/test.scm b/module/vcomponent/recurrence/display/test.scm
new file mode 100644
index 00000000..3502cd5a
--- /dev/null
+++ b/module/vcomponent/recurrence/display/test.scm
@@ -0,0 +1,236 @@
+;;; Commentary:
+;; This is a pure test file, but it's not placed together with the other
+;; tests since it requires a human to read the output.
+;;; Code:
+
+(use-modules (vcomponent recurrence display)
+             (vcomponent recurrence parse)
+             (util))
+
+;; Examples copied from RFC5545
+
+(define (run-test desc sources)
+  (format #t "~%> ~a~%" desc)
+  (for el in (map (compose format-recurrence-rule
+                           parse-recurrence-rule)
+                  sources)
+       (format #t "=> upprepas ~a.~%" el)))
+
+(define-syntax test
+  (syntax-rules (description source)
+    [(_ (description desc)
+        (source sources ...))
+     (run-test desc (list sources ...))]))
+
+(test
+ (description "Daily for 10 occurrences")
+ (source "FREQ=DAILY;COUNT=10"))
+;; => "dagligen, 10 gånger."
+
+(test
+ (description "Daily until December 24, 1997")
+ (source "FREQ=DAILY;UNTIL=19971224T000000Z"))
+;; => "dagligen, till och med den 24 december, 1997 kl.  0:00"
+
+
+(test
+ (description "Every other day - forever")
+ (source "FREQ=DAILY;INTERVAL=2"))
+;; => "varannan dag"
+
+(test
+ (description "Every 10 days, 5 occurrences")
+ (source "FREQ=DAILY;INTERVAL=10;COUNT=5"))
+;; => "var tionde dag, 5 gånger."
+
+;; TODO sortera ordningen på dagar
+(test
+ (description "Every day in January, for 3 years")
+ (source "FREQ=YEARLY;UNTIL=20000131T140000Z;BYMONTH=1;BYDAY=SU,MO,TU,WE,TH,FR,SA"
+         "FREQ=DAILY;UNTIL=20000131T140000Z;BYMONTH=1" ))
+;; => "varje lördag, fredag, torsdag, onsdag, tisdag, måndag & söndag januari varje år, till och med den 31 januari, 2000 kl. 14:00"
+;; => "dagligen, till och med den 31 januari, 2000 kl. 14:00"
+
+(test
+ (description "Weekly for 10 occurrences")
+ (source "FREQ=WEEKLY;COUNT=10"))
+;; => "varje vecka, 10 gånger."
+
+(test
+ (description "Weekly until December 24, 1997")
+ (source "FREQ=WEEKLY;UNTIL=19971224T000000Z"))
+;; => "varje vecka, till och med den 24 december, 1997 kl.  0:00"
+
+(test
+ (description "Every other week - forever")
+ (source "FREQ=WEEKLY;INTERVAL=2;WKST=SU"))
+;; => "varannan vecka"
+
+(test
+ (description "Weekly on Tuesday and Thursday for five weeks")
+ (source "FREQ=WEEKLY;UNTIL=19971007T000000Z;WKST=SU;BYDAY=TU,TH"
+         "FREQ=WEEKLY;COUNT=10;WKST=SU;BYDAY=TU,TH"))
+;; => "varje tisdag & torsdag, till och med den 07 oktober, 1997 kl. 00:00"
+;; => "varje tisdag & torsdag, 10 gånger."
+
+(test
+ (description "Every other week on Monday, Wednesday, and Friday until December 24, 1997, starting on Monday, September 1, 1997:")
+ (source "FREQ=WEEKLY;INTERVAL=2;UNTIL=19971224T000000Z;WKST=SU;BYDAY=MO,WE,FR"))
+;; => "varannan måndag, onsdag & fredag, till och med den 24 december, 1997 kl.  0:00"
+
+;; TOOD tittta närmare vad de egentligen vill ha här
+(test
+ (description "Every other week on Tuesday and Thursday, for 8 occurrences")
+ (source "FREQ=WEEKLY;INTERVAL=2;COUNT=8;WKST=SU;BYDAY=TU,TH"))
+;; => "varannan tisdag & torsdag, 8 gånger."
+
+(test
+ (description "Monthly on the first Friday for 10 occurrences")
+ (source "FREQ=MONTHLY;COUNT=10;BYDAY=1FR"))
+;; => "första fredagen varje månad, 10 gånger."
+
+(test
+ (description "Monthly on the first Friday until December 24, 1997")
+ (source "FREQ=MONTHLY;UNTIL=19971224T000000Z;BYDAY=1FR"))
+;; => "förste fredagen varje månad, till och med den 24 december, 1997 kl.  0:00"
+
+(test
+ (description "Every other month on the first and last Sunday of the month for 10 occurrences")
+ (source "FREQ=MONTHLY;INTERVAL=2;COUNT=10;BYDAY=1SU,-1SU"))
+;; => "första söndagen samt siste söndagen varannan månad, 10 gånger."
+
+(test
+ (description "Monthly on the second-to-last Monday of the month for 6 months")
+ (source "FREQ=MONTHLY;COUNT=6;BYDAY=-2MO"))
+;; => "näst sista måndagen varje månad, 6 gånger."
+
+(test
+ (description "Monthly on the third-to-the-last day of the month, forever")
+ (source "FREQ=MONTHLY;BYMONTHDAY=-3"))
+;; => "den tredje sista varje månad"
+
+(test
+ (description "Monthly on the 2nd and 15th of the month for 10 occurrences")
+ (source "FREQ=MONTHLY;COUNT=10;BYMONTHDAY=2,15"))
+;; => "den andre & femtonde varje månad, 10 gånger."
+
+(test
+ (description "Monthly on the first and last day of the month for 10 occurrences")
+ (source "FREQ=MONTHLY;COUNT=10;BYMONTHDAY=1,-1"))
+;; => "den förste & sista varje månad, 10 gånger."
+
+(test
+ (description "Every 18 months on the 10th thru 15th of the month for 10 occurrences")
+ (source "FREQ=MONTHLY;INTERVAL=18;COUNT=10;BYMONTHDAY=10,11,12,13,14,15"))
+;; => "den tionde, elfte, tolfte, trettonde, fjortonde & femtonde var artonde månad, 10 gånger."
+
+(test
+ (description "Every Tuesday, every other month")
+ (source "FREQ=MONTHLY;INTERVAL=2;BYDAY=TU"))
+;; => "varje tisdag varannan månad"
+
+(test
+ (description "Yearly in June and July for 10 occurrences:
+Note: Since none of the BYDAY, BYMONTHDAY, or BYYEARDAY
+components are specified, the day is gotten from \"DTSTART\".")
+ (source "FREQ=YEARLY;COUNT=10;BYMONTH=6,7"))
+;; => "juni & juli årligen, 10 gånger."
+
+(test
+ (description "Every other year on January, February, and March for 10 occurrences")
+ (source "FREQ=YEARLY;INTERVAL=2;COUNT=10;BYMONTH=1,2,3"))
+;; => "januari, februari & mars vartannat år, 10 gånger."
+
+(test
+ (description "Every third year on the 1st, 100th, and 200th day for 10 occurrences")
+ (source "FREQ=YEARLY;INTERVAL=3;COUNT=10;BYYEARDAY=1,100,200"))
+;; => "dag 1, 100 & 200 vart tredje år, 10 gånger."
+
+(test
+ (description "Every 20th Monday of the year, forever")
+ (source "FREQ=YEARLY;BYDAY=20MO"))
+;; => "tjugonde måndagen årligen"
+
+(test
+ (description "Monday of week number 20 (where the default start of the week is Monday), forever")
+ (source "FREQ=YEARLY;BYWEEKNO=20;BYDAY=MO"))
+;; => "varje måndag v.20 årligen"
+
+(test
+ (description "Every Thursday in March, forever")
+ (source "FREQ=YEARLY;BYMONTH=3;BYDAY=TH"))
+;; => "varje torsdag i mars, årligen"
+
+(test
+ (description "Every Thursday, but only during June, July, and August, forever")
+ (source "FREQ=YEARLY;BYDAY=TH;BYMONTH=6,7,8"))
+;; => "varje torsdag i juni, juli & augusti, årligen"
+
+;; NOTE This has some weird grammar in swedish
+(test
+ (description "Every Friday the 13th, forever")
+ (source "FREQ=MONTHLY;BYDAY=FR;BYMONTHDAY=13"))
+;; => "varje fredag den trettonde varje månad"
+
+(test
+ (description "The first Saturday that follows the first Sunday of the month,forever")
+ (source "FREQ=MONTHLY;BYDAY=SA;BYMONTHDAY=7,8,9,10,11,12,13"))
+;; => "varje lördag den sjunde, åttonde, nionde, tionde, elfte, tolfte & trettonde varje månad"
+
+;; TODO
+(test
+ (description
+  "Every 4 years, the first Tuesday after a Monday in November,
+forever (U.S. Presidential Election day)")
+ (source "FREQ=YEARLY;INTERVAL=4;BYMONTH=11;BYDAY=TU;BYMONTHDAY=2,3,4,5,6,7,8"))
+;; => "varje tisdag  i novembervart fjärde år"
+;; => "varje tisdag den andre, tredje, fjärde, femte, sjätte, sjunde & åttonde i november vart fjärde år"
+
+;; TODO bysetpos
+
+(test
+ (description "The third instance into the month of one of Tuesday, Wednesday, or
+Thursday, for the next 3 months")
+ (source "FREQ=MONTHLY;COUNT=3;BYDAY=TU,WE,TH;BYSETPOS=3"))
+
+(test
+ (description "The second-to-last weekday of the month")
+ (source "FREQ=MONTHLY;BYDAY=MO,TU,WE,TH,FR;BYSETPOS=-2"))
+
+(test
+ (description "Every 3 hours from 9:00 AM to 5:00 PM on a specific day")
+ (source "FREQ=HOURLY;INTERVAL=3;UNTIL=19970902T170000Z"))
+;; => "var tredje timme, till och med den 02 september, 1997 kl. 17:00"
+
+(test
+ (description "Every 15 minutes for 6 occurrences")
+ (source "FREQ=MINUTELY;INTERVAL=15;COUNT=6"))
+;; => "var femtonde minut, 6 gånger."
+
+(test
+ (description "Every hour and a half for 4 occurrences")
+ (source "FREQ=MINUTELY;INTERVAL=90;COUNT=4"))
+;; => "var nitionde minut, 4 gånger."
+
+(test
+ (description "Every 20 minutes from 9:00 AM to 4:40 PM every day")
+ (source "FREQ=DAILY;BYHOUR=9,10,11,12,13,14,15,16;BYMINUTE=0,20,40"
+         "FREQ=MINUTELY;INTERVAL=20;BYHOUR=9,10,11,12,13,14,15,16"))
+;; => "dagligen kl. 09:00, 09:20, 09:40, 10:00, 10:20, 10:40, 11:00, 11:20, 11:40, 12:00, 12:20, 12:40, 13:00, 13:20, 13:40, 14:00, 14:20, 14:40, 15:00, 15:20, 15:40, 16:00, 16:20 & 16:40"
+;; or
+;; => "var 20e minut kl. 9, 10, 11, 12, 13, 14, 15 & 16"
+
+(test
+ (description "An example where the days generated makes a difference because of WKST")
+ (source "FREQ=WEEKLY;INTERVAL=2;COUNT=4;BYDAY=TU,SU;WKST=MO"))
+;; => "varannan tisdag & söndag, 4 gånger."
+
+(test
+ (description "changing only WKST from MO to SU, yields different results...")
+ (source "FREQ=WEEKLY;INTERVAL=2;COUNT=4;BYDAY=TU,SU;WKST=SU"))
+;; => "varannan tisdag & söndag, 4 gånger."
+
+(test
+ (description "An example where an invalid date (i.e., February 30) is ignored.")
+ (source "FREQ=MONTHLY;BYMONTHDAY=15,30;COUNT=5"))
+;; => "den 15 & 30 varje månad, 5 gånger."