Add basis for value-parsing
URIs and CSVs are parsed, somewhat.
This commit is contained in:
parent
8e73f121be
commit
e3d181fee8
80
vcarded.scm
80
vcarded.scm
|
@ -19,7 +19,56 @@
|
||||||
(chicken io)
|
(chicken io)
|
||||||
(chicken irregex)
|
(chicken irregex)
|
||||||
srfi-1
|
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.
|
;; Splits a string into a list of CRLF’d lines.
|
||||||
|
@ -67,16 +116,29 @@
|
||||||
(string-split key-or-value ";")))))
|
(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:
|
;; Parse a line of a vcard file into an alist-friendly format:
|
||||||
;; (KEY ("keyprop1=d" "keyprop2=b") "VALUE" ("valprop1=a" "valprop2=b"))
|
;; (KEY ("keyprop1=d" "keyprop2=b") "VALUE" ("valprop1=a" "valprop2=b"))
|
||||||
(define (parse-vcard-line line)
|
(define (parse-vcard-line line)
|
||||||
(let* [(key-value-strings (split-vcard-line line))
|
(let* [(prop-value-strings (split-vcard-line line))
|
||||||
(key-elements (split-vcard-element (car key-value-strings)))
|
(prop-elements (split-vcard-element (car prop-value-strings)))
|
||||||
(value-elements (split-vcard-element (cdr key-value-strings)))]
|
(value-elements (split-vcard-element (cdr prop-value-strings)))
|
||||||
(list (string->symbol (car key-elements))
|
(property (string->symbol (string-upcase (car prop-elements))))]
|
||||||
(car value-elements)
|
(append (parse-vcard-prop property (cdr prop-elements))
|
||||||
(cdr key-elements)
|
(parse-vcard-value property value-elements))))
|
||||||
(cdr value-elements))))
|
|
||||||
|
|
||||||
|
|
||||||
;; Reader thunk. Read/parse an entire vcard into a “vcard alist.”
|
;; Reader thunk. Read/parse an entire vcard into a “vcard alist.”
|
||||||
|
@ -99,5 +161,5 @@
|
||||||
(if (eq? (peek-char) #\space)
|
(if (eq? (peek-char) #\space)
|
||||||
(string-concatenate
|
(string-concatenate
|
||||||
(list line
|
(list line
|
||||||
(string-drop (read-element) 1)))
|
(string-drop (read-folded-line) 1)))
|
||||||
line)))
|
line)))
|
||||||
|
|
Ŝarĝante…
Reference in New Issue