From 79f8c34c6cbd6ae136255247b925a1601d1b3baf Mon Sep 17 00:00:00 2001
From: Jaidyn Ann <10477760+JadedCtrl@users.noreply.github.com>
Date: Tue, 6 Feb 2024 22:04:49 -0600
Subject: [PATCH] Clean up and refactor value-parsing

---
 vcarded.scm | 92 +++++++++++++++++++++++++++++------------------------
 1 file changed, 50 insertions(+), 42 deletions(-)

diff --git a/vcarded.scm b/vcarded.scm
index f6139e5..53fc978 100644
--- a/vcarded.scm
+++ b/vcarded.scm
@@ -23,68 +23,74 @@
   (prefix uri-common uri:))
 
 
-(define (uri->string uri-or-str)
-  (if (uri:uri? uri-or-str)
-      (uri:uri->string uri-or-str)
-      uri-or-str))
+;; List of all properties with semicoloned-structured strings.
+(define vcard-semicoloned-properties
+  '(ADR CLIENTPIDMAP GENDER N))
 
 
-(define (string->uri . strs)
-  (if (and (not (null? strs))
-           (string? (car strs)))
-      (uri:uri-reference (string-join strs ";"))
-      strs))
+;; List of all properties with datetime values.
+(define vcard-datetime-properties
+  '(ANNIVERSARY BDAY REV TZ))
 
 
-(define (csv-string->list str)
-  (string-split str ","))
+;; List of all properties with multiple comma-separated values.
+(define vcard-csv-properties
+  '(CATEGORIES NICKNAME))
 
 
-(define (list->csv-string list)
-  (string-join list ","))
+;; List of all URL-type vcard properties.
+(define vcard-url-properties
+  '(CALADRURI CALURI FBURL GEO IMPP
+    KEY LOGO MEMBER PHOTO RELATED
+    SOUND SOURCE TEL UID URL))
 
 
+;; A list of the parser/serializer functions for each vcard property.
+;;    ((TEL #<procedure> #<procedure>)
+;;     (ADR #<procedure> #<procedure>)
+;;     …)
 (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.
-(define (unlines lines)
-  (string-join lines "\r\n"))
-
-
-;; Splits a string into a list of CRLF’d lines.
-(define (lines string)
-  (remove string-null? (string-split string "\r\n")))
+   (append
+    (map (lambda (uri-prop)
+           (list uri-prop
+                 (lambda strs (or (uri:uri-reference (string-join strs ";"))
+                                  (string-join sts ";")))
+                 (lambda (url) (uri:uri->string url))))
+         vcard-url-properties)
+    (map (lambda (csv-prop)
+           (list csv-prop
+                 (lambda (str) (string-split-unescaped str ","))
+                 (lambda (csv-list) (string-join csv-list ","))))
+         vcard-csv-properties)
+    (map (lambda (semicolon-prop)
+           (list semicolon-prop
+                 (lambda (str) (string-split-unescaped str ";"))
+                 (lambda (sc-list) (string-join sc-list ";"))))
+         vcard-semicoloned-properties)))
 
 
 ;; Splits a line into a cons of the property-string and value-string.
 ;; … basically splits the string along the first unescaped colon (:).
 ;;    "apple\:berry:mom:dad" → ("apple\:berry" . "mom:dad")
 (define (split-vcard-line line)
-  (let [(split (string-split-nonescaped line ":"))]
+  (let [(split (string-split-unescaped line ":"))]
     (cons (car split)
           (string-join (cdr split) ":"))))
 
 
+;; Ignore whatever conditions the expression might return; just return the
+;; default value in that case.
+;;    (ignore-error (+ 1 "seven") 3) → 3
+(define-syntax ignore-error
+  (syntax-rules ()
+    ((ignore-error expr default)
+     (condition-case expr (var () default)))))
+
+
 ;; 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 (string-split-nonescaped string delimiter)
+(define (string-split-unescaped string delimiter)
   (let [(appendee "")]
     (remove
      not
@@ -108,7 +114,9 @@
 (define (parse-vcard-value prop elements)
   (let [(parser-and-unparser-funcs (alist-ref prop vcard-value-parsers))]
     (if parser-and-unparser-funcs
-        (list (apply (car parser-and-unparser-funcs) (list elements)))
+        (list (ignore-error (apply (car parser-and-unparser-funcs)
+                                   (list elements))
+                            elements))
         (list elements))))
 
 
@@ -116,7 +124,7 @@
 ;;    (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 (string-split-nonescaped (car prop-value-strings) ";"))
+         (prop-elements (string-split-unescaped (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))