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:
Jaidyn Ann 2024-02-06 18:07:18 -06:00
parent e3d181fee8
commit 246cec13ad

View File

@ -17,7 +17,6 @@
(import (import
scheme scheme
(chicken io) (chicken io)
(chicken irregex)
srfi-1 srfi-1
srfi-13 srfi-13
srfi-130 srfi-130
@ -25,32 +24,24 @@
(define (uri->string uri-or-str) (define (uri->string uri-or-str)
(list
(list
(if (uri:uri? uri-or-str) (if (uri:uri? uri-or-str)
(uri:uri->string uri-or-str) (uri:uri->string uri-or-str)
uri-or-str)))) uri-or-str))
(define (string->uri . strs) (define (string->uri . strs)
(list
(list
(if (and (not (null? strs)) (if (and (not (null? strs))
(string? (car strs))) (string? (car strs)))
(uri:uri-reference (string-join strs ";")) (uri:uri-reference (string-join strs ";"))
strs)))) strs))
(define (csv-string->list str) (define (csv-string->list str)
(list (string-split str ","))
(list
(string-split str ","))))
(define (list->csv-string list) (define (list->csv-string list)
(list (string-join list ","))
(list
(string-join list ","))))
(define vcard-value-parsers (define vcard-value-parsers
@ -85,48 +76,39 @@
;; … basically splits the string along the first unescaped colon (:). ;; … basically splits the string along the first unescaped colon (:).
;; "apple\:berry:mom:dad" → ("apple\:berry" . "mom:dad") ;; "apple\:berry:mom:dad" → ("apple\:berry" . "mom:dad")
(define (split-vcard-line line) (define (split-vcard-line line)
(let [(split (irregex-extract "(\\\\:|[^:])*" line))] (let [(split (string-split-nonescaped line ":"))]
(if (>= (length split) 2) (cons (car split)
(cons (string-join (cdr split) ":"))))
(car split)
;; Drop the values 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)))
;; Splits a key or value-element into its (potentially multiple) parameters. ;; Splits a string along a delimiter; while not splitting along
;; … basically just splits along non-escaped semi-colons. ;; backslash-escaped delimiters. With “;” as the delimiter:
;; "Bird;dad;apple\;mom" → ("Bird" "dad" "apple\;mom") ;; "Bird;dad;apple\;mom" → ("Bird" "dad" "apple\;mom")
(define (split-vcard-element key-or-value) (define (string-split-nonescaped string delimiter)
(let [(appendee "")] (let [(appendee "")]
(remove (remove
not not
(map (lambda (str) (map (lambda (substr)
(let [(str (string-concatenate `(,appendee ,str)))] (let [(substr (string-concatenate (list appendee substr)))]
(if (and (not (string-null? str)) (if (and (not (string-null? substr))
(eq? (last (string->list str)) (eq? (last (string->list substr))
#\\)) #\\))
(and (set! appendee (string-concatenate `(,str ";"))) (and (set! appendee
(string-concatenate (list substr delimiter)))
#f) #f)
(and (set! appendee "") str)))) (and (set! appendee "") substr))))
(string-split key-or-value ";"))))) (string-split string delimiter)))))
(define (parse-vcard-prop property elements) (define (parse-vcard-prop property elements)
(list
(append (list property) (append (list property)
elements))) (list elements)))
(define (parse-vcard-value prop elements) (define (parse-vcard-value prop elements)
(print "CHECKING" prop)
(let [(parser-and-unparser-funcs (alist-ref prop vcard-value-parsers))] (let [(parser-and-unparser-funcs (alist-ref prop vcard-value-parsers))]
(if parser-and-unparser-funcs (if parser-and-unparser-funcs
(apply (car parser-and-unparser-funcs) elements) (list (apply (car parser-and-unparser-funcs) (list elements)))
(list elements)))) (list elements))))
@ -134,8 +116,8 @@
;; (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* [(prop-value-strings (split-vcard-line line)) (let* [(prop-value-strings (split-vcard-line line))
(prop-elements (split-vcard-element (car prop-value-strings))) (prop-elements (string-split-nonescaped (car prop-value-strings) ";"))
(value-elements (split-vcard-element (cdr prop-value-strings))) (value-elements (cdr prop-value-strings))
(property (string->symbol (string-upcase (car prop-elements))))] (property (string->symbol (string-upcase (car prop-elements))))]
(append (parse-vcard-prop property (cdr prop-elements)) (append (parse-vcard-prop property (cdr prop-elements))
(parse-vcard-value property value-elements)))) (parse-vcard-value property value-elements))))