chicken-vcarded/vcarded.scm

;; 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 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")))


;; Create irregx-format regex for matching an unescaped character.
(define (regex-unescaped-char char-string)
  `(: (neg-look-behind "\\") ,char-string))


;; Splits a line into a list of key/value pairs.
(define (split-vcard-line line)
  (let [(split (irregex-split (regex-unescaped-char ":") 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))


(define (parse-vcard-element kv-pair)
  (case (car kv-pair)
    ('VERSION
     (append (list (car kv-pair) (string->number (second kv-pair)))
             (cddr kv-pair)))
    (else kv-pair)))


;; 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))))


(define (vcard-string->alist string)
  (map parse-vcard-line (lines string)))