diff options
Diffstat (limited to 'module/vcomponent/recurrence/display.scm')
| -rw-r--r-- | module/vcomponent/recurrence/display.scm | 154 |
1 files changed, 9 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)) |