(defpackage :fwoar.lisp-sandbox.ical-parser
  (:use :cl )
  (:export ))
(in-package :fwoar.lisp-sandbox.ical-parser)

(defvar *data* (alexandria:read-file-into-string "~/test.ics"))

(defun next-section (s &optional start)
  (if start
      (search "BEGIN" s :start2 start)
      (search "BEGIN" s)))

(defmacro str->stream ((op arg &rest r))
  (alexandria:once-only (arg)
    (alexandria:with-gensyms (s)
      `(with-input-from-string (,s ,arg)
         (,op ,s ,@r)))))

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

(defgeneric handle-begin (client block)
  (:method (_ block)
    (format t "~&;; >>>~a~%" block)))
(defgeneric handle-end (client block)
  (:method (_ block)
    (format t "~&;; <<<~a~%" block)))
(defgeneric handle-line (client tag params content)
  (:method (_ tag params content)
    (format t "~&;; - ~s•~s•~s~%" tag params content)))
(defun process-ics (client file)
  (let ((states '())
        (new-keywords '()))
    (unwind-protect
         (labels ((normalize (inp)
                    (multiple-value-bind (kw existing?)
                        (alexandria:make-keyword (string-upcase inp))
                      (unless existing?
                        (push kw new-keywords))
                      kw))
                  (%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-line (it)
                    (apply 'handle-line client it)))
           (with-input-from-string (s file)
             (loop for line = (get-line s)
                   for (%tag tagged) = (if line
                                           (fwoar.string-utils:partition #\: line)
                                           '(nil nil))
                   for tag = (fw.lu:may (normalize %tag))
                   while line
                   do (case tag
                        ((:begin)
                         (%handle-block-delimiter tag (normalize tagged)))
                        ((:end)
                         (%handle-block-delimiter tag (normalize tagged)))
                        (t (%handle-line (parse-property line)))))))
      (mapc 'unintern new-keywords))))

(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 :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))))
                                     '(:X_APPLE_TRAVEL_ADVISORY_BEHAVIOR
                                       :VEVENT :VALARM :RECURRENCE_ID
                                       :ORGANIZER :LAST_MODIFIED
                                       :EXDATE :CREATED :ATTENDEE
                                       :ATTENDEE :ATTACH :CATEGORIES
                                       :DESCRIPTION :DTEND :DTSTAMP
                                       :DTSTART :GEO :LOCATION :RRULE
                                       :SEQUENCE :STATUS :SUMMARY
                                       :TRANSP :UID :URL
                                       :X_ALT_DESC)))))
    (multiple-value-bind (query params)
        (sxql:yield
         (sxql:insert-into :vevent
           (get-setter)))
      (apply 'sqlite:execute-single
             (db client)
             query
             params))))
(defmethod handle-line ((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-line ((client emit-sql) (tag (eql :dtstart)) params content)
  (handle-ical-date client tag params content))
(defmethod handle-line ((client emit-sql) (tag (eql :dtend)) params content)
  (handle-ical-date client tag params content))
(defmethod handle-line ((client emit-sql) (tag (eql :created)) params content)
  (handle-ical-date client tag params content))
(defmethod handle-line ((client emit-sql) (tag (eql :dtstamp)) params content)
  (handle-ical-date client tag params content))
(defmethod handle-line :after ((client emit-sql) (tag (eql :dtstart)) params content)
  (format t "~&~s ~s~%~4t~s~%~4t~s~%" tag params
          content
          (parse-time content
                      (or (local-time:find-timezone-by-location-name
                           (serapeum:assocadr :tzid params))
                          (tzid client)))))

(defun setup-sql ()
  (sxql:yield
   (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))))


(fw.lu:defclass+ build-tree ()
  ((%history :accessor history :initform ())))

(defmethod handle-begin ((client build-tree) block)
  (push (list block) (history client)))
(defmethod handle-end ((client build-tree) block)
  (progn (when (cdr (history client))
           (let ((last (pop (history client))))
             (push (nreverse last)
                   (car (history client)))))))
(defmethod handle-line ((client build-tree) tag params content)
  (push (list tag params content)
        (car (history client))))

(defun ics->tree (data)
  (let ((client (build-tree)))
    (process-ics client data)
    (nreverse (car (history client)))))

(fw.lu:defclass+ one-vevent ()
  ((%started :accessor started :initform nil)
   (%lines :accessor lines :initform nil)))

(defmethod handle-begin ((client one-vevent) block)
  (when (eql block :vevent)
    (push block (started client))))

(defmethod handle-line ((client one-vevent) tag params content)
  (when (started client)
    (push (list tag params content)
          (lines client))))

(defmethod handle-end ((client one-vevent) block)
  (when (eql block :vevent)
    (throw 'vevent
      (nreverse (lines client)))))

(defun extract-one-vevent (data)
  (catch 'vevent
    (process-ics (one-vevent) data)))