diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2021-12-21 16:17:28 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2021-12-22 22:58:30 +0100 |
commit | d00fea566004e67161ee45246b239fff5d416b0e (patch) | |
tree | 5641c0c0d0e78b046b6045ed2440512f12259560 /module/vcomponent/formats/common | |
parent | Complete rewrite of use2dot (diff) | |
download | calp-d00fea566004e67161ee45246b239fff5d416b0e.tar.gz calp-d00fea566004e67161ee45246b239fff5d416b0e.tar.xz |
Cleanup modules.
Primarly this moves all vcompenent input and output code to clearly
labeled modules, instead of being spread out. At the same time it also
removes a handfull of unused procedures.
Diffstat (limited to 'module/vcomponent/formats/common')
-rw-r--r-- | module/vcomponent/formats/common/types.scm | 139 |
1 files changed, 139 insertions, 0 deletions
diff --git a/module/vcomponent/formats/common/types.scm b/module/vcomponent/formats/common/types.scm new file mode 100644 index 00000000..87425c01 --- /dev/null +++ b/module/vcomponent/formats/common/types.scm @@ -0,0 +1,139 @@ +(define-module (vcomponent formats common types) + :use-module (calp util) + :use-module (calp util exceptions) + :use-module (base64) + :use-module (datetime) + :use-module (srfi srfi-9 gnu) + :use-module (datetime timespec) + ) + +;; BINARY +(define (parse-binary props value) + ;; p 30 + (unless (string=? "BASE64" (hashq-ref props 'ENCODING)) + (warning "Binary field not marked ENCODING=BASE64")) + + ;; For icalendar no extra whitespace is allowed in a + ;; binary field (except for line wrapping). This differs + ;; from xcal. + (base64-string->bytevector value)) + +;; BOOLEAN +(define (parse-boolean props value) + (cond + [(string=? "TRUE" value) #t] + [(string=? "FALSE" value) #f] + [else (warning "~a invalid boolean" value)])) + +;; CAL-ADDRESS ⇒ uri + +;; DATE +(define (parse-date props value) + (parse-ics-date value)) + +;; DATE-TIME +(define (parse-datetime props value) + (define parsed + (parse-ics-datetime + value (hashq-ref props 'TZID #f))) + (hashq-set! props '-X-HNH-ORIGINAL parsed) + (get-datetime parsed)) + +;; DURATION +(define (parse-duration props value) + ((@ (vcomponent duration) parse-duration) + value)) + +;; FLOAT +;; Note that this is overly permissive, and flawed. +;; Numbers such as @expr{1/2} is accepted as exact +;; rationals. Some floats are rounded. +(define (parse-float props value) + (string->number value)) + + +;; INTEGER +(define (parse-integer props value) + (let ((n (string->number value))) + (unless (integer? n) + (warning "Non integer as integer")) + n)) + +;; PERIOD +(define (parse-period props value) + (let* (((left right) (string-split value #\/))) + ;; TODO timezones? VALUE=DATE? + (cons (parse-ics-datetime left) + ((if (memv (string-ref right 0) + '(#\P #\+ #\-)) + (@ (vcomponent duration) parse-duration) + parse-ics-datetime) + right)))) + +;; RECUR +(define (parse-recur props value) + ((@ (vcomponent recurrence parse) parse-recurrence-rule) value)) + +;; TEXT +;; TODO quoted strings +(define (parse-text props value) + (let loop ((rem (string->list value)) + (str '()) + (done '())) + (if (null? rem) + (cons (reverse-list->string str) done) + (case (car rem) + [(#\\) + (case (cadr rem) + [(#\n #\N) (loop (cddr rem) (cons #\newline str) done)] + [(#\; #\, #\\) => (lambda (c) (loop (cddr rem) (cons c str) done))] + [else => (lambda (c) (warning "Non-escapable character: ~a" c) + (loop (cddr rem) str done))])] + [(#\,) + (loop (cdr rem) '() (cons (reverse-list->string str) done))] + [else + (loop (cdr rem) (cons (car rem) str) done)])))) + + +;; TIME +(define (parse-time props value) + ;; TODO time can have timezones... + (parse-ics-time value)) + +;; URI +(define (parse-uri props value) + value) + +;; UTC-OFFSET +(define (parse-utc-offset props value) + (make-timespec + (time + hour: (string->number (substring value 1 3)) + minute: (string->number (substring value 3 5)) + second: (if (= 7 (string-length value)) + (string->number (substring value 5 7)) + 0)) + ;; sign + (string->symbol (substring value 0 1)) + #\z)) + + +(define type-parsers (make-hash-table)) +(hashq-set! type-parsers 'BINARY parse-binary) +(hashq-set! type-parsers 'BOOLEAN parse-boolean) +(hashq-set! type-parsers 'CAL-ADDRESS parse-uri) +(hashq-set! type-parsers 'DATE parse-date) +(hashq-set! type-parsers 'DATE-TIME parse-datetime) +(hashq-set! type-parsers 'DURATION parse-duration) +(hashq-set! type-parsers 'FLOAT parse-float) +(hashq-set! type-parsers 'INTEGER parse-integer) +(hashq-set! type-parsers 'PERIOD parse-period) +(hashq-set! type-parsers 'RECUR parse-recur) +(hashq-set! type-parsers 'TEXT parse-text) +(hashq-set! type-parsers 'TIME parse-time) +(hashq-set! type-parsers 'URI parse-uri) +(hashq-set! type-parsers 'UTC-OFFSET parse-utc-offset) + +(define-public (get-parser type) + (or (hashq-ref type-parsers type #f) + (error "No parser for type" type))) |