(defpackage :aion.sqlite (:use :cl ) (:import-from :aion.parser #:handle-begin #:handle-end #:handle-property #:process-ics) (:export #:ics->sqlite)) (in-package :aion.sqlite) (fw.lu:defclass+ emit-sql () ((%lines :accessor lines :initform ()) (%tzid :accessor tzid :initform nil) (%db :reader db :initarg :db))) (defmethod handle-begin ((client emit-sql) block) (values)) (defmethod handle-end :after ((client emit-sql) block) (setf (lines client) nil)) (defmethod handle-end ((client emit-sql) block) ) (defmethod handle-end :before ((client emit-sql) block) (values)) (defmethod handle-end ((client emit-sql) (block (eql :vevent))) (macrolet ((get-setter () `(sxql:set= ,@(mapcan (lambda (it) (list it `(serapeum:assocadr ,(alexandria:make-keyword (substitute #\- #\_ (string it))) (lines client)))) '(:GEO :UID :URL :TZID :CLASS :DTEND :RRULE :ACTION :ATTACH :EXDATE :METHOD :PRODID :STATUS :TRANSP :TZNAME :VALARM :VEVENT :CREATED :DTSTAMP :DTSTART :SUMMARY :TRIGGER :VERSION :ATTENDEE :CALSCALE :LOCATION :SEQUENCE :ORGANIZER :CATEGORIES :TZOFFSETTO :X_ALT_DESC :DESCRIPTION :ACKNOWLEDGED :TZOFFSETFROM :X_WR_CALDESC :X_WR_CALNAME :LAST_MODIFIED :RECURRENCE_ID :X_WR_ALARMUID :X_WR_TIMEZONE :X_LIC_LOCATION :X_APPLE_DEFAULT_ALARM :X_APPLE_TRAVEL_ADVISORY_BEHAVIOR))))) (multiple-value-bind (query params) (sxql:yield (sxql:insert-into :vevent (get-setter))) (apply 'sqlite:execute-single (db client) query params)))) (defmethod handle-property ((client emit-sql) tag params content) (push (list tag content) (lines client))) (defparameter +datetime-scanner+ (cl-ppcre:create-scanner '(:SEQUENCE :START-ANCHOR ;; date yyyy-mm-dd (:REGISTER (:GREEDY-REPETITION 4 4 :DIGIT-CLASS)) (:REGISTER (:GREEDY-REPETITION 2 2 :DIGIT-CLASS)) (:REGISTER (:GREEDY-REPETITION 2 2 :DIGIT-CLASS)) #\T ;; time hh-mm-ss (:REGISTER (:GREEDY-REPETITION 2 2 :DIGIT-CLASS)) (:REGISTER (:GREEDY-REPETITION 2 2 :DIGIT-CLASS)) (:REGISTER (:GREEDY-REPETITION 2 2 :DIGIT-CLASS)) ;; tz (:GREEDY-REPETITION 0 1 (:REGISTER #\Z)) :END-ANCHOR))) (defparameter +date-scanner+ (cl-ppcre:create-scanner '(:SEQUENCE :START-ANCHOR ;; date yyyy-mm-dd (:REGISTER (:GREEDY-REPETITION 4 4 :DIGIT-CLASS)) (:REGISTER (:GREEDY-REPETITION 2 2 :DIGIT-CLASS)) (:REGISTER (:GREEDY-REPETITION 2 2 :DIGIT-CLASS)) :END-ANCHOR))) (defparameter +time-scanner+ (cl-ppcre:create-scanner '(:SEQUENCE :START-ANCHOR ;; time hh-mm-ss (:REGISTER (:GREEDY-REPETITION 2 2 :DIGIT-CLASS)) (:REGISTER (:GREEDY-REPETITION 2 2 :DIGIT-CLASS)) (:REGISTER (:GREEDY-REPETITION 2 2 :DIGIT-CLASS)) ;; tz (:GREEDY-REPETITION 0 1 (:REGISTER #\Z)) :END-ANCHOR))) (defparameter +sqlite-format+ '((:YEAR 4) #\- (:MONTH 2) #\- (:DAY 2) #\space (:HOUR 2) #\: (:MIN 2) #\: (:SEC 2) :GMT-OFFSET-OR-Z)) (defun parse-datetime (time timezone) (trivia:ematch (nth-value 1 (cl-ppcre:scan-to-strings +datetime-scanner+ time)) (#(ye mo da ho mi se tz) (local-time:encode-timestamp 0 (fw.lu:if-let* ((se (parse-integer se)) (_ (= 60 se))) 59 se) (parse-integer mi) (parse-integer ho) (parse-integer da) (parse-integer mo) (parse-integer ye) :timezone (if (equal tz "Z") local-time:+utc-zone+ timezone))))) (defun parse-date (time) (trivia:ematch (nth-value 1 (cl-ppcre:scan-to-strings +date-scanner+ time)) (#(ye mo da) (local-time:encode-timestamp 0 0 0 0 (parse-integer da) (parse-integer mo) (parse-integer ye))))) ;;what do I do for the date here??? #+(or) (defun parse-time (time) (trivia::match (nth-value 1 (cl-ppcre:scan-to-strings +time-scanner+ time)) (#(ho mi se) (local-time:make-timestamp 0 0 0 0 (parse-integer da) (parse-integer mo) (parse-integer ye))))) (defun handle-ical-date (client tag params content) (push (list tag (local-time:format-timestring nil (case (alexandria:make-keyword (string-upcase (serapeum:assocadr :value params))) (:date (parse-date content)) (t (parse-datetime content (or (local-time:find-timezone-by-location-name (serapeum:assocadr :tzid params)) (tzid client))))) :format +sqlite-format+)) (lines client))) (defmethod handle-property ((client emit-sql) (tag (eql :dtstart)) params content) (handle-ical-date client tag params content)) (defmethod handle-property ((client emit-sql) (tag (eql :dtend)) params content) (handle-ical-date client tag params content)) (defmethod handle-property ((client emit-sql) (tag (eql :created)) params content) (handle-ical-date client tag params content)) (defmethod handle-property ((client emit-sql) (tag (eql :dtstamp)) params content) (handle-ical-date client tag params content)) (defun setup-sql () (sxql:yield (sxql:make-statement :create-table '(:vevent :if-not-exists t) (mapcar (lambda (it) (sxql.clause:make-column-definition-clause it :type 'text)) '(:GEO :UID :URL :TZID :CLASS :DTEND :RRULE :ACTION :ATTACH :EXDATE :METHOD :PRODID :STATUS :TRANSP :TZNAME :VALARM :VEVENT :CREATED :DTSTAMP :DTSTART :SUMMARY :TRIGGER :VERSION :ATTENDEE :CALSCALE :LOCATION :SEQUENCE :ORGANIZER :CATEGORIES :TZOFFSETTO :X_ALT_DESC :DESCRIPTION :ACKNOWLEDGED :TZOFFSETFROM :X_WR_CALDESC :X_WR_CALNAME :LAST_MODIFIED :RECURRENCE_ID :X_WR_ALARMUID :X_WR_TIMEZONE :X_LIC_LOCATION :X_APPLE_DEFAULT_ALARM :X_APPLE_TRAVEL_ADVISORY_BEHAVIOR)) (sxql:primary-key '(:sequence :uid :recurrence_id))) #+(or) (sxql:create-table (:vevent :if-not-exists t) ((:ATTACH :type 'text) (:ATTENDEE :type 'text) (:CATEGORIES :type 'text) (:CREATED :type 'text) (:DESCRIPTION :type 'text) (:DTEND :type 'text) (:DTSTAMP :type 'text) (:DTSTART :type 'text) (:EXDATE :type 'text) (:GEO :type 'text) (:LAST_MODIFIED :type 'text) (:LOCATION :type 'text) (:ORGANIZER :type 'text) (:RECURRENCE_ID :type 'text) (:RRULE :type 'text) (:SEQUENCE :type 'text) (:STATUS :type 'text) (:SUMMARY :type 'text) (:TRANSP :type 'text) (:UID :type 'text) (:URL :type 'text) (:VALARM :type 'text) (:VEVENT :type 'text) (:X_ALT_DESC :type 'text) (:X_APPLE_TRAVEL_ADVISORY_BEHAVIOR :type 'text)) (sxql:primary-key '(:sequence :uid :recurrence_id))))) (defun ics->sqlite (fn data) (sqlite:with-open-database (db fn) (sqlite:execute-non-query db (sxql:yield (sxql:drop-table :vevent :if-exists t))) (sqlite:execute-non-query db (setup-sql)) (sqlite:with-transaction db (process-ics (emit-sql db) data))))