From 3c9b8911b5952afe6ad69d04fbcbb7169bb0db3c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Tue, 22 Feb 2022 18:02:12 +0100
Subject: Fix modularization of recurrence display.

---
 module/vcomponent/recurrence/display/sv.scm | 139 ++++++++++++++++++++++++++++
 1 file changed, 139 insertions(+)
 create mode 100644 module/vcomponent/recurrence/display/sv.scm

(limited to 'module/vcomponent/recurrence/display/sv.scm')

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"])))))
-- 
cgit v1.2.3