Add duration output.

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