diff --git a/vcarded.scm b/vcarded.scm index 03a862b..64216e1 100644 --- a/vcarded.scm +++ b/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)))