diff --git a/vcarded.scm b/vcarded.scm index 64216e1..f6139e5 100644 --- a/vcarded.scm +++ b/vcarded.scm @@ -17,7 +17,6 @@ (import scheme (chicken io) - (chicken irregex) srfi-1 srfi-13 srfi-130 @@ -25,32 +24,24 @@ (define (uri->string uri-or-str) - (list - (list - (if (uri:uri? uri-or-str) - (uri:uri->string uri-or-str) - uri-or-str)))) + (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)))) + (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 ",")))) + (string-split str ",")) (define (list->csv-string list) - (list - (list - (string-join list ",")))) + (string-join list ",")) (define vcard-value-parsers @@ -85,48 +76,39 @@ ;; … basically splits the string along the first unescaped colon (:). ;; "apple\:berry:mom:dad" → ("apple\:berry" . "mom:dad") (define (split-vcard-line line) - (let [(split (irregex-extract "(\\\\:|[^:])*" line))] - (if (>= (length split) 2) - (cons - (car split) - ;; Drop the value’s first char (redundant “:”) and concatenate the - ;; rest of the string-parts which were erroneously split along “:”. - (string-drop (reduce-right - (lambda (a b) (string-concatenate (list a ":" b))) - "" (cdr split)) - 1)) - #f))) + (let [(split (string-split-nonescaped line ":"))] + (cons (car split) + (string-join (cdr split) ":")))) -;; Splits a key or value-element into its (potentially multiple) parameters. -;; … basically just splits along non-escaped semi-colons. +;; 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 (split-vcard-element key-or-value) +(define (string-split-nonescaped string delimiter) (let [(appendee "")] (remove not - (map (lambda (str) - (let [(str (string-concatenate `(,appendee ,str)))] - (if (and (not (string-null? str)) - (eq? (last (string->list str)) + (map (lambda (substr) + (let [(substr (string-concatenate (list appendee substr)))] + (if (and (not (string-null? substr)) + (eq? (last (string->list substr)) #\\)) - (and (set! appendee (string-concatenate `(,str ";"))) + (and (set! appendee + (string-concatenate (list substr delimiter))) #f) - (and (set! appendee "") str)))) - (string-split key-or-value ";"))))) + (and (set! appendee "") substr)))) + (string-split string delimiter))))) (define (parse-vcard-prop property elements) - (list (append (list property) - elements))) + (list 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 (apply (car parser-and-unparser-funcs) (list elements))) (list elements)))) @@ -134,8 +116,8 @@ ;; (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 (split-vcard-element (car prop-value-strings))) - (value-elements (split-vcard-element (cdr prop-value-strings))) + (prop-elements (string-split-nonescaped (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)) (parse-vcard-value property value-elements))))