;; SPDX-FileCopyrightText: 2026 Andrew Oberstar <andrew@ajoberstar.org>
;; SPDX-License-Identifier: AGPL-3.0-only

(in-package #:org.ajoberstar.quixote.db)

(defun read-date (string)
  (if string (dates:parse-iso-date string)))

(defun write-date (date)
  (if date (dates:write-iso-date nil date)))

;;; Core

(defvar *sql-connection* nil)

(defun sql-connect (connect-args)
  (let ((conn (apply #'dbi:connect-cached connect-args)))
    (dbi:execute (dbi:prepare conn "PRAGMA foreign_keys = ON"))
    conn))

(defun sql-disconnect ()
  (dbi:disconnect-cached-all))

(defmacro with-connection ((connect-args) &body body)
  `(let ((*sql-connection* (sql-connect ,connect-args)))
     ,@body))

(defun sql-user-version ()
  (let* ((query (dbi:prepare *sql-connection* "PRAGMA user_version"))
         (results (dbi:execute query)))
    (getf (dbi:fetch results) :|user_version|)))

(defsetf sql-user-version () (value)
  `(progn
     (dbi:execute (dbi:prepare *sql-connection* (format nil "PRAGMA user_version = ~A" ,value)))
     ,value))

(defun sql-reset ()
  (let* ((query (dbi:prepare *sql-connection* "SELECT name FROM sqlite_master WHERE type='table'"))
         (result (dbi:execute query)))
    (loop for row = (dbi:fetch result)
          while row
          do (format t "DROP ~A~%" (getf row :|name|))
          do (let ((drop-query (dbi:prepare *sql-connection* (format nil "DROP TABLE ~A" (getf row :|name|)))))
               (dbi:execute drop-query)))
    (setf (sql-user-version) 0)))

(defparameter sql-migrations
  (vector "CREATE TABLE books(
             id INTEGER PRIMARY KEY,
             created_at TEXT,
             updated_at TEXT,
             title TEXT UNIQUE,
             type TEXT,
             pages INTEGER
           )"
          "CREATE TABLE readthroughs(
             id INTEGER PRIMARY KEY,
             created_at TEXT,
             updated_at TEXT,
             book_id INTEGER,
             started_at TEXT,
             completed_at TEXT,
             FOREIGN KEY(book_id) REFERENCES books(id)
           )"
          "CREATE TABLE readings(
             id INTEGER PRIMARY KEY,
             created_at TEXT,
             updated_at TEXT,
             readthrough_id INTEGER,
             at TEXT,
             page_start INTEGER,
             page_end INTEGER,
             FOREIGN KEY(readthrough_id) REFERENCES readthroughs(id)
           )"
          "ALTER TABLE books
           ADD COLUMN author TEXT"
          "ALTER TABLE books
           ADD COLUMN year INTEGER"
          "ALTER TABLE books
           ADD COLUMN isbn TEXT"
          "ALTER TABLE books
           ADD COLUMN cover BLOB"))

(defun sql-migrate ()
  (loop for v from (sql-user-version) below (length sql-migrations)
        for query = (dbi:prepare *sql-connection* (elt sql-migrations v))
        do (format t "Applying v~D~%" v)
        do (dbi:execute query)
        finally (setf (sql-user-version) v)))

(defun sql-truncate (table)
  ;; UNSAFE from SQL injection
  (let ((query (dbi:prepare *sql-connection* (format nil "DELETE FROM ~A" table))))
    (dbi:execute query)
    (dbi:row-count *sql-connection*)))

(defmacro sql-execute (sql args row-mapper)
  (let ((query (gensym))
        (result (gensym))
        (row-count (gensym))
        (row (gensym))
        (user-result (gensym)))
    `(let* ((,query (dbi:prepare-cached *sql-connection* ,sql))
            (,result (dbi:execute ,query ,args)))
       (loop with ,row-count = (dbi:query-row-count ,query)
             for ,row = (dbi:fetch ,result)
             while ,row
             collect (funcall ,row-mapper ,row) into ,user-result
             finally (return (values ,user-result ,row-count))))))

;;; Books

(defun map-book (row)
  (make-instance 'model:book
                 :id (getf row :|id|)
                 :created-at (read-date (getf row :|created_at|))
                 :updated-at (read-date (getf row :|updated_at|))
                 :title (getf row :|title|)
                 :author (getf row :|author|)
                 :year (getf row :|year|)
                 :type (getf row :|type|)
                 :pages (getf row :|pages|)
                 :isbn (getf row :|isbn|)))

(defun select-books ()
  (sql-execute "SELECT id, created_at, updated_at, title, author, year, type, pages, isbn FROM books ORDER BY title" nil #'map-book))

(defun select-book (id)
  (declare (type integer id))
  (first
   (sql-execute "SELECT id, created_at, updated_at, title, author, year, type, pages, isbn FROM books WHERE id=?" (list id) #'map-book)))

(defun insert-book (book)
  (declare (type model:book book))
  (first
   (sql-execute "INSERT INTO books(created_at, updated_at, title, author, year, type, pages, isbn) VALUES (?, ?, ?, ?, ?, ?, ?, ?) RETURNING id, created_at, updated_at, title, author, year, type, pages, isbn"
                (let ((now (dates:today)))
                  (list (write-date now)
                        (write-date now)
                        (model:book-title book)
                        (model:book-author book)
                        (model:book-year book)
                        (model:book-type book)
                        (model:book-pages book)
                        (model:book-isbn book)))
                #'map-book)))

(defun update-book (book)
  (declare (type model:book book))
  (first
   (sql-execute "UPDATE books SET created_at=?, updated_at=?, title=?, author=?, year=?, type=?, pages=?, isbn=? WHERE id=? RETURNING id, created_at, updated_at, title, author, year, type, pages, isbn"
                (list (write-date (model:entity-created-at book))
                      (write-date (dates:today))
                      (model:book-title book)
                      (model:book-author book)
                      (model:book-year book)
                      (model:book-type book)
                      (model:book-pages book)
                      (model:book-isbn book)
                      (model:entity-id book))
                #'map-book)))

(defun delete-book (book)
  (declare (type model:book book))
  (sql-execute "DELETE FROM books WHERE id=?"
               (list (model:entity-id book))
               nil))

(defun select-book-cover (book-id)
  (declare (type integer book-id))
  (first
   (sql-execute "SELECT cover FROM books WHERE id=?" (list book-id)
                (lambda (row)
                  (getf row :|cover|)))))

(defun update-book-cover (book-id cover)
  (declare (type integer book-id))
  (declare (type (vector (unsigned-byte 8))))
  (sql-execute "UPDATE books SET cover=? WHERE id=?"
               (list cover book-id)
               (lambda (row)
                 (declare (ignore row))
                 nil))
  nil)

(defun delete-book-cover (book-id)
  (declare (type integer book-id))
  (sql-execute "UPDATE books SET cover=NULL WHERE id=?"
               (list book-id)
               (lambda (row)
                 (declare (ignore row))
                 nil))
  nil)

;;; Readthroughs

(defun map-readthrough (row)
  (make-instance 'model:readthrough
                 :id (getf row :|id|)
                 :created-at (read-date (getf row :|created_at|))
                 :updated-at (read-date (getf row :|updated_at|))
                 :book (select-book (getf row :|book_id|))
                 :started-at (read-date (getf row :|started_at|))
                 :completed-at (read-date (getf row :|completed_at|))))

(defun select-readthroughs ()
  (sql-execute "SELECT id, created_at, updated_at, book_id, started_at, completed_at FROM readthroughs ORDER BY completed_at DESC NULLS FIRST, started_at DESC" nil #'map-readthrough))

(defun select-book-readthroughs (book)
  (sql-execute "SELECT id, created_at, updated_at, book_id, started_at, completed_at FROM readthroughs WHERE book_id=? ORDER BY completed_at DESC NULLS FIRST, started_at DESC" (list (model:entity-id book)) #'map-readthrough))

(defun select-active-readthroughs ()
  (sql-execute "SELECT id, created_at, updated_at, book_id, started_at, completed_at FROM readthroughs WHERE completed_at IS NULL ORDER BY completed_at DESC NULLS FIRST, started_at DESC" nil #'map-readthrough))

(defun select-readthrough (id)
  (declare (type integer id))
  (first
   (sql-execute "SELECT id, created_at, updated_at, book_id, started_at, completed_at FROM readthroughs WHERE id=?" (list id) #'map-readthrough)))

(defun insert-readthrough (readthrough)
  (declare (type model:readthrough readthrough))
  (first
   (sql-execute "INSERT INTO readthroughs(created_at, updated_at, book_id, started_at, completed_at) VALUES (?, ?, ?, ?, ?) RETURNING id, created_at, updated_at, book_id, started_at, completed_at"
                (let ((now (dates:today)))
                  (list (write-date now)
                        (write-date now)
                        (model:entity-id (model:readthrough-book readthrough))
                        (write-date (model:readthrough-started-at readthrough))
                        (write-date (model:readthrough-completed-at readthrough))))
                #'map-readthrough)))

(defun update-readthrough (readthrough)
  (declare (type model:readthrough readthrough))
  (first
   (sql-execute "UPDATE readthroughs SET created_at=?, updated_at=?, book_id=?, started_at=?, completed_at=? WHERE id=? RETURNING id, created_at, updated_at, book_id, started_at, completed_at"
                (list (write-date (model:entity-created-at readthrough))
                      (write-date (dates:today))
                      (model:entity-id (model:readthrough-book readthrough))
                      (write-date (model:readthrough-started-at readthrough))
                      (write-date (model:readthrough-completed-at readthrough))
                      (model:entity-id readthrough))
                #'map-readthrough)))

(defun delete-readthrough (readthrough)
  (declare (type model:readthrough readthrough))
  (sql-execute "DELETE FROM readthroughs WHERE id=?"
               (list (model:entity-id readthrough))
               nil))

;;; Readings

(defun map-reading (row)
  (make-instance 'model:reading
                 :id (getf row :|id|)
                 :created-at (read-date (getf row :|created_at|))
                 :updated-at (read-date (getf row :|updated_at|))
                 :readthrough (select-readthrough (getf row :|readthrough_id|))
                 :at (read-date (getf row :|at|))
                 :page-start (getf row :|page_start|)
                 :page-end (getf row :|page_end|)))

(defun select-readings ()
  (sql-execute "SELECT id, created_at, updated_at, readthrough_id, at, page_start, page_end FROM readings ORDER BY at DESC, page_start DESC" nil #'map-reading))

(defun select-readthrough-readings (readthrough)
  (sql-execute "SELECT id, created_at, updated_at, readthrough_id, at, page_start, page_end FROM readings WHERE readthrough_id=? ORDER BY at DESC, page_start DESC" (list (model:entity-id readthrough)) #'map-reading))

(defun select-reading (id)
  (declare (type integer id))
  (first
   (sql-execute "SELECT id, created_at, updated_at, readthrough_id, at, page_start, page_end FROM readings WHERE id=?" (list id) #'map-reading)))

(defun insert-reading (reading)
  (declare (type model:reading reading))
  (first
   (sql-execute "INSERT INTO readings(created_at, updated_at, readthrough_id, at, page_start, page_end) VALUES (?, ?, ?, ?, ?, ?) RETURNING id, created_at, updated_at, readthrough_id, at, page_start, page_end"
                (let ((now (dates:today)))
                  (list (write-date now)
                        (write-date now)
                        (model:entity-id (model:reading-readthrough reading))
                        (write-date (model:reading-at reading))
                        (model:reading-page-start reading)
                        (model:reading-page-end reading)))
                #'map-reading)))

(defun update-reading (reading)
  (declare (type model:reading reading))
  (first
   (sql-execute "UPDATE readings SET created_at=?, updated_at=?, readthrough_id=?, at=?, page_start=?, page_end=? WHERE id=? RETURNING id, created_at, updated_at, readthrough_id, at, page_start, page_end"
                (list (write-date (model:entity-created-at reading))
                      (write-date (dates:today))
                      (model:entity-id (model:reading-readthrough reading))
                      (write-date (model:reading-at reading))
                      (model:reading-page-start reading)
                      (model:reading-page-end reading)
                      (model:entity-id reading))
                #'map-reading)))

(defun delete-reading (reading)
  (declare (type model:reading reading))
  (sql-execute "DELETE FROM readings WHERE id=?"
               (list (model:entity-id reading))
               nil))

;;; Importer

(defun read-csv (path)
  (declare (type pathname path))
  (with-open-file (in path)
    (loop with header = (mapcar (lambda (name) (intern (substitute #\- #\Space (string-upcase name)) :keyword))
                                (uiop:split-string (read-line in) :separator (string #\Tab)))
          for line = (read-line in nil)
          while line
          collect (loop with fields = (uiop:split-string line :separator (string #\Tab))
                        for key in header
                        for value in fields
                        collect (cons key
                                      (case key
                                        ((:week :date)
                                         (dates:parse-us-date value))
                                        ((:current-pages :previous-pages :pages-read)
                                         (parse-integer value))
                                        (t
                                         value)))))))

(defun import-data (path)
  (declare (type pathname path))
  (let* ((csv (read-csv path))
         (by-date (stable-sort csv (lambda (a b)
                                     (dates:date< (cdr (assoc :date a))
                                                  (cdr (assoc :date b))))))
         (by-book (stable-sort by-date (lambda (a b)
                                         (string< (cdr (assoc :book a))
                                                  (cdr (assoc :book b)))))))
    (loop with book = nil
          with readthrough = nil
          for entry in by-book
          unless (string-equal (model:book-title book) (cdr (assoc :book entry)))
            do (progn
                 (if book
                     (update-book book))
                 (setf book (insert-book (model:make-book (cdr (assoc :book entry)) "novel" 0)))
                 (if readthrough
                     (update-readthrough readthrough))
                 (setf readthrough nil))
          if (or (null readthrough) (eq 0 (cdr (assoc :current-pages entry))))
            do (progn
                 (if readthrough
                     (update-readthrough readthrough))
                 (setf readthrough (insert-readthrough (model:make-readthrough book (cdr (assoc :date entry)) nil))))
          do (setf (model:book-pages book)
                   (max (model:book-pages book)
                        (cdr (assoc :current-pages entry))))
          do (if (dates:date< (or (model:readthrough-completed-at readthrough)
                                  dates:minimum-date)
                              (cdr (assoc :date entry)))
                 (setf (model:readthrough-completed-at readthrough)
                       (cdr (assoc :date entry))))
          collect (insert-reading (model:make-reading readthrough
                                                      (cdr (assoc :date entry))
                                                      (cdr (assoc :previous-pages entry))
                                                      (cdr (assoc :current-pages entry)))))))
