blob: ee8fc3fdd24caa149af9bfd172f926f3f6d3d7e8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
;;; 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))
:export (format-recurrence-rule))
;; 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))))
(cdr group)
)))]
[else
(list (number->string-ordinal
(car group)
a-form?: #t)
" "
(add-enumeration-punctuation
(map (lambda (d) (list (week-day-name (cdr d)) "en"))
(cdr group))))])
)
groups))))
(define* (format-bymonth-day lst optional: (final-delim "&"))
(list "den "
(add-enumeration-punctuation
(map number->string-ordinal lst)
final-delim)))
(define (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"])))))
|
