(define-module (vcomponent)
  :use-module (util)
  :use-module (util app)
  :use-module (util config)
  :use-module (srfi srfi-1)
  :use-module (srfi srfi-41)
  :use-module (srfi srfi-41 util)
  :use-module (datetime)
  :use-module (vcomponent base)
  :use-module (vcomponent parse)
  :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?))
  :use-module ((vcomponent datetime) :select (ev-time<?))
  :re-export (make-vcomponent
              parse-cal-path parse-calendar))

(re-export-modules (vcomponent base))

(use-modules (sqlite3))

(define db (sqlite-open ":memory:"))

;; (define db (sqlite-open "/home/hugo/cal.db"))

(sqlite-exec db "DROP TABLE IF EXISTS vcomponents")

(sqlite-exec db
 "
CREATE TABLE vcomponents (
  id INTEGER PRIMARY KEY NOT NULL,
  type TEXT NOT NULL,
  repeating INTEGER DEFAULT 0,
  uid TEXT,
  dtstart TEXT,
  dtend TEXT,
  parent INTEGER REFERENCES vcomponents(id)
)
")

(sqlite-exec db "DROP TABLE IF EXISTS instances")

(sqlite-exec
 db
 "
CREATE TABLE instances (
  id INTEGER PRIMARY KEY NOT NULL,
  dtstart TEXT NOT NULL,
  event_id INTEGER REFERENCES vcomponents(id)
)
")

(sqlite-exec db "DROP TABLE IF EXISTS stuff")

(sqlite-exec
 db
 "
CREATE TABLE stuff (
  id INTEGER PRIMARY KEY NOT NULL,
  key TEXT NOT NULL,
  value
)
")

(sqlite-exec db "INSERT INTO stuff (key) VALUES ('max-instance')")

(define (get-events db ht clause . args)
  (apply sqlite-query db (string-append
                    "SELECT uid FROM vcomponents WHERE "
                    clause)
                (lambda (v) (hash-ref ht (vector-ref v 0)))
                args
                ))

;; (sqlite-exec db "BEGIN TRANSACTION")
;; (sqlite-exec db "COMMIT TRANSACTION")

(sqlite-exec db "PRAGMA synchronous=off")

(define* (sqlite-query db str optional: (map identity)
                       key: DUMMY-KEY-DONT-USE #:allow-other-keys
                       rest: keys)
  (let* ((stmt (sqlite-prepare db str)))
    (apply sqlite-bind-arguments stmt keys)
    (let ((return (sqlite-map map stmt)))
      (sqlite-finalize stmt)
      return)))

#;
(define uids
 (sqlite-query db "select uid from vcomponents 
where parent = 1 and 
type = 'VEVENT'"
               (lambda (v) (vector-ref v 0))))

(define* (insert-vcomponent db component optional: parent)
  (define stmt
   (sqlite-prepare db
    "INSERT INTO vcomponents (type, uid, dtstart, dtend, parent, repeating)
VALUES (:type, :uid, :dtstart, :dtend, :parent, :repeating)"))
  (sqlite-bind-arguments
   stmt
   type: (symbol->string (type component))
   uid: (prop component 'UID)
   dtstart: (aif (prop component 'DTSTART)
                 (datetime->string (as-datetime it)
                                   "~Y-~m-~dT~H:~M:~S")
                 #f)
   dtend: (aif (prop component 'DTEND)
               (datetime->string (as-datetime it)
                                 "~Y-~m-~dT~H:~M:~S")
               #f)
   parent: parent
   repeating: (if (repeating? component) 1 0))
  (sqlite-step stmt)
  (sqlite-finalize stmt)

  (unless (null? (children component))
    (let ((id
           (car
            (sqlite-query db "select last_insert_rowid()"
                          (lambda (v) (vector-ref v 0))))))
      (map (lambda (c) (insert-vcomponent db c id))
           (children component)))))

(define-config calendar-files '()
  "Which files to parse. Takes a list of paths or a single string which will be globbed."
  pre: (lambda (v)
         (cond [(list? v) v]
               [(string? v) ((@ (glob) glob) v)]
               [else #f])))

(define-public (load-calendars calendar-files)
  (map parse-cal-path calendar-files))


(define (force-ids component)
  (aif (prop component 'UID)
       (set! (prop component '-X-HNH-UID) it)
       (set! (prop component '-X-HNH-UID) (uuidgen)))
  (for-each force-ids (children component)))

(define (components->hash-map ht components)
  (for-each (lambda (comp)
              (hash-set! ht (prop comp '-X-HNH-UID) comp)
              (components->hash-map ht (children comp)))
            components))

(define-method (init-app calendar-files)
  (define calendars (load-calendars calendar-files))
  (define ht (make-hash-table 512) )

  (setf 'calendars calendars)
  (setf 'uid-map ht)

  (for-each force-ids calendars)
  (for-each (lambda (cal) (insert-vcomponent db cal #f))
            calendars)

  (components->hash-map ht calendars)

  (sqlite-exec db "INSERT INTO instances (dtstart, event_id) 
SELECT dtstart, id FROM vcomponents WHERE type = 'VEVENT' AND repeating = 0")

  (let ((fixed-events
         (get-events db ht "type = 'VEVENT' AND repeating = 0"))

        (repeating-events
         (get-events db ht "type = 'VEVENT' AND repeating = 1")))
    (define recurring-stream (interleave-streams
                              ev-time<? (map generate-recurrence-set repeating-events)))

    (let ((target (date+ (current-date) (date year: 1))))
      (let ((stmt (sqlite-prepare
                   db "UPDATE stuff SET value = :value WHERE key = 'max-instance'")))
        (sqlite-bind-arguments stmt value: (date->string target "~Y-~m-~d"))
        (sqlite-step stmt)
        (sqlite-finalize stmt))
      (stream-for-each
       (lambda (ev)
         (define id (car (sqlite-query db "SELECT id FROM vcomponents WHERE uid = :uid"
                                       (lambda (r) (vector-ref r 0))
                                       uid: (prop ev 'UID))))
         (define stmt (sqlite-prepare
                       db "INSERT INTO instances (dtstart, event_id) VALUES (:dtstart, :id)"
                       cache?: #t))
         (sqlite-bind-arguments
          stmt id: id
          dtstart: (datetime->string (as-datetime (prop ev 'DTSTART)) "~Y-~m-~dT~H:~M:~S"))
         (sqlite-step stmt)
         )
       (stream-take-while (lambda (e) (date< (as-date (prop e 'DTSTART))
                                        target))
                          recurring-stream)))

    (setf 'event-set
          (list
           (interleave-streams
            ev-time<?
            (cons (list->stream fixed-events)
                  (map generate-recurrence-set repeating-events)))))))


(define-method (fixed-events-in-range start end)
  (get-events db (getf 'uid-map)
              "type = 'VEVENT' AND start BETWEEN :start AND :end"
              start: (date->string (as-date start) "~Y-~m-~d")
              end: (date->string (as-date end) "~Y-~m-~d")
              )
  #;
  (filter-sorted (lambda (ev) ((in-date-range? start end)
                          (as-date (prop ev 'DTSTART))))
                 (getf 'fixed-events)))

(define-method (get-event-by-uid uid)
  (hash-ref (getf 'uid-map) uid))




;;; TODO both add- and remove-event sometimes crash with
;;;;; Warning: Unwind-only `stack-overflow' exception; skipping pre-unwind handler.
;;; I belive this is due to how getf and setf work.


;;; TODO what should happen when an event with that UID already exists
;;; in the calendar? Fail? Overwrite? Currently it adds a second element
;;; with the same UID, which is BAD.
(define-public (add-event calendar event)

  (add-child! calendar event)

  (unless (prop event 'UID)
    (set! (prop event 'UID) (uuidgen)))

  (force-ids event)
  (components->hash-map (getf 'uid-map) event)
  (insert-vcomponent db event (prop calendar '-X-HNH-UID))

  (let ((event-set (getf 'event-set)))
    (set! (car event-set)
      (interleave-streams
       ev-time<?
       (list (if (repeating? event)
                 (generate-recurrence-set event)
                 (stream event))
             (car event-set)))))

  (prop event 'UID))


(define-public (remove-event event)

  (let ((event-set (getf 'event-set)))
    (set! (car event-set)
      (stream-remove
       (lambda (ev)
         (equal? (prop ev 'UID)
                 (prop event 'UID)))
       (car event-set))))

  (hash-set! (getf 'uid-map) (prop event '-X-HNH-UID)
             #f))