From d00fea566004e67161ee45246b239fff5d416b0e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 21 Dec 2021 16:17:28 +0100 Subject: 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. --- module/vcomponent/parse/types.scm | 140 -------------------------------------- 1 file changed, 140 deletions(-) delete mode 100644 module/vcomponent/parse/types.scm (limited to 'module/vcomponent/parse') diff --git a/module/vcomponent/parse/types.scm b/module/vcomponent/parse/types.scm deleted file mode 100644 index ba4b2b47..00000000 --- a/module/vcomponent/parse/types.scm +++ /dev/null @@ -1,140 +0,0 @@ -(define-module (vcomponent parse types) - :use-module (calp util) - :use-module (calp util exceptions) - :use-module (base64) - :use-module (datetime) - :use-module (srfi srfi-9 gnu) - ) - -;; 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) - -(use-modules (datetime timespec)) - -;; 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))) -- cgit v1.2.3