chicken-vcarded/vcarded.scm

87 lines
2.8 KiB
Scheme
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;; Copyright © 2024 Jaidyn Ann <jadedctrl@posteo.at>
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(import
scheme
(chicken io)
(chicken irregex)
srfi-1
srfi-130)
;; Splits a string into a list of CRLFd lines.
(define (unlines lines)
(string-join lines "\r\n"))
;; Splits a string into a list of CRLFd lines.
(define (lines string)
(remove string-null? (string-split string "\r\n")))
;; Splits a line into a cons of the property-string and value-string.
;; … basically splits the string along the first unescaped colon (:).
(define (split-vcard-line line)
(let [(split (irregex-extract "(\\\\:|[^:])*" line))]
(if (>= (length split) 2)
(cons
(car split)
(reduce-right
(lambda (a b) (string-concatenate (list a ":" b)))
"" (cdr split)))
#f)))
;; Splits a key or value-element into its (potentially multiple) parameters.
(define (split-vcard-element key-or-value)
(irregex-extract "(\\\\;|[^;])*" key-or-value))
;; 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* [(key-value-strings (split-vcard-line line))
(key-elements (split-vcard-element (car key-value-strings)))
(value-elements (split-vcard-element (cdr key-value-strings)))]
(list (string->symbol (car key-elements))
(car value-elements)
(cdr key-elements)
(cdr value-elements))))
;; Reader thunk. Read/parse an entire vcard into a “vcard alist.”
(define (read-vcard)
(let [(element (read-vcard-element))]
(if (not (eof-object? (peek-char)))
(append (list element) (read-vcard))
element)))
;; Read a single unfolded line into a vcard “element” list.
(define (read-vcard-element)
(parse-vcard-line (read-folded-line)))
;; 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)
(let [(line (read-line))]
(if (eq? (peek-char) #\space)
(string-concatenate
(list line
(string-drop (read-element) 1)))
line)))