Function documentation and re-organization
Purely for legibility; no functional changes.
This commit is contained in:
parent
099e74cc38
commit
612dde9533
334
vcarded.scm
334
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
|
||||
(lambda (str) (string-split-unescaped str ","))
|
||||
(lambda (csv-list) (string-join csv-list ","))))
|
||||
(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
|
||||
|
|
@ -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 (:).
|
||||
;; "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) ":"))))
|
||||
|
||||
;;; ~ General utilities ~ ^^
|
||||
|
||||
;; 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))
|
||||
""))
|
||||
|
||||
|
||||
;; 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)))))
|
||||
;; 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))))
|
||||
|
||||
|
||||
;; 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)))))
|
||||
|
||||
|
||||
;; 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)))))
|
||||
(string-split string delimiter))))))
|
||||
|
||||
|
|
|
|||
Ŝarĝante…
Reference in New Issue