From 246cec13ad15d7a16f410657a38025c56c94f06e Mon Sep 17 00:00:00 2001
From: Jaidyn Ann <10477760+JadedCtrl@users.noreply.github.com>
Date: Tue, 6 Feb 2024 18:07:18 -0600
Subject: [PATCH] Change parsed-alist structure
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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.
---
 vcarded.scm | 72 ++++++++++++++++++++---------------------------------
 1 file changed, 27 insertions(+), 45 deletions(-)

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))))