(in-package :aion.parser) (defgeneric handle-begin (client block) (:documentation "handle the beginning of a new block in the iCalendar data")) (defgeneric handle-end (client block) (:documentation "handle the ending of a block in the iCalendar data")) (defgeneric handle-property (client tag params content) (:documentation "handle a property for the current iCalendar block")) (defun get-line (stream) (loop for line = (read-line stream nil) while line collect line into results while (eql #\space (peek-char nil stream nil)) finally (return (when results (string-right-trim '(#\newline #\return) (serapeum:string-replace-all #1=#.(coerce (list #\return #\space) 'string) (serapeum:string-join results "") "")))))) (defmacro with-temporary-keywords ((intern) &body body) (alexandria:with-gensyms (kw-list) `(let ((,kw-list '())) (unwind-protect (flet ((,intern (inp) (multiple-value-bind (kw existing?) (alexandria:make-keyword (string-upcase inp)) (prog1 kw (unless existing? (push kw ,kw-list)))))) ,@body) (mapc 'unintern ,kw-list))))) (defgeneric as-stream (it) (:method ((it string)) (make-string-input-stream it)) (:method ((it pathname)) (open it)) (:method ((it stream)) it)) (defun process-ics (client file) (let ((states '())) (with-temporary-keywords (normalize) (labels ((%handle-block-delimiter (tag type) (push type states) (ecase tag ((:begin) (handle-begin client type)) ((:end) (handle-end client type)))) (parse-params (inp) (destructuring-bind (head params) (fwoar.string-utils:partition #\; inp) (values head (when params (map 'list (data-lens:• (data-lens:transform-head #'normalize) (serapeum:op (fwoar.string-utils:partition #\= _))) (fwoar.string-utils:split #\; params)))))) (parse-property (it) (destructuring-bind (s e) (fwoar.string-utils:partition #\: it) (multiple-value-bind (head params) (parse-params s) (list (normalize head) params e)))) (%handle-property (it) (apply 'handle-property client it)) (handle-line (tag tagged line) (case tag ((:begin) (%handle-block-delimiter tag (normalize tagged))) ((:end) (%handle-block-delimiter tag (normalize tagged))) (t (%handle-property (parse-property line)))))) (with-open-stream (s (as-stream file)) (loop for line = (get-line s) for (tag tagged) = (if line (fwoar.string-utils:partition #\: line) '(nil nil)) while line do (handle-line (fw.lu:may (normalize tag)) tagged line)))))))