diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-06-25 22:36:45 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-06-25 22:36:45 +0200 |
commit | cafb91d173a0a552cc94441a41ec5f8c1cb9bc36 (patch) | |
tree | 8de4160603cd68ed695a607419f3fffc156579ee /module/vcomponent | |
parent | Fix GEO output. (diff) | |
download | calp-cafb91d173a0a552cc94441a41ec5f8c1cb9bc36.tar.gz calp-cafb91d173a0a552cc94441a41ec5f8c1cb9bc36.tar.xz |
Add xcal output!
Diffstat (limited to 'module/vcomponent')
-rw-r--r-- | module/vcomponent/recurrence/internal.scm | 68 |
1 files changed, 43 insertions, 25 deletions
diff --git a/module/vcomponent/recurrence/internal.scm b/module/vcomponent/recurrence/internal.scm index b15ce90e..8c295bb9 100644 --- a/module/vcomponent/recurrence/internal.scm +++ b/module/vcomponent/recurrence/internal.scm @@ -82,36 +82,54 @@ (datetime) (srfi srfi-1)) -(define-public (recur-rule->rrule-string rrule) +(define (field->string field value) + (case field + [(wkst) + (string-upcase + (week-day-name value 2 + locale: (make-locale (list LC_TIME) "C")))] + [(byday) + (string-join (map byday->string value) ",")] + [(freq count interval) + (format #f "~a" value)] + [(until) + (if (date? value) + (date->string value "~Y~m~d") + (datetime->string value "~Y~m~dT~H~M~S~Z"))] + [else (format #f "~{~a~^,~}" value)])) + +(define (map-fields proc rrule) (define (get f) ((record-accessor <recur-rule> f) rrule)) + (filter-map + (lambda (field) + (if (not (get field)) + #f (proc field (get field)))) + (record-type-fields <recur-rule>))) + +(define-public (recur-rule->rrule-string rrule) (string-join - (filter-map - (lambda (field) - (if (not (get field)) - #f - (string-append - (string-upcase (symbol->string field)) - "=" - (case field - [(wkst) - (string-upcase - (week-day-name (get field) 2 - locale: (make-locale (list LC_TIME) "C")))] - [(byday) - (string-join (map byday->string (get field)) ",")] - [(freq count interval) - (format #f "~a" (get field))] - [(until) - (let ((o (get field))) - (if (date? o) - (date->string o "~Y~m~d") - (datetime->string o "~Y~m~dT~H~M~S~Z") - ))] - [else (format #f "~{~a~^,~}" (get field))])))) - (record-type-fields <recur-rule>)) + (map-fields + (lambda (field value) + (string-append + (string-upcase (symbol->string field)) + "=" (field->string field value))) + rrule) ";")) +(define (downcase-symbol symb) + (-> symb + symbol->string + string-downcase + string->symbol)) + +(define-public (recur-rule->rrule-sxml rrule) + (map-fields + (lambda (field value) + `(,(downcase-symbol field) + ,(field->string filed value))) + rrule)) + |