Change parsed-alist structure
Changes the format from ((PROP TRAIT1 TRAIT2 …) (VALUE1 VALUE2 …)) to (PROP (TRAIT1 TRAIT2 …) VALUE1 VALUE2 …) Also makes the line-splitting functions more generic and efficient.
This commit is contained in:
parent
e3d181fee8
commit
246cec13ad
72
vcarded.scm
72
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))))
|
||||
|
|
Ŝarĝante…
Reference in New Issue