Improve output format for vcomponents.

A stantdalone vline is now it's own constructor, and includes its
parameters.

Complete vcomponents instead serialize vlines to the vcomponent create
syntax, which sometimes hides the existance of a vline completely.

2 files changed, 54 insertions, 17 deletions

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 39b2c810..d21f785d 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -8,6 +8,7 @@
   :use-module (hnh util lens)
   :use-module (hnh util table)
   :use-module (hnh util uuid)
+  :use-module ((hnh util exceptions) :select (unreachable))
   :export (vline
            vline?
            vline-value
@@ -58,12 +59,17 @@
 ;;; emit something which allows the serialized vcomponent to be
 ;;; fed back into the parser to get the object back.
 (define (print-vline v p)
-  (format p "#<<vline> key: ~s value: ~s parameters: ~s>"
-          (key v)
-          (vline-value v)
-          #f
-          ;; (hash-map->list list (get-vline-parameters v))
-          ))
+  ((@ (ice-9 pretty-print) pretty-print)
+   `(vline key: ,(key v)
+           vline-value: ,(vline-value v)
+           ,@(let ((params (table->list (vline-parameters v))))
+               (if (null? params)
+                   '()
+                   `(vline-parameters:
+                     ,(concatenate (for (key . value) in params
+                                        `(,(symbol->keyword key)
+                                          ,value)))))))
+   p))
 
 (define-type (vline printer: print-vline)
   ;; TODO why does vline contain its own key?
@@ -72,6 +78,17 @@
   (vline-parameters default: (table) type: table?)
   (vline-source default: "" type: string?))
 
+(define (serialize-vline line)
+  (let ((parameters
+         (table->list (vline-parameters line))))
+    (if (null? parameters)
+        (vline-value line)
+        `(with-parameters
+          ,@(concatenate (for (key . value) in parameters
+                              `(,(symbol->keyword key)
+                                ,value)))
+          ,(vline-value line)))))
+
 (define (serialize-vcomponent c)
   (let ((children (table->list (vcomponent-children c))))
     `(vcomponent ',(type c)
@@ -80,7 +97,14 @@
                          (list (-> key symbol->string
                                    string-downcase
                                    string->keyword)
-                               value)))
+                               (cond ((list? value)
+                                      `(as-list (list
+                                                 ,@(map serialize-vline value))))
+                                     ((vline? value) (serialize-vline value))
+                                     (else (unreachable
+                                            "serialize-vcomponent"
+                                            "Expected vline or list of vline, got ~s"
+                                            value))))))
                  ,@(unless (null? children)
                      `((list ,@(map (lambda (child) (serialize-vcomponent child))
                                     (map cdr children))))))))
diff --git a/tests/unit/vcomponent/vcomponent.scm b/tests/unit/vcomponent/vcomponent.scm
index 2f692d19..87fddb5f 100644
--- a/tests/unit/vcomponent/vcomponent.scm
+++ b/tests/unit/vcomponent/vcomponent.scm
@@ -89,16 +89,26 @@
              (K2 . "V2"))))))
 
 (test-equal "VLine string representation"
-  "#<<vline> key: KEY value: \"Value\" parameters: #f>"
+  "(vline #:key KEY #:vline-value \"Value\")
+"
+  (with-output-to-string
+    (lambda ()
+      (write (vline key: 'KEY vline-value: "Value") ))))
+
+(test-equal "VLine with parameters representation"
+  "(vline #:key
+       KEY
+       #:vline-value
+       \"Value\"
+       #:vline-parameters
+       (#:a \"1\"))
+"
  (with-output-to-string
    (lambda ()
-     (write (vline key: 'KEY vline-value: "Value") ))))
-
-;; (test-equal "VLine with parameters representation"
-;;   "#<<vline> key: KEY value: \"Value\" parameters: #f>"
-;;  (with-output-to-string
-;;    (lambda ()
-;;      (write (vline key: 'KEY vline-value: "Value") ))))
+     (write (vline key: 'KEY
+                   vline-value: "Value"
+                   vline-parameters:
+                   (alist->table '((a . "1"))))))))
 
 (test-equal "VComponent string representation"
   "(vcomponent
@@ -106,9 +116,12 @@
   (list (vcomponent
           'VEVENT
           #:dtstart
-          #<<vline> key: DTSTART value: #2023-03-01T10:00:00 parameters: #f>
+          (with-parameters
+            #:TZID
+            \"Europe/Stockholm\"
+            #2023-03-01T10:00:00)
           #:uid
-          #<<vline> key: UID value: \"049d9004-cb1e-4c8d-bb54-042689d9808b\" parameters: #f>)))
+          \"049d9004-cb1e-4c8d-bb54-042689d9808b\")))
 "
 
   (with-output-to-string