Create vcarded module and egg

vcarded.egg

@@ -0,0 +1,8 @@
+;; -*- Scheme -*-
+((synopsis "Simple vCard parser.")
+ (author "Jaidyn Ann")
+ (category net)
+ (license "GPLv3")
+ (dependencies srfi-1 srfi-13 srfi-130 uri-common)
+ (components
+  (extension vcarded)))

vcarded.scm

@@ -13,41 +13,46 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
 
+(module vcarded
+    (read-vcard)
 
-(import
+  (import
     scheme
+    (chicken base)
+    (chicken condition)
     (chicken io)
     srfi-1
     srfi-13
+    srfi-19
     srfi-130
     (prefix uri-common uri:))
 
 
-;; List of all properties with semicoloned-structured strings.
+  ;; List of all properties with semicoloned-structured strings.
-(define vcard-semicoloned-properties
+  (define vcard-semicoloned-properties
     '(ADR CLIENTPIDMAP GENDER N))
 
 
-;; List of all properties with datetime values.
+  ;; List of all properties with datetime values.
-(define vcard-datetime-properties
+  (define vcard-datetime-properties
     '(ANNIVERSARY BDAY REV))
 
 
-;; List of all properties with multiple comma-separated values.
+  ;; List of all properties with multiple comma-separated values.
-(define vcard-csv-properties
+  (define vcard-csv-properties
     '(CATEGORIES NICKNAME))
 
 
-;; List of all URL-type vcard properties.
+  ;; List of all URL-type vcard properties.
-(define vcard-url-properties
+  (define vcard-url-properties
     '(CALADRURI CALURI FBURL GEO IMPP
                 KEY LOGO MEMBER PHOTO RELATED
                 SOUND SOURCE TEL UID URL))
 
 
-;; Should parse any truncated & reduced-accuracy ISO 8601 datetime.
+  ;; Should parse any truncated & reduced-accuracy ISO 8601 datetime.
-;; … right now, it only parses a few possibilities.
+  ;; … right now, it only parses a few possibilities.
-(define (string->any-date str)
+  (define (string->any-date str)
     (let* [(ymd "~Y~m~d")
            (hms "~H~M~S")
            (ymd-hms (string-join (list ymd hms) "T"))]
@@ -56,17 +61,17 @@
           (ignore-error (string->date str hms) #f))))
 
 
-;; A list of the parser/serializer functions for each vcard property.
+  ;; A list of the parser/serializer functions for each vcard property.
-;;    ((TEL #<procedure> #<procedure>)
+  ;;    ((TEL #<procedure> #<procedure>)
-;;     (ADR #<procedure> #<procedure>)
+  ;;     (ADR #<procedure> #<procedure>)
-;;     …)
+  ;;     …)
-;; TODO: Add a parser for the TZ [timezone] property.
+  ;; TODO: Add a parser for the TZ [timezone] property.
-(define vcard-value-parsers
+  (define vcard-value-parsers
     (append
      (map (lambda (uri-prop)
             (list uri-prop
                   (lambda strs (or (uri:uri-reference (string-join strs ";"))
-                                  (string-join sts ";")))
+                                   (string-join strs ";")))
                   (lambda (url) (uri:uri->string url))))
           vcard-url-properties)
      (map (lambda (date-prop)
@@ -87,28 +92,28 @@
           vcard-semicoloned-properties)))
 
 
-;; Splits a line into a cons of the property-string and value-string.
+  ;; Splits a line into a cons of the property-string and value-string.
-;; … 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 (string-split-unescaped line ":"))]
       (cons (car split)
             (string-join (cdr split) ":"))))
 
 
-;; Ignore whatever conditions the expression might return; just return the
+  ;; Ignore whatever conditions the expression might return; just return the
-;; default value in that case.
+  ;; default value in that case.
-;;    (ignore-error (+ 1 "seven") 3) → 3
+  ;;    (ignore-error (+ 1 "seven") 3) → 3
-(define-syntax ignore-error
+  (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
+  ;; Splits a string along a delimiter; while not splitting along
-;; backslash-escaped delimiters. With “;” as the delimiter:
+  ;; backslash-escaped delimiters. With “;” as the delimiter:
-;;    "Bird;dad;apple\;mom" → ("Bird" "dad" "apple\;mom")
+  ;;    "Bird;dad;apple\;mom" → ("Bird" "dad" "apple\;mom")
-(define (string-split-unescaped string delimiter)
+  (define (string-split-unescaped string delimiter)
     (let [(appendee "")]
       (remove
        not
@@ -124,12 +129,12 @@
             (string-split string delimiter)))))
 
 
-(define (parse-vcard-prop property elements)
+  (define (parse-vcard-prop property elements)
     (append (list property)
             (list elements)))
 
 
-(define (parse-vcard-value prop elements)
+  (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)
@@ -138,9 +143,9 @@
           (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* [(prop-value-strings (split-vcard-line line))
            (prop-elements (string-split-unescaped (car prop-value-strings) ";"))
            (value-elements (cdr prop-value-strings))
@@ -149,25 +154,25 @@
               (parse-vcard-value property value-elements))))
 
 
-;; Reader thunk. Read/parse an entire vcard into a “vcard alist.”
+  ;; Reader thunk. Read/parse an entire vcard into a “vcard alist.”
-(define (read-vcard)
+  (define (read-vcard)
     (let [(element (read-vcard-element))]
       (if (not (eof-object? (peek-char)))
           (append (list element) (read-vcard))
           (list element))))
 
 
-;; Read a single unfolded line into a vcard “element” list.
+  ;; Read a single unfolded line into a vcard “element” list.
-(define (read-vcard-element)
+  (define (read-vcard-element)
     (parse-vcard-line (read-folded-line)))
 
 
-;; Reader-thunk. Read a “logical” folded-line, where a line beginning with a
+  ;; Reader-thunk. Read a “logical” folded-line, where a line beginning with a
-;; space is a continuation of the previous line — like with vcards.
+  ;; space is a continuation of the previous line — like with vcards.
-(define (read-folded-line)
+  (define (read-folded-line)
     (let [(line (read-line))]
       (if (eq? (peek-char) #\space)
           (string-concatenate
            (list line
                  (string-drop (read-folded-line) 1)))
-        line)))
+          line))))