aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-04-17 22:07:28 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-04-17 22:07:28 +0200
commitad4adc7576c5c2e2c0cae010a6b0a14601a849ab (patch)
tree7f593bc1a5eca02f2b6e2f02676c9c380d68bbd2
parentAdd week numbers to HTML small calendar. (diff)
downloadcalp-ad4adc7576c5c2e2c0cae010a6b0a14601a849ab.tar.gz
calp-ad4adc7576c5c2e2c0cae010a6b0a14601a849ab.tar.xz
RRULE parser now converts weekdays to (datetime util) weekdays.
-rw-r--r--module/vcomponent/recurrence/display.scm19
-rw-r--r--module/vcomponent/recurrence/internal.scm3
-rw-r--r--module/vcomponent/recurrence/parse.scm18
3 files changed, 20 insertions, 20 deletions
diff --git a/module/vcomponent/recurrence/display.scm b/module/vcomponent/recurrence/display.scm
index beb89277..3510e512 100644
--- a/module/vcomponent/recurrence/display.scm
+++ b/module/vcomponent/recurrence/display.scm
@@ -10,19 +10,6 @@
(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".
@@ -37,13 +24,13 @@
[(#f)
(list "varje "
(add-enumeration-punctuation
- (map (lambda (d) (list (rrule-week->string (cdr d))))
+ (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 (rrule-week->string (cdr d)) "en"))
+ (map (lambda (d) (list (week-day-name (cdr d)) "en"))
(cadr group))))])
)
groups))))
@@ -108,7 +95,7 @@
;; either MONTHLY or YEARLY
[(WEEKLY) (aif (byday rrule)
(add-enumeration-punctuation
- (map (compose rrule-week->string cdr) it))
+ (map (compose week-day-name cdr) it))
"vecka")]
[(MONTHLY) "månad"]
[(YEARLY) "år"]
diff --git a/module/vcomponent/recurrence/internal.scm b/module/vcomponent/recurrence/internal.scm
index f7b49abc..cb00cd3d 100644
--- a/module/vcomponent/recurrence/internal.scm
+++ b/module/vcomponent/recurrence/internal.scm
@@ -3,6 +3,7 @@
#:use-module (srfi srfi-88) ; better keywords
#:use-module ((vcomponent base) :select (attr))
+ #:use-module (datetime util)
#:use-module (util)
)
@@ -55,7 +56,7 @@
val ...))))
(define-public weekdays
- '(SU MO TU WE TH FR SA))
+ (weekday-list sun))
(define-public intervals
'(SECONDLY MINUTELY HOURLY DAILY WEEKLY MONTHLY YEARLY))
diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm
index 9de8a4be..66605c11 100644
--- a/module/vcomponent/recurrence/parse.scm
+++ b/module/vcomponent/recurrence/parse.scm
@@ -12,6 +12,18 @@
#:use-module (ice-9 match))
+;; transform into weekday objects from
+(define (rfc->datetime-weekday symbol)
+ (case symbol
+ [(SU) sun]
+ [(MO) mon]
+ [(TU) tue]
+ [(WE) wed]
+ [(TH) thu]
+ [(FR) fri]
+ [(SA) sat]
+ [else => (lambda (d) (error "No such day ~a" d))]))
+
;; @example
;; <weekday> ∈ weekdays
;; <weekdaynum> ::= [[±] <num>] <weekday> ;; +3MO
@@ -31,7 +43,7 @@
(numbers letters (span (cut memv <> numerical-characters)
(string->list str))))
(cons (string->number (list->string numbers))
- (apply symbol letters))))
+ (rfc->datetime-weekday (apply symbol letters)))))
(define-macro (quick-case key . cases)
(let ((else-clause (or (assoc-ref cases 'else)
@@ -70,7 +82,7 @@
(INTERVAL (<= 0 num) => (set! (interval o) num))
(FREQ (memv symb intervals) => (set! (freq o) symb))
- (WKST (memv symb weekdays) => (set! (wkst o) symb))
+ (WKST (memv symb weekdays) => (set! (wkst o) (cdar days)))
;; Always positive
(BYSECOND (every (lambda (n) (<= 0 n 60)) nums) => (set! (bysecond o) nums))
@@ -89,7 +101,7 @@
(else o)))))
;; obj
- (make-recur-rule (interval 1) (wkst 'MO))
+ (make-recur-rule (interval 1) (wkst mon))
;; ((key val) ...)
(map (cut string-split <> #\=)