Add basis for value-parsing

URIs and CSVs are parsed, somewhat.

vcarded.scm

@@ -19,7 +19,56 @@
   (chicken io)
   (chicken irregex)
   srfi-1
-  srfi-130)
+  srfi-13
+  srfi-130
+  (prefix uri-common uri:))
+
+
+(define (uri->string uri-or-str)
+  (list
+   (list
+    (if (uri:uri? uri-or-str)
+        (uri:uri->string uri-or-str)
+        uri-or-str))))
+
+
+(define (string->uri . strs)
+  (list
+   (list
+    (if (and (not (null? strs))
+             (string? (car strs)))
+        (uri:uri-reference (string-join strs ";"))
+        strs))))
+
+
+(define (csv-string->list str)
+  (list
+   (list
+    (string-split str ","))))
+
+
+(define (list->csv-string list)
+  (list
+   (list
+    (string-join list ","))))
+
+
+(define vcard-value-parsers
+  (list
+   (list 'PHOTO string->uri uri->string)
+   (list 'LOGO string->uri uri->string)
+   (list 'MEMBER string->uri uri->string)
+   (list 'SOUND string->uri uri->string)
+   (list 'UID string->uri uri->string)
+   (list 'URL string->uri uri->string)
+   (list 'KEY string->uri uri->string)
+   (list 'FBURL string->uri uri->string)
+   (list 'CALADRURI string->uri uri->string)
+   (list 'CALURI string->uri uri->string)
+   (list 'RELATED string->uri uri->string)
+   (list 'CATEGORIES csv-string->list list->csv-string)
+   (list 'IMPP string->uri uri->string)
+   (list 'GEO string->uri uri->string)))
 
 
 ;; Splits a string into a list of CRLF’d lines.
@@ -67,16 +116,29 @@
           (string-split key-or-value ";")))))
 
 
+(define (parse-vcard-prop property elements)
+  (list
+   (append (list property)
+           elements)))
+
+
+(define (parse-vcard-value prop elements)
+  (print "CHECKING" prop)
+  (let [(parser-and-unparser-funcs (alist-ref prop vcard-value-parsers))]
+    (if parser-and-unparser-funcs
+        (apply (car parser-and-unparser-funcs) elements)
+        (list elements))))
+
+
 ;; Parse a line of a vcard file into an alist-friendly format:
 ;;    (KEY ("keyprop1=d" "keyprop2=b") "VALUE" ("valprop1=a" "valprop2=b"))
 (define (parse-vcard-line line)
-  (let* [(key-value-strings (split-vcard-line line))
-         (key-elements (split-vcard-element (car key-value-strings)))
-         (value-elements (split-vcard-element (cdr key-value-strings)))]
-    (list (string->symbol (car key-elements))
-          (car value-elements)
-          (cdr key-elements)
-          (cdr value-elements))))
+  (let* [(prop-value-strings (split-vcard-line line))
+         (prop-elements (split-vcard-element (car prop-value-strings)))
+         (value-elements (split-vcard-element (cdr prop-value-strings)))
+         (property (string->symbol (string-upcase (car prop-elements))))]
+    (append (parse-vcard-prop property (cdr prop-elements))
+            (parse-vcard-value property value-elements))))
 
 
 ;; Reader thunk. Read/parse an entire vcard into a “vcard alist.”
@@ -99,5 +161,5 @@
     (if (eq? (peek-char) #\space)
         (string-concatenate
          (list line
-               (string-drop (read-element) 1)))
+               (string-drop (read-folded-line) 1)))
         line)))