diff options
Diffstat (limited to '')
-rw-r--r-- | module/output/types.scm | 5 | ||||
-rw-r--r-- | module/vcomponent/duration.scm | 22 |
2 files changed, 23 insertions, 4 deletions
diff --git a/module/output/types.scm b/module/output/types.scm index ad6a39a2..8037a2d1 100644 --- a/module/output/types.scm +++ b/module/output/types.scm @@ -22,11 +22,8 @@ (datetime->string (hashq-ref param 'X-HNH-ORIGINAL value) "~Y~m~dT~H~M~S~Z")) -;; TODO (define (write-duration _ value) - (warning "DURATION writer not yet implemented") - (with-output-to-string - (lambda () (write value)))) + ((@ (vcomponent duration) format-duration)) value) (define (write-float _ value) (number->string value)) diff --git a/module/vcomponent/duration.scm b/module/vcomponent/duration.scm index 061cc50a..f8ef1d70 100644 --- a/module/vcomponent/duration.scm +++ b/module/vcomponent/duration.scm @@ -23,6 +23,28 @@ (error "Can't give week together with day or time")) (make-duration sign week day time)) + +(define-public (format-duration duration) + (with-output-to-string + (lambda () + (unless (eq? '+ (duration-sign duration)) + (display (duration-sign duration))) + (display "P") + (aif (duration-week duration) + (format #t "~aW" it) + (begin + (awhen (duration-day duration) (format #t "~aD" it)) + (awhen (duration-time duration) + (display "T") + ;; if any non-zero, + (unless (= 0 (hour it) (minute it) (second it)) + (format #t "~aH" (hour it)) + (unless (= 0 (minute it) (second it)) + (format #t "~aM" (minute it)) + (unless (= 0 (second it)) + (format #t "~aS" (second it))))))))))) + + (define-peg-pattern number all (+ (range #\0 #\9))) (define-peg-pattern time-pattern body |