From 051edf0de9f1dd39269b6ecdf1c5e534023dd8e4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 17 Aug 2020 18:09:46 +0200 Subject: Got type files out of output. --- module/output/sxml-types.scm | 55 ----------------------- module/output/types.scm | 95 --------------------------------------- module/vcomponent/ical/output.scm | 2 +- module/vcomponent/ical/types.scm | 95 +++++++++++++++++++++++++++++++++++++++ module/vcomponent/xcal/output.scm | 2 +- module/vcomponent/xcal/types.scm | 55 +++++++++++++++++++++++ 6 files changed, 152 insertions(+), 152 deletions(-) delete mode 100644 module/output/sxml-types.scm delete mode 100644 module/output/types.scm create mode 100644 module/vcomponent/ical/types.scm create mode 100644 module/vcomponent/xcal/types.scm diff --git a/module/output/sxml-types.scm b/module/output/sxml-types.scm deleted file mode 100644 index 2d5b3742..00000000 --- a/module/output/sxml-types.scm +++ /dev/null @@ -1,55 +0,0 @@ -(define-module (output sxml-types) - :use-module (util) - :use-module (output types) - :use-module (datetime) - :use-module (output common) - ) - -(define (write-boolean _ v) - `(boolean ,(if v "true" "false"))) - -(define (write-date _ v) - `(date ,(date->string v "~Y-~m-~d"))) - -(define (write-datetime p v) - `(date-time - ,(datetime->string - (hashq-ref p '-X-HNH-ORIGINAL v) - ;; 'Z' should be included for UTC, - ;; other timezones MUST be specified - ;; in the TZID parameter. - "~Y-~m-~dT~H:~M:~S~Z"))) - -(define (write-time _ v) - `(time ,(time->string v "~H:~M:S"))) - -(define (write-recur _ v) - `(recur ,@((@@ (vcomponent recurrence internal) recur-rule->rrule-sxml) v))) - -;; sepparate since this text shouldn't be escaped -(define (write-text _ v) - ;; TODO out type should be xsd:string. - ;; Look into what that means, and escape - ;; from there - `(text ,v)) - - - -(define sxml-writers (make-hash-table)) -(for simple-type in '(BINARY DURATION CAL-ADDRESS DURATION FLOAT INTEGER - #| TODO PERIOD |# URI UTC-OFFSET) - (hashq-set! sxml-writers simple-type - (lambda (p v) - `(,(downcase-symbol simple-type) - ,(((@ (output types) get-writer) simple-type) p v))))) - -(hashq-set! sxml-writers 'BOOLEAN write-boolean) -(hashq-set! sxml-writers 'DATE write-date) -(hashq-set! sxml-writers 'DATE-TIME write-datetime) -(hashq-set! sxml-writers 'TIME write-time) -(hashq-set! sxml-writers 'RECUR write-recur) -(hashq-set! sxml-writers 'TEXT write-text) - -(define-public (get-writer type) - (or (hashq-ref sxml-writers type #f) - (error "No writer for type" type))) diff --git a/module/output/types.scm b/module/output/types.scm deleted file mode 100644 index d4305b7a..00000000 --- a/module/output/types.scm +++ /dev/null @@ -1,95 +0,0 @@ -;; see (vcomponent parse types) -(define-module (output types) - :use-module (util) - :use-module (util exceptions) - :use-module (util base64) - :use-module (datetime)) - - -(define (write-binary _ value) - (bytevector->base64-string value)) - -(define (write-boolean _ value) - (if value "TRUE" "FALSE")) - -(define (write-date _ value) - (date->string value "~Y~m~d")) - -(define (write-datetime param value) - ;; NOTE We really should output TZID from param here, but - ;; we first need to change so these writers can output - ;; parameters. - (datetime->string (hashq-ref param '-X-HNH-ORIGINAL value) - "~Y~m~dT~H~M~S~Z")) - -(define (write-duration _ value) - ((@ (vcomponent duration) format-duration) value)) - -(define (write-float _ value) - (number->string value)) - -(define (write-integer _ value) - (number->string value)) - -;; TODO -(define (write-period _ value) - (warning "PERIOD writer not yet implemented") - (with-output-to-string - (lambda () (write value)))) - -(define (write-recur _ value) - ((@ (vcomponent recurrence internal) - recur-rule->rrule-string) value)) - -(define-public (escape-chars str) - (define (escape char) - (string #\\ char)) - (string-concatenate - (map (lambda (c) - (case c - ((#\newline) "\\n") - ((#\, #\; #\\) => escape) - (else => string))) - (string->list str)))) - -(define (write-text _ value) - (escape-chars value)) - -(define (write-time _ value) - (time->string value "~H~M~S")) - -(define (write-uri _ value) - value) - - -(use-modules (datetime timespec)) - -(define (write-utc-offset _ value) - (with-output-to-string - (lambda () - (display (if (time-zero? (timespec-time value)) - '+ (timespec-sign value))) - (display (time->string (timespec-time value) "~H~M")) - (when (not (zero? (second (timespec-time value)))) - (display (time->string (timespec-time value) "~S")))))) - - -(define type-writers (make-hash-table)) -(hashq-set! type-writers 'BINARY write-binary) -(hashq-set! type-writers 'BOOLEAN write-boolean) -(hashq-set! type-writers 'CAL-ADDRESS write-uri) -(hashq-set! type-writers 'DATE write-date) -(hashq-set! type-writers 'DATE-TIME write-datetime) -(hashq-set! type-writers 'DURATION write-duration) -(hashq-set! type-writers 'FLOAT write-float) -(hashq-set! type-writers 'INTEGER write-integer) -(hashq-set! type-writers 'PERIOD write-period) -(hashq-set! type-writers 'RECUR write-recur) -(hashq-set! type-writers 'TEXT write-text) -(hashq-set! type-writers 'TIME write-time) -(hashq-set! type-writers 'URI write-uri) -(hashq-set! type-writers 'UTC-OFFSET write-utc-offset) - -(define-public (get-writer type) - (or (hashq-ref type-writers type #f) - (error "No writer for type" type))) diff --git a/module/vcomponent/ical/output.scm b/module/vcomponent/ical/output.scm index 530203e6..eead035b 100644 --- a/module/vcomponent/ical/output.scm +++ b/module/vcomponent/ical/output.scm @@ -13,7 +13,7 @@ :use-module (glob) :use-module (vcomponent recurrence) :use-module (vcomponent geo) - :use-module (output types) + :use-module (vcomponent ical types) :use-module (output common) :autoload (vcomponent instance) (global-event-object) :use-module ((datetime instance) :select (zoneinfo)) diff --git a/module/vcomponent/ical/types.scm b/module/vcomponent/ical/types.scm new file mode 100644 index 00000000..f2787693 --- /dev/null +++ b/module/vcomponent/ical/types.scm @@ -0,0 +1,95 @@ +;; see (vcomponent parse types) +(define-module (vcomponent ical types) + :use-module (util) + :use-module (util exceptions) + :use-module (util base64) + :use-module (datetime)) + + +(define (write-binary _ value) + (bytevector->base64-string value)) + +(define (write-boolean _ value) + (if value "TRUE" "FALSE")) + +(define (write-date _ value) + (date->string value "~Y~m~d")) + +(define (write-datetime param value) + ;; NOTE We really should output TZID from param here, but + ;; we first need to change so these writers can output + ;; parameters. + (datetime->string (hashq-ref param '-X-HNH-ORIGINAL value) + "~Y~m~dT~H~M~S~Z")) + +(define (write-duration _ value) + ((@ (vcomponent duration) format-duration) value)) + +(define (write-float _ value) + (number->string value)) + +(define (write-integer _ value) + (number->string value)) + +;; TODO +(define (write-period _ value) + (warning "PERIOD writer not yet implemented") + (with-output-to-string + (lambda () (write value)))) + +(define (write-recur _ value) + ((@ (vcomponent recurrence internal) + recur-rule->rrule-string) value)) + +(define-public (escape-chars str) + (define (escape char) + (string #\\ char)) + (string-concatenate + (map (lambda (c) + (case c + ((#\newline) "\\n") + ((#\, #\; #\\) => escape) + (else => string))) + (string->list str)))) + +(define (write-text _ value) + (escape-chars value)) + +(define (write-time _ value) + (time->string value "~H~M~S")) + +(define (write-uri _ value) + value) + + +(use-modules (datetime timespec)) + +(define (write-utc-offset _ value) + (with-output-to-string + (lambda () + (display (if (time-zero? (timespec-time value)) + '+ (timespec-sign value))) + (display (time->string (timespec-time value) "~H~M")) + (when (not (zero? (second (timespec-time value)))) + (display (time->string (timespec-time value) "~S")))))) + + +(define type-writers (make-hash-table)) +(hashq-set! type-writers 'BINARY write-binary) +(hashq-set! type-writers 'BOOLEAN write-boolean) +(hashq-set! type-writers 'CAL-ADDRESS write-uri) +(hashq-set! type-writers 'DATE write-date) +(hashq-set! type-writers 'DATE-TIME write-datetime) +(hashq-set! type-writers 'DURATION write-duration) +(hashq-set! type-writers 'FLOAT write-float) +(hashq-set! type-writers 'INTEGER write-integer) +(hashq-set! type-writers 'PERIOD write-period) +(hashq-set! type-writers 'RECUR write-recur) +(hashq-set! type-writers 'TEXT write-text) +(hashq-set! type-writers 'TIME write-time) +(hashq-set! type-writers 'URI write-uri) +(hashq-set! type-writers 'UTC-OFFSET write-utc-offset) + +(define-public (get-writer type) + (or (hashq-ref type-writers type #f) + (error "No writer for type" type))) diff --git a/module/vcomponent/xcal/output.scm b/module/vcomponent/xcal/output.scm index a689b2cf..4aa68b00 100644 --- a/module/vcomponent/xcal/output.scm +++ b/module/vcomponent/xcal/output.scm @@ -3,7 +3,7 @@ :use-module (util exceptions) :use-module (vcomponent) :use-module (vcomponent geo) - :use-module (output sxml-types) + :use-module (vcomponent xcal types) :use-module (ice-9 match) :use-module (output common) :use-module (datetime) diff --git a/module/vcomponent/xcal/types.scm b/module/vcomponent/xcal/types.scm new file mode 100644 index 00000000..e56ace55 --- /dev/null +++ b/module/vcomponent/xcal/types.scm @@ -0,0 +1,55 @@ +(define-module (vcomponent xcal types) + :use-module (util) + :use-module (vcomponent ical types) + :use-module (datetime) + :use-module (output common) + ) + +(define (write-boolean _ v) + `(boolean ,(if v "true" "false"))) + +(define (write-date _ v) + `(date ,(date->string v "~Y-~m-~d"))) + +(define (write-datetime p v) + `(date-time + ,(datetime->string + (hashq-ref p '-X-HNH-ORIGINAL v) + ;; 'Z' should be included for UTC, + ;; other timezones MUST be specified + ;; in the TZID parameter. + "~Y-~m-~dT~H:~M:~S~Z"))) + +(define (write-time _ v) + `(time ,(time->string v "~H:~M:S"))) + +(define (write-recur _ v) + `(recur ,@((@@ (vcomponent recurrence internal) recur-rule->rrule-sxml) v))) + +;; sepparate since this text shouldn't be escaped +(define (write-text _ v) + ;; TODO out type should be xsd:string. + ;; Look into what that means, and escape + ;; from there + `(text ,v)) + + + +(define sxml-writers (make-hash-table)) +(for simple-type in '(BINARY DURATION CAL-ADDRESS DURATION FLOAT INTEGER + #| TODO PERIOD |# URI UTC-OFFSET) + (hashq-set! sxml-writers simple-type + (lambda (p v) + `(,(downcase-symbol simple-type) + ,(((@ (vcomponent ical types) get-writer) simple-type) p v))))) + +(hashq-set! sxml-writers 'BOOLEAN write-boolean) +(hashq-set! sxml-writers 'DATE write-date) +(hashq-set! sxml-writers 'DATE-TIME write-datetime) +(hashq-set! sxml-writers 'TIME write-time) +(hashq-set! sxml-writers 'RECUR write-recur) +(hashq-set! sxml-writers 'TEXT write-text) + +(define-public (get-writer type) + (or (hashq-ref sxml-writers type #f) + (error "No writer for type" type))) -- cgit v1.2.3