;; 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)
  (etypecase string
    (string (dates:parse-iso-date string))
    (integer (dates:make-date string 1 1))
    (null nil)))

(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 journal_mode = WAL"))
    (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))

(defmacro with-transaction (&body body)
  `(dbi:with-transaction *sql-connection*
     ,@body))

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

;;; Migrations

(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)))
    (dbi:execute (dbi:prepare *sql-connection* "PRAGMA foreign_keys = OFF"))
    (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)))
    (dbi:execute (dbi:prepare *sql-connection* "PRAGMA foreign_keys = ON"))
    (setf (sql-user-version) 0)))

(defparameter sql-migrations
  (vector "CREATE TABLE authors(
             id INTEGER PRIMARY KEY,
             created_at TEXT NOT NULL,
             updated_at TEXT NOT NULL,
             name TEXT NOT NULL,
             sort_name TEXT,
             birth TEXT,
             death TEXT,
             bookbrainz_author_id TEXT,
             openlibrary_author_id TEXT,
             wikidata_id TEXT
           )"
          "CREATE TABLE editions(
             id INTEGER PRIMARY KEY,
             created_at TEXT NOT NULL,
             updated_at TEXT NOT NULL,
             title TEXT NOT NULL,
             sort_title TEXT,
             disambiguation TEXT,
             author_id INTEGER,
             translator_id INTEGER,
             page_start INTEGER NOT NULL,
             page_end INTEGER NOT NULL,
             type TEXT NOT NULL,
             year TEXT,
             isbn TEXT,
             bookbrainz_edition_id TEXT,
             openlibrary_book_id TEXT,
             wikidata_id TEXT,
             cover BLOB,
             FOREIGN KEY(author_id) REFERENCES authors(id) ON DELETE CASCADE,
             FOREIGN KEY(translator_id) REFERENCES authors(id) ON DELETE CASCADE
           )"
          "CREATE TABLE parts(
             id INTEGER PRIMARY KEY,
             created_at TEXT NOT NULL,
             updated_at TEXT NOT NULL,
             edition_id INTEGER NOT NULL,
             title TEXT,
             sort_title TEXT,
             segment TEXT NOT NULL,
             page_start INTEGER NOT NULL,
             page_end INTEGER NOT NULL,
             bookbrainz_work_id TEXT,
             openlibrary_work_id TEXT,
             wikidata_id TEXT,
             FOREIGN KEY(edition_id) REFERENCES editions(id) ON DELETE CASCADE
           )"
          "CREATE TABLE collections(
             id INTEGER PRIMARY KEY,
             created_at TEXT NOT NULL,
             updated_at TEXT NOT NULL,
             title TEXT NOT NULL,
             type TEXT NOT NULL
           )"
          "CREATE TABLE collection_items(
             id INTEGER PRIMARY KEY,
             created_at TEXT NOT NULL,
             updated_at TEXT NOT NULL,
             collection_id INTEGER NOT NULL,
             position INTEGER,
             part_id INTEGER,
             subcollection_id INTEGER,
             FOREIGN KEY(collection_id) REFERENCES collections(id) ON DELETE CASCADE,
             FOREIGN KEY(part_id) REFERENCES parts(id) ON DELETE CASCADE,
             FOREIGN KEY(subcollection_id) REFERENCES collections(id) ON DELETE CASCADE,
             UNIQUE(collection_id, position),
             CHECK((part_id IS NOT NULL) + (subcollection_id IS NOT NULL) = 1)
           )"
          "CREATE TABLE readthroughs(
             id INTEGER PRIMARY KEY,
             created_at TEXT NOT NULL,
             updated_at TEXT NOT NULL,
             collection_id INTEGER NOT NULL,
             started_at TEXT,
             ended_at TEXT,
             status TEXT NOT NULL,
             FOREIGN KEY(collection_id) REFERENCES collections(id) ON DELETE CASCADE
           )"
          "CREATE TABLE readings(
             id INTEGER PRIMARY KEY,
             created_at TEXT NOT NULL,
             updated_at TEXT NOT NULL,
             readthrough_id INTEGER,
             part_id INTEGER NOT NULL,
             started_at TEXT,
             ended_at TEXT,
             status TEXT NOT NULL,
             FOREIGN KEY(readthrough_id) REFERENCES readthroughs(id) ON DELETE SET NULL,
             FOREIGN KEY(part_id) REFERENCES parts(id) ON DELETE CASCADE
           )"
           "CREATE TABLE sessions(
              id INTEGER PRIMARY KEY,
              created_at TEXT NOT NULL,
              updated_at TEXT NOT NULL,
              reading_id INTEGER NOT NULL,
              at TEXT NOT NULL,
              page_start INTEGER NOT NULL,
              page_end INTEGER NOT NULL,
              FOREIGN KEY(reading_id) REFERENCES readings(id) ON DELETE CASCADE
            )"
           "CREATE INDEX idx_editions_author_id ON editions(author_id)"
           "CREATE INDEX idx_editions_translator_id ON editions(translator_id)"
           "CREATE INDEX idx_editions_sort_title ON editions(sort_title, title)"
           "CREATE INDEX idx_parts_edition_id ON parts(edition_id)"
           "CREATE INDEX idx_collection_items_part_id ON collection_items(part_id)"
           "CREATE INDEX idx_collection_items_subcollection_id ON collection_items(subcollection_id)"
           "CREATE INDEX idx_readthroughs_collection_id ON readthroughs(collection_id)"
           "CREATE INDEX idx_readings_readthrough_id ON readings(readthrough_id)"
           "CREATE INDEX idx_readings_part_id ON readings(part_id)"
           "CREATE INDEX idx_sessions_reading_id_at ON sessions(reading_id, at)"
           "CREATE INDEX idx_sessions_at ON sessions(at)"
           'migrate-covers
           'migrate-sort-names-titles
           "UPDATE editions SET cover=NULL"
           "VACUUM"))

(defun migrate-covers ()
  (loop for (id . cover-bytes) in (select-edition-covers)
        for cover = (covers:make-cover id)
        unless (covers:cover-exists-p cover)
          do (progn
               (covers:ensure-cover-empty cover)
               (with-open-file (out (covers:cover-path cover :front t)
                                    :direction :output
                                    :element-type '(unsigned-byte 8)
                                    :if-exists :supersede)
                 (write-sequence cover-bytes out))
               (format t "Migrated cover for edition ~D~%" id))))

(defun migrate-sort-names-titles ()
  (let ((*sneaky-update* t))
    (dolist (author (select-authors))
      (update-author author))
    (format t "Migrated author sort names~%")
    (dolist (edition (select-editions))
      (update-edition edition))
    (format t "Migrated edition sort titles~%")
    (dolist (part (select-parts))
      (update-part part))
    (format t "Migrated part sort titles~%")))

(defun sql-migrate ()
  (loop for v from (sql-user-version) below (length sql-migrations)
        for migration = (elt sql-migrations v)
        do (format t "Applying v~D~%" v)
        do (etypecase migration
             (string (dbi:execute
                      (dbi:prepare *sql-connection* migration)))
             (symbol (funcall migration)))
        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*)))

;;; SQL Helpers

(defparameter +author-columns+ (list "id" "created_at" "updated_at" "name" "sort_name" "birth" "death" "bookbrainz_author_id" "openlibrary_author_id" "wikidata_id"))
(defparameter +edition-columns+ (list "id" "created_at" "updated_at" "title" "sort_title" "disambiguation" "author_id" "translator_id" "page_start" "page_end" "type" "year" "isbn" "bookbrainz_edition_id" "openlibrary_book_id" "wikidata_id"))
(defparameter +part-columns+ (list "id" "created_at" "updated_at" "edition_id" "title" "sort_title" "segment" "page_start" "page_end" "bookbrainz_work_id" "openlibrary_work_id" "wikidata_id"))
(defparameter +collection-columns+ (list "id" "created_at" "updated_at" "title" "type"))
(defparameter +collection-item-columns+ (list "id" "created_at" "updated_at" "collection_id" "position" "part_id" "subcollection_id"))
(defparameter +readthrough-columns+ (list "id" "created_at" "updated_at" "collection_id" "started_at" "ended_at" "status"))
(defparameter +reading-columns+ (list "id" "created_at" "updated_at" "readthrough_id" "part_id" "started_at" "ended_at" "status"))
(defparameter +session-columns+ (list "id" "created_at" "updated_at" "reading_id" "at" "page_start" "page_end"))


(defmacro with-row-prefix ((row prefix) f &body body)
  `(macrolet ((,f (name)
                `(getf ,',row (intern (format nil "~A~A" ,',prefix ,name) :keyword))))
     ,@body))

(defun select-columns (table alias columns)
  (format nil "~{~A~^, ~}"
          (loop for column in columns
                collect (format nil "~A.~A AS ~A~A" table column alias column))))

(defmacro insert ((table columns entity) now &body values)
  (alexandria:with-gensyms (cols id i row)
    `(let* ((,cols (remove "id" ,columns :test #'equalp))
            (,now (dates:today))
            (,id (first
                  (sql-execute (format nil "INSERT INTO ~A(~{~A~^, ~}) VALUES(~{~A~^, ~}) RETURNING id"
                                       ,table
                                       ,cols
                                       (loop for ,i from 1 to (length ,cols)
                                             collect "?"))
                               (list ,@values)
                               (lambda (,row) (getf ,row :|id|))))))
       (setf (model:entity-id ,entity) ,id)
       (setf (model:entity-created-at ,entity) ,now)
       (setf (model:entity-updated-at ,entity) ,now)
       ,entity)))

(defparameter *sneaky-update* nil)

(defmacro update ((table columns entity) now &body values)
  (alexandria:with-gensyms (cols vals col row updated-pos)
    `(let* ((,cols (remove "created_at"
                           (remove "id" ,columns :test #'equalp)
                           :test #'equalp))
            (,now (dates:today))
            (,vals (list ,@values)))
       (when *sneaky-update*
         (let ((,updated-pos (position "updated_at" ,cols :test #'string-equal)))
           (when ,updated-pos
             (setf ,cols (remove-if (constantly t) ,cols :start ,updated-pos :count 1))
             (setf ,vals (remove-if (constantly t) ,vals :start ,updated-pos :count 1)))))
       (sql-execute (format nil "UPDATE ~A SET ~{~A~^, ~} WHERE id=?"
                            ,table
                            (loop for ,col in ,cols
                                  collect (format nil "~A=?" ,col)))
                    ,vals
                    (lambda (,row) (getf ,row :|id|)))
       (unless *sneaky-update*
         (setf (model:entity-updated-at ,entity) ,now))
       ,entity)))

(defun %paging-clause (limit offset)
  (if (< 0 limit)
      (format nil "LIMIT ~D OFFSET ~D" limit offset)
      ""))

(defun %search-clause (terms fields bares flags)
  (labels ((escape-like (value)
             (with-output-to-string (out)
               (loop for c across value
                     when (member c '(#\\ #\% #\_))
                       do (write-char #\\ out)
                     do (write-char c out))))
           (like-fragment (col)
             (format nil "~A LIKE '%' || ? || '%' ESCAPE '\\'" col))
           (bare-clause (term)
             (loop for col in bares
                   collect (like-fragment col) into clauses
                   collect (escape-like (second term)) into args
                   finally (return (cons (format nil "(~{~A~^ OR ~})" clauses)
                                         args))))
           (field-clause (term)
             (let* ((field (second term))
                    (value (third term))
                    (col (cdr (assoc field fields :test #'string-equal))))
               (when (and col value (< 0 (length value)))
                 (cons (like-fragment col)
                       (list (escape-like value))))))
           (flag-clause (term)
             (let* ((flag-name (second term)))
               (cons (cdr (assoc flag-name flags :test #'string-equal))
                     nil))))
    (loop for term in terms
          for (term-clause . term-args) = (ecase (first term)
                                            (:bare (bare-clause term))
                                            (:field (field-clause term))
                                            (:flag (flag-clause term)))
          when term-clause
            collect term-clause into clauses
            and append term-args into args
          finally (return (values (format nil "~@[(~{~A~^ AND ~})~]" clauses)
                                  args)))))

(defmacro search ((clause values) (terms &key fields bares flags) &body body)
  `(multiple-value-bind (,clause ,values)
       (if (null ,terms)
           (values "1=1" nil)
           (%search-clause ,terms ,fields ,bares ,flags))
     (when (< 0 (length ,clause))
       ,@body)))

;;; Authors

(defun map-author (row &optional (prefix ""))
  (with-row-prefix (row prefix) field
    (when (field "id")
      (make-instance 'model:author
                     :id (field "id")
                     :created-at (read-date (field "created_at"))
                     :updated-at (read-date (field "updated_at"))
                     :name (field "name")
                     :sort-name (field "sort_name")
                     :birth (read-date (field "birth"))
                     :death (read-date (field "death"))
                     :bookbrainz-id (field "bookbrainz_author_id")
                     :openlibrary-id (field "openlibrary_author_id")
                     :wikidata-id (field "wikidata_id")))))

(defun %select-authors (filter order paging values)
  (sql-execute (format nil "SELECT ~A
                            FROM authors a
                            ~A
                            ~A
                            ~A"
                       (select-columns "a" "" +author-columns+)
                       filter
                       order
                       paging)
               values
               #'map-author))

(defun select-authors ()
  (%select-authors "" "ORDER BY LOWER(a.sort_name), LOWER(a.name)" "" nil))

(defun select-author (id)
  (first
   (%select-authors "WHERE a.id=?" "" ""
                    (list id))))

(defun search-authors (terms &key (limit 0) (offset 0))
  (search (clause values)
      (terms :fields '(("author" . "a.name")
                       ("name" . "a.name")
                       ("olid" . "a.openlibrary_author_id"))
             :bares '("a.name" "a.sort_name"))
    (%select-authors (format nil "WHERE ~A" clause)
                     "ORDER BY LOWER(a.sort_name), LOWER(a.name)"
                     (%paging-clause limit offset)
                     values)))

(defun insert-author (author)
  (declare (type model:author author))
  (insert ("authors" +author-columns+ author) now
    (write-date now)
    (write-date now)
    (model:author-name author)
    (model:author-sort-name author)
    (write-date (model:author-birth author))
    (write-date (model:author-death author))
    (model:author-bookbrainz-id author)
    (model:author-openlibrary-id author)
    (model:author-wikidata-id author)))

(defun update-author (author)
  (declare (type model:author author))
  (update ("authors" +author-columns+ author) now
    (write-date now)
    (model:author-name author)
    (model:author-sort-name author)
    (write-date (model:author-birth author))
    (write-date (model:author-death author))
    (model:author-bookbrainz-id author)
    (model:author-openlibrary-id author)
    (model:author-wikidata-id author)
    (model:author-id author)))

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

;;; Editions

(defun map-edition (row prefix author-prefix translator-prefix)
  (with-row-prefix (row prefix) field
    (when (field "id")
      (make-instance 'model:edition
                     :id (field "id")
                     :created-at (read-date (field "created_at"))
                     :updated-at (read-date (field "updated_at"))
                     :title (field "title")
                     :sort-title (field "sort_title")
                     :disambiguation (field "disambiguation")
                     :author (when (field "author_id")
                               (map-author row author-prefix))
                     :translator (when (field "translator_id")
                                   (map-author row translator-prefix))
                     :page-start (field "page_start")
                     :page-end (field "page_end")
                     :type (field "type")
                     :year (read-date (field "year"))
                     :isbn (field "isbn")
                     :bookbrainz-id (field "bookbrainz_edition_id")
                     :openlibrary-id (field "openlibrary_book_id")
                     :wikidata-id (field "wikidata_id")))))

(defun %select-editions (filter order paging values)
  (sql-execute (format nil "SELECT ~A, ~A, ~A
                            FROM editions e
                            LEFT JOIN authors a ON a.id=e.author_id
                            LEFT JOIN authors t ON t.id=e.translator_id
                            ~A
                            ~A
                            ~A"
                       (select-columns "e" "" +edition-columns+)
                       (select-columns "a" "a_" +author-columns+)
                       (select-columns "t" "t_" +author-columns+)
                       filter
                       order
                       paging)
               values
               (lambda (row) (map-edition row "" "a_" "t_"))))

(defun select-editions (&key (limit 0)  (offset 0))
  (%select-editions ""
                    "ORDER BY LOWER(e.sort_title), LOWER(e.title)"
                    (%paging-clause limit offset)
                    nil))

(defun select-recent-editions (&key (since-days 7) (limit 10))
  (%select-editions "WHERE e.updated_at >= date('now', ?)"
                    "ORDER BY e.updated_at DESC, e.id DESC"
                    (%paging-clause limit 0)
                    (list (format nil "-~D days" since-days))))

(defun select-author-editions (author)
  (declare (type model:author author))
  (%select-editions "WHERE author_id=? OR translator_id=?"
                    "ORDER BY year, LOWER(e.sort_title), LOWER(e.title)"
                    ""
                    (list (model:author-id author)
                          (model:author-id author))))

(defun select-edition (id)
  (declare (type integer id))
  (first
   (%select-editions "WHERE e.id=?" "" ""
                     (list id))))

(defun search-editions (terms &key (limit 0) (offset 0))
  (search (clause values)
      (terms
       :fields '(("title" . "e.title")
                 ("edition" . "e.title")
                 ("disambiguation" . "e.disambiguation")
                 ("author" . "a.name")
                 ("translator" . "t.name")
                 ("isbn" . "e.isbn")
                 ("year" . "e.year")
                 ("type" . "e.type")
                 ("olid" . "e.openlibrary_book_id"))
       :bares '("e.title" "e.sort_title"
                "e.disambiguation"
                "a.name" "a.sort_name"
                "t.name" "t.sort_name"))
    (%select-editions (format nil "WHERE ~A" clause)
                      "ORDER BY LOWER(e.sort_title), LOWER(e.title)"
                      (%paging-clause limit offset)
                      values)))

(defun insert-edition (edition)
  (declare (type model:edition edition))
  (insert ("editions" +edition-columns+ edition) now
    (write-date now)
    (write-date now)
    (model:edition-title edition)
    (model:edition-sort-title edition)
    (model:edition-disambiguation edition)
    (when (model:edition-author edition)
      (model:author-id (model:edition-author edition)))
    (when (model:edition-translator edition)
      (model:author-id (model:edition-translator edition)))
    (model:edition-page-start edition)
    (model:edition-page-end edition)
    (model:edition-type edition)
    (write-date (model:edition-year edition))
    (model:edition-isbn edition)
    (model:edition-bookbrainz-id edition)
    (model:edition-openlibrary-id edition)
    (model:edition-wikidata-id edition)))

(defun update-edition (edition)
  (declare (type model:edition edition))
  (update ("editions" +edition-columns+ edition) now
    (write-date now)
    (model:edition-title edition)
    (model:edition-sort-title edition)
    (model:edition-disambiguation edition)
    (when (model:edition-author edition)
      (model:author-id (model:edition-author edition)))
    (when (model:edition-translator edition)
      (model:author-id (model:edition-translator edition)))
    (model:edition-page-start edition)
    (model:edition-page-end edition)
    (model:edition-type edition)
    (write-date (model:edition-year edition))
    (model:edition-isbn edition)
    (model:edition-bookbrainz-id edition)
    (model:edition-openlibrary-id edition)
    (model:edition-wikidata-id edition)
    (model:edition-id edition)))

(defun delete-edition (edition)
  (declare (type model:edition edition))
  (sql-execute "DELETE FROM editions WHERE id=?"
               (list (model:edition-id edition))
               nil)
  (covers:delete-cover
   (covers:make-cover (model:edition-id edition))))

(defun select-edition-covers ()
  (sql-execute "SELECT id, cover FROM editions WHERE cover IS NOT NULL"
               nil
                (lambda (row)
                  (cons (getf row :|id|) (getf row :|cover|)))))

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

(defun update-edition-cover (edition-id cover)
  (declare (type integer edition-id))
  (declare (type (vector (unsigned-byte 8)) cover))
  (sql-execute "UPDATE editions SET cover=?, updated_at=? WHERE id=?"
               (list cover (write-date (dates:today)) edition-id)
               (lambda (row)
                 (declare (ignore row))
                 nil))
  nil)

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

;;; Parts

(defun map-part (row prefix edition-prefix author-prefix translator-prefix)
  (with-row-prefix (row prefix) field
    (when (field "id")
      (make-instance 'model:part
                     :id (field "id")
                     :created-at (read-date (field "created_at"))
                     :updated-at (read-date (field "updated_at"))
                     :edition (map-edition row edition-prefix author-prefix translator-prefix)
                     :title (field "title")
                     :sort-title (field "sort_title")
                     :segment (field "segment")
                     :page-start (field "page_start")
                     :page-end (field "page_end")
                     :bookbrainz-id (field "bookbrainz_work_id")
                     :openlibrary-id (field "openlibrary_work_id")
                     :wikidata-id (field "wikidata_id")))))

(defun %select-parts (filter order paging values)
  (sql-execute (format nil "SELECT ~A, ~A, ~A, ~A
                            FROM parts p
                            JOIN editions e ON p.edition_id=e.id
                            LEFT JOIN authors a ON e.author_id=a.id
                            LEFT JOIN authors t ON e.translator_id=t.id
                            ~A
                            ~A
                            ~A"
                       (select-columns "p" "" +part-columns+)
                       (select-columns "e" "e_" +edition-columns+)
                       (select-columns "a" "a_" +author-columns+)
                       (select-columns "t" "t_" +author-columns+)
                       filter
                       order
                       paging)
               values
               (lambda (row) (map-part row "" "e_" "a_" "t_"))))

(defun select-parts (&key type)
  (%select-parts (if type "WHERE e.type=?" "")
                 "ORDER BY LOWER(e.sort_title), LOWER(e.title), LOWER(p.sort_title), LOWER(p.title)"
                 ""
                 (if type (list type) nil)))

(defun select-orphan-parts (&key type)
  (%select-parts (format nil "WHERE NOT EXISTS (SELECT 1 FROM collection_items ci WHERE ci.part_id=p.id)~A"
                         (if type
                             "AND e.type=?"
                             ""))
                 "ORDER BY LOWER(e.sort_title), LOWER(e.title), LOWER(p.sort_title), LOWER(p.title)"
                 ""
                 (if type (list type) nil)))

(defun select-edition-parts (edition)
  (declare (type model:edition edition))
  (%select-parts "WHERE p.edition_id=?"
                 "ORDER BY segment DESC, page_start, page_end"
                 ""
                 (list (model:edition-id edition))))

(defun select-part (id)
  (declare (type integer id))
  (first
   (%select-parts "WHERE p.id=?" "" ""
                  (list id))))

(defun search-parts (terms &key (limit 0) (offset 0))
  (search (clause values)
      (terms
       :fields '(("title" . "p.title")
                 ("edition" . "e.title")
                 ("disambiguation" . "e.disambiguation")
                 ("author" . "a.name")
                 ("translator" . "t.name")
                 ("isbn" . "e.isbn")
                 ("year" . "e.year")
                 ("type" . "e.type")
                 ("olid" . "e.openlibrary_work_id"))
       :bares '("p.title" "p.sort_title"
                "e.title" "e.sort_title"
                "e.disambiguation"
                "a.name" "a.sort_name"
                "t.name" "t.sort_name")
       :flags '(("orphan" . "NOT EXISTS (SELECT 1 FROM collection_items ci WHERE ci.part_id=p.id)")))
    (%select-parts (format nil "WHERE ~A" clause)
                    "ORDER BY LOWER(p.sort_title), LOWER(p.title), LOWER(e.sort_title), LOWER(e.title)"
                   (%paging-clause limit offset)
                   values)))

(defun insert-part (part)
  (declare (type model:part part))
  (insert ("parts" +part-columns+ part) now
    (write-date now)
    (write-date now)
    (model:entity-id (model:part-edition part))
    (model:part-title part)
    (model:part-sort-title part)
    (model:part-segment part)
    (model:part-page-start part)
    (model:part-page-end part)
    (model:part-bookbrainz-id part)
    (model:part-openlibrary-id part)
    (model:part-wikidata-id part)))

(defun update-part (part)
  (declare (type model:part part))
  (update ("parts" +part-columns+ part) now
    (write-date now)
    (model:entity-id (model:part-edition part))
    (model:part-title part)
    (model:part-sort-title part)
    (model:part-segment part)
    (model:part-page-start part)
    (model:part-page-end part)
    (model:part-bookbrainz-id part)
    (model:part-openlibrary-id part)
    (model:part-wikidata-id part)
    (model:part-id part)))

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

;;; Collections

(defun map-collection-item (row prefix collection-prefix part-prefix edition-prefix author-prefix translator-prefix subcollection-prefix)
  (with-row-prefix (row prefix) field
    (when (field "id")
      (make-instance 'model:item
                     :id (field "id")
                     :created-at (read-date (field "created_at"))
                     :updated-at (read-date (field "updated_at"))
                     :collection (map-collection row collection-prefix)
                     :position (field "position")
                     :item (cond
                             ((field "part_id")
                              (map-part row part-prefix edition-prefix author-prefix translator-prefix))
                             ((field "subcollection_id")
                              (map-collection row subcollection-prefix)))))))

(defun %select-collection-items (filter order values)
  (sql-execute (format nil "SELECT ~A, ~A, ~A, ~A, ~A, ~A, ~A
                            FROM collection_items ci
                            JOIN collections c ON ci.collection_id=c.id
                            LEFT OUTER JOIN parts p ON ci.part_id=p.id
                            LEFT OUTER JOIN editions e ON p.edition_id=e.id
                            LEFT OUTER JOIN authors a ON e.author_id=a.id
                            LEFT OUTER JOIN authors t ON e.translator_id=t.id
                            LEFT OUTER JOIN collections s ON ci.subcollection_id=s.id
                            ~A
                            ~A"
                       (select-columns "ci" "" +collection-item-columns+)
                       (select-columns "c" "c_" +collection-columns+)
                       (select-columns "p" "p_" +part-columns+)
                       (select-columns "e" "e_" +edition-columns+)
                       (select-columns "a" "a_" +author-columns+)
                       (select-columns "t" "t_" +author-columns+)
                       (select-columns "s" "s_" +collection-columns+)
                       filter
                       order)
               values
               (lambda (row) (map-collection-item row "" "c_" "p_" "e_" "a_" "t_" "s_"))))

(defun select-collection-items (collection-id)
  (%select-collection-items "WHERE ci.collection_id=?"
                            "ORDER BY position NULLS LAST"
                            (list collection-id)))

(defun select-content-items (content)
  (%select-collection-items (format nil "WHERE ~A=?"
                                    (etypecase content
                                      (model:collection
                                       "subcollection_id")
                                      (model:part
                                       "part_id")))
                            ""
                            (list (model:entity-id content))))

(defun select-collection-item (id)
  (first
   (%select-collection-items "WHERE ci.id=?"
                             ""
                             (list id))))

(defun insert-collection-item (item)
  (insert ("collection_items" +collection-item-columns+ item) now
    (write-date now)
    (write-date now)
    (model:collection-id (model:item-collection item))
    (model:item-position item)
    (model:part-id item)
    (model:collection-id item)))

(defun update-collection-item (item)
  (update ("collection_items" +collection-item-columns+ item) now
    (write-date now)
    (model:collection-id (model:item-collection item))
    (model:item-position item)
    (model:part-id item)
    (model:collection-id item)
    (model:item-id item)))

(defun delete-collection-item (item)
  (sql-execute "DELETE FROM collection_items WHERE id=?"
               (list (model:item-id item))
               nil))

(defun map-collection (row &optional (prefix ""))
  (with-row-prefix (row prefix) field
    (when (field "id")
      (make-instance 'model:collection
                     :id (field "id")
                     :created-at (read-date (field "created_at"))
                     :updated-at (read-date (field "updated_at"))
                     :title (field "title")
                     :type (field "type")))))

(defun %select-collections (filter order paging values)
  (sql-execute (format nil "SELECT ~A
                            FROM collections c
                            ~A
                            ~A
                            ~A"
                       (select-columns "c" "" +collection-columns+)
                       filter
                       order
                       paging)
               values
               #'map-collection))

(defun select-collections ()
  (%select-collections "" "ORDER BY LOWER(title)" "" nil))

(defun select-root-collections ()
  (%select-collections "WHERE NOT EXISTS (SELECT 1 FROM collection_items ci WHERE ci.subcollection_id=c.id)"
                       "ORDER BY LOWER(title)"
                       ""
                       nil))

(defun select-collection (id)
  (first
   (%select-collections "WHERE c.id=?" "" "" (list id))))

(defun search-collections (terms &key (limit 0) (offset 0))
  (search (clause values)
      (terms
       :fields '(("title" . "c.title")
                 ("collection" . "c.title")
                 ("type" . "c.type"))
       :bares '("c.title"))
    (%select-collections (format nil "WHERE ~A" clause)
                         "ORDER BY LOWER(title)"
                         (%paging-clause limit offset)
                         values)))

(defun insert-collection (collection)
  (insert ("collections" +collection-columns+ collection) now
    (write-date now)
    (write-date now)
    (model:collection-title collection)
    (model:collection-type collection)))

(defun update-collection (collection)
  (update ("collections" +collection-columns+ collection) now
    (write-date now)
    (model:collection-title collection)
    (model:collection-type collection)
    (model:collection-id collection)))

(defun delete-collection (collection)
  (sql-execute "DELETE FROM collections WHERE id=?"
               (list (model:collection-id collection))
               nil))

(defun select-collection-tree (node)
  (let ((collection (etypecase node
                      (model:collection
                       node)
                      (model:item
                       (model:item-item node))))
        (item (etypecase node
                (model:collection
                 (first (select-content-items node)))
                (model:item
                 node))))
    (model:make-tree :collection collection
                     :item item
                     :children (loop for item in (select-collection-items (model:collection-id collection))
                                     collect (etypecase (model:item-item item)
                                               (model:collection
                                                (select-collection-tree item))
                                               (model:part
                                                item))))))

(defun select-collection-breadcrumbs (content)
  (loop for item in (select-content-items content)
        append (sql-execute "WITH RECURSIVE
                               start AS (
                                 SELECT COALESCE(subcollection_id, collection_id) as start_id
                                 FROM collection_items
                                 WHERE id=?
                               ),
                               paths AS (
                                 SELECT json_array(c.id) AS path, c.id AS node_id, 1 AS depth
                                 FROM start s
                                 JOIN collections c ON c.id=s.start_id
                                 UNION ALL
                                 SELECT json_insert(paths.path, '$[#]', p.id), p.id, paths.depth + 1
                                 FROM paths
                                 JOIN collection_items pi ON pi.subcollection_id=paths.node_id
                                 JOIN collections p ON p.id=pi.collection_id
                                 WHERE NOT EXISTS (
                                   SELECT 1 FROM json_each(paths.path) WHERE value=p.id
                                 )
                                 AND paths.depth < 50
                               )
                               SELECT path
                               FROM paths
                               WHERE NOT EXISTS (
                                 SELECT 1 FROM collection_items ci WHERE ci.subcollection_id=paths.node_id
                               );"
                            (list (model:item-id item))
                            (lambda (row)
                              (list :path (loop for id across (jzon:parse (getf row :|path|))
                                                collect (select-collection id))
                                    :item item)))))

;;; Readthroughs

(defun map-readthrough (row prefix collection-prefix)
  (with-row-prefix (row prefix) field
    (when (field "id")
      (make-instance 'model:readthrough
                     :id (field "id")
                     :created-at (read-date (field "created_at"))
                     :updated-at (read-date (field "updated_at"))
                     :collection (map-collection row collection-prefix)
                     :started-at (read-date (field "started_at"))
                     :ended-at (read-date (field "ended_at"))
                     :status (field "status")))))

(defun %select-readthroughs (filter order values)
  (sql-execute (format nil "SELECT ~A, ~A
                            FROM readthroughs r
                            JOIN collections c ON r.collection_id=c.id
                            ~A
                            ~A"
                       (select-columns "r" "" +readthrough-columns+)
                       (select-columns "c" "c_" +collection-columns+)
                       filter
                       order)
               values
               (lambda (row) (map-readthrough row "" "c_"))))

(defun select-readthroughs ()
  (%select-readthroughs "" "ORDER BY started_at DESC NULLS FIRST" nil))

(defun select-active-readthroughs ()
  (%select-readthroughs "WHERE r.status IN ('not-started', 'in-progress')"
                        "ORDER BY started_at DESC NULLS FIRST"
                        nil))

(defun select-collection-readthroughs (collection)
  (%select-readthroughs "WHERE r.collection_id=?"
                        "ORDER BY started_at DESC NULLS FIRST, ended_at DESC"
                        (list (model:collection-id collection))))

(defun select-readthrough (id)
  (first
   (%select-readthroughs "WHERE r.id=?" "" (list id))))

(defun insert-readthrough (readthrough)
  (insert ("readthroughs" +readthrough-columns+ readthrough) now
    (write-date now)
    (write-date now)
    (model:collection-id (model:readthrough-collection readthrough))
    (write-date (model:readthrough-started-at readthrough))
    (write-date (model:readthrough-ended-at readthrough))
    (model:readthrough-status readthrough)))

(defun update-readthrough (readthrough)
  (update ("readthroughs" +readthrough-columns+ readthrough) now
    (write-date now)
    (model:collection-id (model:readthrough-collection readthrough))
    (write-date (model:readthrough-started-at readthrough))
    (write-date (model:readthrough-ended-at readthrough))
    (model:readthrough-status readthrough)
    (model:readthrough-id readthrough)))

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

;;; Readings

(defun map-reading (row prefix readthrough-prefix collection-prefix part-prefix edition-prefix author-prefix translator-prefix)
  (with-row-prefix (row prefix) field
    (when (field "id")
      (make-instance 'model:reading
                     :id (field "id")
                     :created-at (read-date (field "created_at"))
                     :updated-at (read-date (field "updated_at"))
                     :readthrough (map-readthrough row readthrough-prefix collection-prefix)
                     :part (map-part row part-prefix edition-prefix author-prefix translator-prefix)
                     :started-at (read-date (field "started_at"))
                     :ended-at (read-date (field "ended_at"))
                     :status (field "status")))))

(defun %select-readings (filter order paging values)
  (sql-execute (format nil "SELECT ~A, ~A, ~A, ~A, ~A, ~A, ~A
                            FROM readings r
                            LEFT JOIN readthroughs rt ON r.readthrough_id=rt.id
                            LEFT JOIN collections c ON rt.collection_id=c.id
                            JOIN parts p ON r.part_id=p.id
                            JOIN editions e ON p.edition_id=e.id
                            LEFT JOIN authors a ON e.author_id=a.id
                            LEFT JOIN authors t ON e.translator_id=t.id
                            LEFT JOIN (SELECT reading_id, MAX(at) AS at FROM sessions GROUP BY reading_id) latest_session ON latest_session.reading_id=r.id
                            ~A
                            ~A
                            ~A"
                       (select-columns "r" "" +reading-columns+)
                       (select-columns "rt" "rt_" +readthrough-columns+)
                       (select-columns "c" "c_" +collection-columns+)
                       (select-columns "p" "p_" +part-columns+)
                       (select-columns "e" "e_" +edition-columns+)
                       (select-columns "a" "a_" +author-columns+)
                       (select-columns "t" "t_" +author-columns+)
                       filter
                       order
                       paging)
               values
               (lambda (row) (map-reading row "" "rt_" "c_" "p_" "e_" "a_" "t_"))))

(defun select-readings (&key (limit 0) (offset 0))
  (%select-readings ""
                    "ORDER BY ended_at DESC NULLS FIRST, started_at DESC"
                    (%paging-clause limit offset)
                    nil))

(defun select-readthrough-readings (readthrough)
  (%select-readings "WHERE r.readthrough_id=?"
                    "ORDER BY ended_at DESC NULLS FIRST, started_at DESC"
                    ""
                    (list (model:readthrough-id readthrough))))

(defun select-edition-readings (edition)
  (%select-readings "WHERE e.id=?"
                    "ORDER BY ended_at DESC NULLS FIRST, started_at DESC"
                    ""
                    (list (model:edition-id edition))))

(defun select-part-readings (part)
  (%select-readings "WHERE p.id=?"
                    "ORDER BY ended_at DESC NULLS FIRST, started_at DESC"
                    ""
                    (list (model:part-id part))))

(defun select-part-orphan-readings (part)
  (%select-readings "WHERE p.id=? AND r.readthrough_id IS NULL"
                    "ORDER BY ended_at DESC NULLS FIRST, started_at DESC"
                    ""
                    (list (model:part-id part))))

(defun select-active-readings ()
  (%select-readings "WHERE r.status IN ('not-started', 'in-progress')"
                    "ORDER BY latest_session.at DESC NULLS FIRST"
                    ""
                    nil))

(defun select-active-parts-readings (part-ids)
  (%select-readings (format nil "WHERE r.status IN ('not-started', 'in-progress') AND p.id IN (~{~D~^, ~})" part-ids)
                    "ORDER BY ended_at DESC NULLS FIRST, started_at DESC"
                    ""
                    nil))

(defun select-reading (id)
  (first
   (%select-readings "WHERE r.id=?" "" "" (list id))))

(defun insert-reading (reading)
  (insert ("readings" +reading-columns+ reading) now
    (write-date now)
    (write-date now)
    (model:readthrough-id (model:reading-readthrough reading))
    (model:part-id (model:reading-part reading))
    (write-date (model:reading-started-at reading))
    (write-date (model:reading-ended-at reading))
    (model:reading-status reading)))

(defun update-reading (reading)
  (update ("readings" +reading-columns+ reading) now
    (write-date now)
    (model:readthrough-id (model:reading-readthrough reading))
    (model:part-id (model:reading-part reading))
    (write-date (model:reading-started-at reading))
    (write-date (model:reading-ended-at reading))
    (model:reading-status reading)
    (model:reading-id reading)))

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

;;; Sessions

(defun map-session (row prefix reading-prefix readthrough-prefix collection-prefix part-prefix edition-prefix author-prefix translator-prefix)
  (with-row-prefix (row prefix) field
    (when (field "id")
      (make-instance 'model:session
                     :id (field "id")
                     :created-at (read-date (field "created_at"))
                     :updated-at (read-date (field "updated_at"))
                     :reading (map-reading row reading-prefix readthrough-prefix collection-prefix part-prefix edition-prefix author-prefix translator-prefix)
                     :at (read-date (field "at"))
                     :page-start (field "page_start")
                     :page-end (field "page_end")))))

(defun %select-sessions (filter order paging values)
  (sql-execute (format nil "SELECT ~A, ~A, ~A, ~A, ~A, ~A, ~A, ~A
                            FROM sessions s
                            JOIN readings r ON s.reading_id=r.id
                            LEFT JOIN readthroughs rt ON r.readthrough_id=rt.id
                            LEFT JOIN collections c ON rt.collection_id=c.id
                            JOIN parts p ON r.part_id=p.id
                            JOIN editions e ON p.edition_id=e.id
                            LEFT JOIN authors a ON e.author_id=a.id
                            LEFT JOIN authors t ON e.translator_id=t.id
                            ~A
                            ~A
                            ~A"
                       (select-columns "s" "" +session-columns+)
                       (select-columns "r" "r_" +reading-columns+)
                       (select-columns "rt" "rt_" +readthrough-columns+)
                       (select-columns "c" "c_" +collection-columns+)
                       (select-columns "p" "p_" +part-columns+)
                       (select-columns "e" "e_" +edition-columns+)
                       (select-columns "a" "a_" +author-columns+)
                       (select-columns "t" "t_" +author-columns+)
                       filter
                       order
                       paging)
               values
               (lambda (row) (map-session row "" "r_" "rt_" "c_" "p_" "e_" "a_" "t_"))))

(defun select-sessions (&key start-date end-date (limit 0) (offset 0))
  (%select-sessions "WHERE at>=? AND at<=?"
                    "ORDER BY s.at DESC, s.page_start DESC"
                    (%paging-clause limit offset)
                    (list (write-date (or start-date dates:minimum-date))
                          (write-date (or end-date dates:maximum-date)))))

(defun select-collection-tree-sessions (tree)
  (let ((part-ids (model:tree-map-parts tree #'model:part-id)))
    (%select-sessions (format nil "WHERE p.id IN (~{~A~^, ~})" part-ids)
                      "ORDER BY at DESC, page_start DESC"
                      ""
                      nil)))

(defun select-readthrough-sessions (readthrough)
  (%select-sessions "WHERE r.readthrough_id=?"
                    "ORDER BY at DESC, page_start DESC"
                    ""
                    (list (model:readthrough-id readthrough))))

(defun select-reading-sessions (reading)
  (%select-sessions "WHERE s.reading_id=?"
                    "ORDER BY s.at DESC, s.page_start DESC"
                    ""
                    (list (model:reading-id reading))))

(defun select-session (id)
  (declare (type integer id))
  (first
   (%select-sessions "WHERE s.id=?" "" "" (list id))))

(defun insert-session (session)
  (declare (type model:session session))
  (insert ("sessions" +session-columns+ session) now
    (write-date now)
    (write-date now)
    (model:reading-id (model:session-reading session))
    (write-date (model:session-at session))
    (model:session-page-start session)
    (model:session-page-end session)))

(defun update-session (session)
  (declare (type model:session session))
  (update ("sessions" +session-columns+ session) now
    (write-date now)
    (model:reading-id (model:session-reading session))
    (write-date (model:session-at session))
    (model:session-page-start session)
    (model:session-page-end session)
    (model:session-id session)))

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