diff --git a/vcarded.scm b/vcarded.scm index f6139e5..53fc978 100644 --- a/vcarded.scm +++ b/vcarded.scm @@ -23,68 +23,74 @@ (prefix uri-common uri:)) -(define (uri->string uri-or-str) - (if (uri:uri? uri-or-str) - (uri:uri->string uri-or-str) - uri-or-str)) +;; List of all properties with semicoloned-structured strings. +(define vcard-semicoloned-properties + '(ADR CLIENTPIDMAP GENDER N)) -(define (string->uri . strs) - (if (and (not (null? strs)) - (string? (car strs))) - (uri:uri-reference (string-join strs ";")) - strs)) +;; List of all properties with datetime values. +(define vcard-datetime-properties + '(ANNIVERSARY BDAY REV TZ)) -(define (csv-string->list str) - (string-split str ",")) +;; List of all properties with multiple comma-separated values. +(define vcard-csv-properties + '(CATEGORIES NICKNAME)) -(define (list->csv-string list) - (string-join list ",")) +;; List of all URL-type vcard properties. +(define vcard-url-properties + '(CALADRURI CALURI FBURL GEO IMPP + KEY LOGO MEMBER PHOTO RELATED + SOUND SOURCE TEL UID URL)) +;; A list of the parser/serializer functions for each vcard property. +;; ((TEL # #) +;; (ADR # #) +;; …) (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. -(define (unlines lines) - (string-join lines "\r\n")) - - -;; Splits a string into a list of CRLF’d lines. -(define (lines string) - (remove string-null? (string-split string "\r\n"))) + (append + (map (lambda (uri-prop) + (list uri-prop + (lambda strs (or (uri:uri-reference (string-join strs ";")) + (string-join sts ";"))) + (lambda (url) (uri:uri->string url)))) + vcard-url-properties) + (map (lambda (csv-prop) + (list csv-prop + (lambda (str) (string-split-unescaped str ",")) + (lambda (csv-list) (string-join csv-list ",")))) + vcard-csv-properties) + (map (lambda (semicolon-prop) + (list semicolon-prop + (lambda (str) (string-split-unescaped str ";")) + (lambda (sc-list) (string-join sc-list ";")))) + vcard-semicoloned-properties))) ;; Splits a line into a cons of the property-string and value-string. ;; … basically splits the string along the first unescaped colon (:). ;; "apple\:berry:mom:dad" → ("apple\:berry" . "mom:dad") (define (split-vcard-line line) - (let [(split (string-split-nonescaped line ":"))] + (let [(split (string-split-unescaped line ":"))] (cons (car split) (string-join (cdr split) ":")))) +;; Ignore whatever conditions the expression might return; just return the +;; default value in that case. +;; (ignore-error (+ 1 "seven") 3) → 3 +(define-syntax ignore-error + (syntax-rules () + ((ignore-error expr default) + (condition-case expr (var () default))))) + + ;; Splits a string along a delimiter; while not splitting along ;; backslash-escaped delimiters. With “;” as the delimiter: ;; "Bird;dad;apple\;mom" → ("Bird" "dad" "apple\;mom") -(define (string-split-nonescaped string delimiter) +(define (string-split-unescaped string delimiter) (let [(appendee "")] (remove not @@ -108,7 +114,9 @@ (define (parse-vcard-value prop elements) (let [(parser-and-unparser-funcs (alist-ref prop vcard-value-parsers))] (if parser-and-unparser-funcs - (list (apply (car parser-and-unparser-funcs) (list elements))) + (list (ignore-error (apply (car parser-and-unparser-funcs) + (list elements)) + elements)) (list elements)))) @@ -116,7 +124,7 @@ ;; (KEY ("keyprop1=d" "keyprop2=b") "VALUE" ("valprop1=a" "valprop2=b")) (define (parse-vcard-line line) (let* [(prop-value-strings (split-vcard-line line)) - (prop-elements (string-split-nonescaped (car prop-value-strings) ";")) + (prop-elements (string-split-unescaped (car prop-value-strings) ";")) (value-elements (cdr prop-value-strings)) (property (string->symbol (string-upcase (car prop-elements))))] (append (parse-vcard-prop property (cdr prop-elements))