Function documentation and re-organization

Purely for legibility; no functional changes.

vcarded.scm

@@ -30,6 +30,162 @@
     (srfi 207)
     (prefix uri-common uri:))
 
+
+  ;;; ~ Macros ~
+
+  ;; 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)))))
+
+
+
+  ;;; ~ Exports ~
+
+  ;; Reader thunk. Read/parse an entire vCard into a “vCard alist.”
+  ;; vCard is read from an optional PORT, defaulting to (current-input-port).
+  ;; Ignore the IGNORED parameter.
+  ;;
+  ;; The format of a cell is:
+  ;;    (PROPERTY-SYMBOL (ATTRIBUTE-STR …) PROPERTY-VALUE)
+  ;;
+  ;; PROPERTY-VALUE might be a string, a uri-common URI, an srfi-19 datetime,
+  ;; an srfi-4 bytevector (u8vector), or a list of values.
+  ;;
+  ;; The type of the value follows logically  from the vCard specification’s
+  ;; type for that property — URI properties are a uri-common URI and NICKNAME
+  ;; is a list of strings, for example.
+  ;;
+  ;; But there is one notable exception: `data`-URIs are parsed into bytevectors
+  ;; for convenience, as these are often used to encode profile pictures.
+  ;;
+  ;; Anyway, here is an example vCard alist made by this function:
+  ;;    ((BEGIN () "VCARD")
+  ;;     (VERSION () "3.0")
+  ;;     (FN () "Birdie Johnson")
+  ;;     (NICKNAME () ("Bird" "Gal" "Tweety"))
+  ;;     (TEL ("type=home") #<URI-common: scheme=tel path=("12149989852")>)
+  ;;     (END () "VCARD"))
+  (define (read-vcard #!optional (port (current-input-port)) (ignored #t))
+    (let* [(first-element? ignored)
+           (element (read-vcard-element port first-element?))]
+      (if (not (eof-object? (peek-char port)))
+          (append (list element) (read-vcard port #f))
+          (list element))))
+
+
+  ;; Writes a vCard’s parsed alist to the output port as a string.
+  ;; Defaults to (current-output-port).
+  ;;
+  ;; I wish I had more to say, especially compared to READ-VCARD’s essay-long
+  ;; description, but unfortunately I’m coming up empty! =w=,
+  (define (write-vcard vcard-alist #!optional (port (current-output-port)))
+    (for-each (lambda (element)
+                (write-string (serialize-vcard-element element) #f port)
+                (write-char #\return port)
+                (write-char #\newline port))
+              vcard-alist))
+
+
+
+  ;;; ~ vCard parsing [string→alist] ~
+
+  ;; Read a single unfolded line into a vCard “element” list.
+  ;; The optional FIRST-ELEMENT? argument simply makes sure the next line is a
+  ;; BEGIN:VCARD element (as the first element in any valid vCard file should
+  ;; be. It is used internally by READ-VCARD.
+  (define (read-vcard-element #!optional (port (current-input-port)) (first-element? #f))
+    (let* [(line (read-folded-line (if first-element? 100 #f) port))]
+      (cond
+       ;; Ignore blank lines, they’re not doing anyone any harm!
+       [(or (string-null? line)
+            (irregex-search "^[[:whitespace:]]+$" line))
+        (read-vcard-element port first-element?)]
+       ;; If we’ve previously established this is a vCard stream we’re dealing
+       ;; with, just go ahead and parse. If we haven’t established that, make
+       ;; sure it’s a BEGIN:VCARD line first.
+       [(or (not first-element?)
+            (and first-element?
+                 (string-contains line "BEGIN")
+                 (string-contains line "VCARD")))
+        (parse-vcard-line line)]
+       ;; If we’re still making sure the file is vCard, and the first non-blank
+       ;; line *isn’t* a BEGIN:VCARD line, then the file probably isn’t a vCard.
+       [#t
+        (signal
+         (condition '(exn location vcarded message
+                          "Not a valid vCard file.")
+                    '(file)
+                    '(vcard)))])))
+
+
+  ;; Parse a line of a vcard file into an alist-friendly format:
+  ;;    (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-unescaped (car prop-value-strings) ";"))
+           (value-elements (cdr prop-value-strings))
+           (property (string->symbol (string-upcase (car prop-elements))))]
+      (append (parse-vcard-property property (cdr prop-elements))
+              (parse-vcard-value property value-elements))))
+
+
+  ;; 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-unescaped line ":"))]
+      (cons (car split)
+            (string-join (cdr split) ":"))))
+
+
+  ;; Given a vCard property and its values (e.g., “VERSION” and “3.0”),
+  ;; parse them into a list.
+  ;;    "EMAIL;TYPE=home" "mom@dad.com" → '(EMAIL ("TYPE=home") "mom@dad.com")
+  (define (parse-vcard-property property elements)
+    (append (list property)
+            (list elements)))
+
+
+  ;; Given the value(s) of a vCard element’s value string(s), returned a
+  ;; parsed object.
+  ;;    'BIRTHDAY "2024-01-02T00:00:00" → #@2024-01-02T00:00:00-0600
+  (define (parse-vcard-value prop elements)
+    (let [(parser-and-unparser-funcs (alist-ref prop vcard-value-parsers))]
+      (if parser-and-unparser-funcs
+          (list (ignore-error (apply (car parser-and-unparser-funcs)
+                                     (list elements))
+                              elements))
+          (list elements))))
+
+
+
+  ;;; ~ vCard serialization [alist→string] ~
+
+  ;; With an element of a parsed vCard alist, serialize it (back) into a
+  ;; string.
+  (define (serialize-vcard-element element)
+    (let [(property (string-join
+                     (append (list (symbol->string (car element)))
+                             (second element)) ";"))
+          (value (serialize-vcard-value (car element) (last element)))]
+      (string-join (list property value) ":")))
+
+
+  ;; Serialize the value of a vCard property (from a parsed vCard alist)
+  ;; into a string.
+  (define (serialize-vcard-value prop value)
+    (let [(parser-and-unparser-funcs (alist-ref prop vcard-value-parsers))]
+      (if parser-and-unparser-funcs
+          (apply (cadr parser-and-unparser-funcs) (list value))
+          value)))
+
+
+
+  ;;; ~ Property-value parsers ~
 
   ;; List of all properties with semicoloned-structured strings.
   (define vcard-semicoloned-properties
@@ -69,7 +225,6 @@
     (uri:uri-reference string))
 
 
-
   ;; Parse a data URI’s contents into a list containing the mimetype (string)
   ;; and bytevector contents (u8vector).
   ;;    "data:text/plain;base64,ZGFk" → ("text/plain;base64" #u8(100 97 100))
@@ -157,9 +312,9 @@
                         datetime))))
           vcard-datetime-properties)
      (map (lambda (csv-prop)
-             (list csv-prop
+            (list csv-prop
-                     (lambda (str) (string-split-unescaped str ","))
+                 (lambda (str) (string-split-unescaped str ",")
-                     (lambda (csv-list) (string-join csv-list ","))))
+                  (lambda (csv-list) (string-join csv-list ",")))))
           vcard-csv-properties)
      (map (lambda (semicolon-prop)
             (list semicolon-prop
@@ -168,22 +323,32 @@
           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 (:).
+  ;;; ~ General utilities ~ ^^
-  ;;    "apple\:berry:mom:dad" → ("apple\:berry" . "mom:dad")
+
-  (define (split-vcard-line line)
+  ;; Reader-thunk. Read a “logical” folded-line, where a line beginning with a
-    (let [(split (string-split-unescaped line ":"))]
+  ;; space is a continuation of the previous line — like with vcards.
-      (cons (car split)
+  (define (read-folded-line #!optional (limit 100) (port (current-input-port)))
-            (string-join (cdr split) ":"))))
+    (if (not (eof-object? (peek-char port)))
+        (let [(line (read-line port limit))]
+          (if (or (eq? (peek-char port) #\space)
+                  (eq? (peek-char port) #\tab))
+              (string-concatenate
+               (list line
+                     (string-drop (read-folded-line limit port) 1)))
+              line))
+        ""))
 
 
-  ;; Ignore whatever conditions the expression might return; just return the
+  ;; Split a STRING into strings of a size of (at most) LENGTH signs.
-  ;; default value in that case.
+  ;;    ("ÁPPLE" 2) → '("ÁP" "PL" "E")
-  ;;    (ignore-error (+ 1 "seven") 3) → 3
+  (define (string-split-by-lengths string length)
-  (define-syntax ignore-error
+    (append (list (if (<= (string-length string) length)
-    (syntax-rules ()
+                      string
-      ((ignore-error expr default)
+                      (substring string 0 length)))
-       (condition-case expr (var () default)))))
+            (if (<= (string-length string) length)
+                '()
+                (string-split-by-lengths (substring string length) length))))
 
 
   ;; Splits a string along a delimiter; while not splitting along
@@ -202,136 +367,5 @@
                            (string-concatenate (list substr delimiter)))
                          #f)
                     (and (set! appendee "") substr))))
-            (string-split string delimiter)))))
+            (string-split string delimiter))))))
-
-
-  ;; Given a vCard property and its values (e.g., “VERSION” and “3.0”),
-  ;; parse them into a list.
-  ;;    "EMAIL;TYPE=home" "mom@dad.com" → '(EMAIL ("TYPE=home") "mom@dad.com")
-  (define (parse-vcard-property property elements)
-    (append (list property)
-            (list elements)))
-
-
-  ;; Given the value(s) of a vCard element’s value string(s), returned a
-  ;; parsed object.
-  ;;    'BIRTHDAY "2024-01-02T00:00:00" → #@2024-01-02T00:00:00-0600
-  (define (parse-vcard-value prop elements)
-    (let [(parser-and-unparser-funcs (alist-ref prop vcard-value-parsers))]
-      (if parser-and-unparser-funcs
-          (list (ignore-error (apply (car parser-and-unparser-funcs)
-                                     (list elements))
-                              elements))
-          (list elements))))
-
-
-  ;; With an element of a parsed vCard alist, serialize it (back) into a
-  ;; string.
-  (define (serialize-vcard-element element)
-    (let [(property (string-join
-                     (append (list (symbol->string (car element)))
-                             (second element)) ";"))
-          (value (serialize-vcard-value (car element) (last element)))]
-      (string-join (list property value) ":")))
-
-
-  ;; Serialize the value of a vCard property (from a parsed vCard alist)
-  ;; into a string.
-  (define (serialize-vcard-value prop value)
-   (let [(parser-and-unparser-funcs (alist-ref prop vcard-value-parsers))]
-     (if parser-and-unparser-funcs
-         (apply (cadr parser-and-unparser-funcs) (list value))
-         value)))
-
-
-  ;; Serialize a vCard parsed-alist into a set of line-strings, once more.
-  (define (serialized-vcard vcard-alist)
-    (map serialize-vcard-element vcard-alist))
-
-
-  ;; Parse a line of a vcard file into an alist-friendly format:
-  ;;    (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-unescaped (car prop-value-strings) ";"))
-           (value-elements (cdr prop-value-strings))
-           (property (string->symbol (string-upcase (car prop-elements))))]
-      (append (parse-vcard-property property (cdr prop-elements))
-              (parse-vcard-value property value-elements))))
-
-
-  ;; Reader thunk. Read/parse an entire vCard into a “vCard alist.”
-  ;; vCard is read from an optional PORT, defaulting to (current-input-port).
-  ;; Ignore the IGNORED parameter.
-  (define (read-vcard #!optional (port (current-input-port)) (ignored #t))
-    (let* [(first-element? ignored)
-           (element (read-vcard-element port first-element?))]
-      (if (not (eof-object? (peek-char port)))
-          (append (list element) (read-vcard port #f))
-          (list element))))
-
-
-
-  ;; Read a single unfolded line into a vCard “element” list.
-  ;; The optional FIRST-ELEMENT? argument simply makes sure the next line is a
-  ;; BEGIN:VCARD element (as the first element in any valid vCard file should
-  ;; be. It is used internally by READ-VCARD.
-  (define (read-vcard-element #!optional (port (current-input-port)) (first-element? #f))
-    (let* [(line (read-folded-line (if first-element? 100 #f) port))]
-      (cond
-       ;; Ignore blank lines, they’re not doing anyone any harm!
-       [(or (string-null? line)
-            (irregex-search "^[[:whitespace:]]+$" line))
-        (read-vcard-element port first-element?)]
-       ;; If we’ve previously established this is a vCard stream we’re dealing
-       ;; with, just go ahead and parse. If we haven’t established that, make
-       ;; sure it’s a BEGIN:VCARD line first.
-       [(or (not first-element?)
-            (and first-element?
-                 (string-contains line "BEGIN")
-                 (string-contains line "VCARD")))
-        (parse-vcard-line line)]
-       ;; If we’re still making sure the file is vCard, and the first non-blank
-       ;; line *isn’t* a BEGIN:VCARD line, then the file probably isn’t a vCard.
-       [#t
-        (signal
-         (condition '(exn location vcarded message
-                          "Not a valid vCard file.")
-                    '(file)
-                    '(vcard)))])))
-
-
-  ;; Reader-thunk. Read a “logical” folded-line, where a line beginning with a
-  ;; space is a continuation of the previous line — like with vcards.
-  (define (read-folded-line #!optional (limit 100) (port (current-input-port)))
-    (if (not (eof-object? (peek-char port)))
-      (let [(line (read-line port limit))]
-        (if (or (eq? (peek-char port) #\space)
-                (eq? (peek-char port) #\tab))
-            (string-concatenate
-             (list line
-                   (string-drop (read-folded-line limit port) 1)))
-            line))
-      ""))
-
-
-  ;; Writes a vCard alist to the output port as a string.
-  ;; Defaults to (current-output-port).
-  (define (write-vcard vcard-alist #!optional (port (current-output-port)))
-    (for-each (lambda (element)
-                (write-string (serialize-vcard-element element) #f port)
-                (write-char #\return port)
-                (write-char #\newline port))
-         vcard-alist))
-
-
-  ;; Split a STRING into strings of a size of (at most) LENGTH signs.
-  ;;    ("ÁPPLE" 2) → '("ÁP" "PL" "E")
-  (define (string-split-by-lengths string length)
-    (append (list (if (<= (string-length string) length)
-                      string
-                      (substring string 0 length)))
-            (if (<= (string-length string) length)
-                '()
-                (string-split-by-lengths (substring string length) length)))))