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

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

;;; Validation Lists

(defparameter +domain-types+ '(("book" . "Book")
                               ("manga" . "Manga")))
(defparameter +statuses+ '(("not-started" . "Not Started")
                           ("in-progress" . "In Progress")
                           ("paused" . "Paused")
                           ("skipped" . "Skipped")
                           ("did-not-finish" . "Did Not Finish")
                           ("completed" . "Completed")))

(defun friendly (key alist)
  (cdr (assoc key alist :test #'equalp)))

;;; Helpers

(defun sort-name (name sort-name)
  (or sort-name
      (let ((parts (uiop:split-string name)))
        (if (< 1 (length parts))
            (format nil "~A, ~{~A~^ ~}"
                    (car (last parts))
                    (butlast parts))
            (first parts)))))

(defun normalize-sort-name (author &key (overwrite nil))
  (with-slots (name sort-name) author
    (when (or overwrite (null sort-name) (string-equal name sort-name))
      (setf sort-name (sort-name name sort-name)))))

(defun sort-title (title sort-title)
  (or sort-title
      (cond
        ((uiop:string-prefix-p "A " title)
         (subseq title 2))
        ((uiop:string-prefix-p "An " title)
         (subseq title 3))
        ((uiop:string-prefix-p "The " title)
         (subseq title 4))
        (t
         title))))

(defun normalize-sort-title (obj &key (overwrite nil))
  (with-slots (title sort-title) obj
    (when (and title (or overwrite (null sort-title) (string-equal title sort-title)))
      (setf sort-title (sort-title title sort-title)))))

(defun normalize-part-title (part)
  (with-slots (title sort-title edition) part
    (when (and edition title (string-equal title (edition-title edition)))
      (setf title nil))
    (unless title
      (setf sort-title nil))))

;;; String Normalization

(defclass string-normalizing-class (standard-class)
  ())

(defmethod closer-mop:validate-superclass ((class string-normalizing-class) (superclass standard-class))
  t)

(defmethod closer-mop:validate-superclass ((class standard-class) (superclass string-normalizing-class))
  t)

(defclass string-normalizing-object (standard-object)
  ()
  (:metaclass string-normalizing-class))

(defun normalize-string (string)
  (if (stringp string)
      (let ((trimmed (string-trim '(#\Space #\Tab) string)))
        (if (string= trimmed "")
            nil
            trimmed))
      string))

(defmethod (setf slot-value-using-class) :around
    (new-value (class string-normalizing-class) object
     (slot closer-mop:standard-effective-slot-definition))
  (call-next-method (normalize-string new-value)))

(defmethod initialize-instance :after ((obj string-normalizing-object) &key)
  (loop for slot in (closer-mop:class-slots (class-of obj))
        for name = (closer-mop:slot-definition-name slot)
        when (slot-boundp obj name)
          do (setf (slot-value obj name)
                   (normalize-string (slot-value obj name)))))

;;; Entity

(defclass entity (string-normalizing-object)
  ((id :initarg :id :type integer :accessor entity-id)
   (created-at :initarg :created-at :type dates:date :accessor entity-created-at)
   (updated-at :initarg :updated-at :type dates:date :accessor entity-updated-at)))

;;; Authors

(defgeneric author-id (author))
(defgeneric author-name (author))
(defgeneric author-sort-name (author))
(defgeneric author-birth (author))
(defgeneric author-death (author))
(defgeneric author-bookbrainz-id (author))
(defgeneric author-openlibrary-id (author))
(defgeneric author-wikidata-id (author))

(defmethod author-id ((author (eql nil)))
  nil)

(defclass author (entity)
  ((name :initarg :name :type string :accessor author-name)
   (sort-name :initarg :sort-name :type string :accessor author-sort-name)
   (birth :initarg :birth :type dates:date :accessor author-birth)
   (death :initarg :death :type dates:date :accessor author-death)
   (bookbrainz-id :initarg :bookbrainz-id :type string :accessor author-bookbrainz-id)
   (openlibrary-id :initarg :openlibrary-id :type string :accessor author-openlibrary-id)
   (wikidata-id :initarg :wikidata-id :type string :accessor author-wikidata-id)))

(defun make-author (&key name sort-name birth death bookbrainz-id openlibrary-id wikidata-id)
  (make-instance 'author
                 :id nil
                 :created-at nil
                 :updated-at nil
                 :name name
                 :sort-name sort-name
                 :birth birth
                 :death death
                 :bookbrainz-id bookbrainz-id
                 :openlibrary-id openlibrary-id
                 :wikidata-id wikidata-id))

(defmethod print-object ((obj author) stream)
  (print-unreadable-object (obj stream :type t)
    (format stream "~A" (author-name obj))))

(defmethod initialize-instance :after ((author author) &key)
  (normalize-sort-name author))

(defmethod author-id ((author author))
  (entity-id author))

(defmethod (setf author-name) :after (value (author author))
  (declare (ignore value))
  (normalize-sort-name author))

(defmethod (setf author-sort-name) :after (value (author author))
  (declare (ignore value))
  (normalize-sort-name author))

;;; Editions

(defgeneric edition-id (edition))
(defgeneric edition-title (edition))
(defgeneric edition-full-title (edition))
(defgeneric edition-sort-title (edition))
(defgeneric edition-disambiguation (edition))
(defgeneric edition-author (edition))
(defgeneric edition-translator (edition))
(defgeneric edition-page-start (edition))
(defgeneric edition-page-end (edition))
(defgeneric edition-pages (edition))
(defgeneric edition-type (edition))
(defgeneric edition-year (edition))
(defgeneric edition-isbn (edition))
(defgeneric edition-bookbrainz-id (edition))
(defgeneric edition-openlibrary-id (edition))
(defgeneric edition-wikidata-id (edition))

(defmethod edition-id ((edition (eql nil)))
  nil)

(defclass edition (entity)
  ((title :initarg :title :type string :accessor edition-title)
   (sort-title :initarg :sort-title :type string :accessor edition-sort-title)
   (disambiguation :initarg :disambiguation :type string :accessor edition-disambiguation)
   (author :initarg :author :type author :accessor edition-author)
   (translator :initarg :translator :type author :accessor edition-translator)
   (page-start :initarg :page-start :type integer :accessor edition-page-start)
   (page-end :initarg :page-end :type integer :accessor edition-page-end)
   (type :initarg :type :type string :accessor edition-type)
   (year :initarg :year :type dates:date :accessor edition-year)
   (isbn :initarg :isbn :type string :accessor edition-isbn)
   (bookbrainz-id :initarg :bookbrainz-id :type string :accessor edition-bookbrainz-id)
   (openlibrary-id :initarg :openlibrary-id :type string :accessor edition-openlibrary-id)
   (wikidata-id :initarg :wikidata-id :type string :accessor edition-wikidata-id)))

(defun make-edition (&key title sort-title disambiguation author translator page-start page-end type year isbn bookbrainz-id openlibrary-id wikidata-id)
  (make-instance 'edition
                 :id nil
                 :created-at nil
                 :updated-at nil
                 :title title
                 :sort-title sort-title
                 :disambiguation disambiguation
                 :author author
                 :translator translator
                 :page-start page-start
                 :page-end page-end
                 :type type
                 :year year
                 :isbn isbn
                 :bookbrainz-id bookbrainz-id
                 :openlibrary-id openlibrary-id
                 :wikidata-id wikidata-id))

(defmethod print-object ((obj edition) stream)
  (print-unreadable-object (obj stream :type t)
    (format stream "~A (~A~@[, ~:d p.~])"
            (edition-title obj)
            (if (edition-author obj)
                (author-name (edition-author obj))
                "Unknown")
            (edition-pages obj))))

(defmethod initialize-instance :after ((edition edition) &key)
  (normalize-sort-title edition))

(defmethod edition-id ((edition edition))
  (entity-id edition))

(defmethod (setf edition-title) :after (value (edition edition))
  (declare (ignore value))
  (normalize-sort-title edition :overwrite t))

(defmethod edition-sort-title ((edition edition))
  (with-slots (title sort-title) edition
    (sort-title title sort-title)))

(defmethod (setf edition-sort-title) :after (value (edition edition))
  (declare (ignore value))
  (normalize-sort-title edition :overwrite t))

(defmethod edition-full-title ((edition edition))
  (with-slots (title disambiguation) edition
    (if (and disambiguation (< 0 (length disambiguation)))
        (format nil "~A (~A)" title disambiguation)
        title)))

(defmethod edition-pages ((edition edition))
  (with-slots (page-start page-end) edition
    (when (and page-start page-end)
      (1+ (- page-end page-start)))))

;; Parts

(defgeneric part-id (part))
(defgeneric part-edition (part))
(defgeneric part-title (part))
(defgeneric part-sort-title (part))
(defgeneric part-segment (part))
(defgeneric part-page-start (part))
(defgeneric part-page-end (part))
(defgeneric part-pages (part))
(defgeneric part-page-start-str (part))
(defgeneric part-page-end-str (part))
(defgeneric part-page-range (part))
(defgeneric part-bookbrainz-id (part))
(defgeneric part-openlibrary-id (part))
(defgeneric part-wikidata-id (part))

(defmethod part-id ((part (eql nil)))
  nil)

(defclass part (entity)
  ((edition :initarg :edition :type edition :accessor part-edition)
   (title :initarg :title :type string :accessor part-title)
   (sort-title :initarg :sort-title :type string :accessor part-sort-title)
   (segment :initarg :segment :type string :accessor part-segment)
   (page-start :initarg :page-start :type integer :accessor part-page-start)
   (page-end :initarg :page-end :type integer :accessor part-page-end)
   (bookbrainz-id :initarg :bookbrainz-id :type string :accessor part-bookbrainz-id)
   (openlibrary-id :initarg :openlibrary-id :type string :accessor part-openlibrary-id)
   (wikidata-id :initarg :wikidata-id :type string :accessor part-wikidata-id)))

(defun make-part (&key edition title sort-title segment page-start page-end bookbrainz-id openlibrary-id wikidata-id)
  (make-instance 'part
                 :edition edition
                 :title title
                 :sort-title sort-title
                 :segment segment
                 :page-start page-start
                 :page-end page-end
                 :bookbrainz-id bookbrainz-id
                 :openlibrary-id openlibrary-id
                 :wikidata-id wikidata-id))

(defmethod print-object ((obj part) stream)
  (print-unreadable-object (obj stream :type t)
    (format stream "~A~@[ (from ~A)~]"
            (part-title obj)
            (when (part-edition obj)
              (edition-title (part-edition obj))))))

(defmethod initialize-instance :after ((part part) &key)
  (normalize-part-title part)
  (normalize-sort-title part))

(defmethod part-id ((part part))
  (entity-id part))

(defmethod part-title ((part part))
  (with-slots (title edition) part
    (if title title (edition-title edition))))

(defmethod (setf part-title) :after (value (part part))
  (declare (ignore value))
  (normalize-part-title part)
  (normalize-sort-title part :overwrite t))

(defmethod part-sort-title ((part part))
  (with-slots (title sort-title) part
    (sort-title title sort-title)))

(defmethod (setf part-sort-title) :after (value (part part))
  (declare (ignore value))
  (normalize-sort-title part :overwrite t))

(defun part-title-p (part)
  (with-slots (edition title) part
    (and title
         (< 0 (length title))
         (not (string-equal title (edition-title edition))))))

(defun part-partial-p (part)
  (not
   (and
    (= 1 (part-page-start part))
    (= (part-page-end part)
       (edition-page-end (part-edition part))))))

(defmethod part-pages ((part part))
  (1+ (- (part-page-end part)
         (part-page-start part))))

(defun part-page-str (part page)
  (cond
    ((string-equal "frontmatter" (part-segment part))
     (string-downcase (format nil "~@R" page)))
    ((string-equal "body" (part-segment part))
     (format nil "~:D" page))
    (t
     (error "Unexpected part segment: ~A" (part-segment part)))))

(defmethod part-page-start-str ((part part))
  (part-page-str part (part-page-start part)))

(defmethod part-page-end-str ((part part))
    (part-page-str part (part-page-end part)))

(defmethod part-page-range ((part part))
  (format nil "pp. ~A-~A"
          (part-page-start-str part)
          (part-page-end-str part)))

;; Collections

(defgeneric collection-id (collection))
(defgeneric collection-title (collection))
(defgeneric collection-type (collection))
(defgeneric collection-type-friendly (collection))

(defmethod collection-id ((collection (eql nil)))
  nil)

(defclass collection (entity)
  ((title :initarg :title :type string :accessor collection-title)
   (type :initarg :type :type string :accessor collection-type)))

(defun make-collection (&key title type)
  (make-instance 'collection
                 :id nil
                 :created-at nil
                 :updated-at nil
                 :title title
                 :type type))

(defmethod print-object ((obj collection) stream)
  (print-unreadable-object (obj stream :type t)
    (format stream "~A"
            (collection-title obj))))

(defmethod collection-id ((collection collection))
  (entity-id collection))

(defmethod collection-type-friendly ((collection collection))
  (friendly (collection-type collection) +domain-types+))

;; Items

(defgeneric item-id (item))
(defgeneric item-collection (item))
(defgeneric item-position (item))
(defgeneric item-item (item))

(defmethod item-id ((item (eql nil)))
  nil)

(defclass item (entity)
  ((collection :initarg :collection :type collection :accessor item-collection)
   (position :initarg :position :type integer :accessor item-position)
   (item :initarg :item :accessor item-item)))

(defun make-item (&key collection position item)
  (make-instance 'item
                 :id nil
                 :created-at nil
                 :updated-at nil
                 :collection collection
                 :position position
                 :item item))

(defmethod print-object ((obj item) stream)
  (print-unreadable-object (obj stream :type t)
    (format stream "#~D: ~A"
            (item-position obj)
            (etypecase (item-item obj)
              (collection
               (collection-title (item-item obj)))
              (part
               (part-title (item-item obj)))))))

(defmethod item-id ((item item))
  (entity-id item))

(defmethod part-id ((item item))
  (with-slots (item) item
    (when (typep item 'part)
      (part-id item))))

(defmethod collection-id ((item item))
  (with-slots (item) item
    (when (typep item 'collection)
      (collection-id item))))

;; Collection Trees

(defgeneric tree-collection (tree))
(defgeneric tree-item (tree))
(defgeneric tree-children (tree))

(defgeneric tree-map-collections (tree function))
(defgeneric tree-map-parts (tree function))

(defclass tree ()
  ((collection :initarg :collection :type collection :reader tree-collection)
   (item :initarg :item :type item :reader tree-item)
   (children :initarg :children :type list :reader tree-children)))

(defun make-tree (&key collection item children)
  (make-instance 'tree :collection collection
                       :item item
                       :children children))

(defmethod print-object ((obj tree) stream)
  (print-unreadable-object (obj stream :type t)
    (format stream "#~D ~A (~{~A~^ ~})"
            (item-position (tree-item obj))
            (collection-title (tree-collection obj))
            (tree-children obj))))

(defmethod tree-children ((tree item))
  nil)

(defmethod tree-find ((tree tree) (content collection))
  (if (= (entity-id content)
         (entity-id (tree-collection tree)))
      tree
      (loop for node in (tree-children tree)
            for found = (tree-find node content)
            when found
              return found)))

(defmethod tree-find ((tree tree) (content part))
  (loop for node in (tree-children tree)
        for found = (tree-find node content)
        when found
          return found))

(defmethod tree-find ((tree item) (content collection))
  nil)

(defmethod tree-find ((tree item) (content part))
  (when (and (typep (item-item tree) 'part)
             (= (entity-id content)
                (entity-id (item-item tree))))
    tree))

(defmethod tree-map-collections ((tree tree) function)
  (cons (funcall function (tree-collection tree))
        (loop for node in (tree-children tree)
              append (tree-map-collections node function))))

(defmethod tree-map-collections ((tree item) function)
  nil)

(defmethod tree-map-parts ((tree tree) function)
  (loop for node in (tree-children tree)
        append (tree-map-parts node function)))

(defmethod tree-map-parts ((tree item) function)
  (let ((content (item-item tree)))
    (when (typep content 'part)
      (list (funcall function content)))))

;; Readthroughs

(defgeneric readthrough-id (readthrough))
(defgeneric readthrough-collection (readthrough))
(defgeneric readthrough-status (readthrough))
(defgeneric readthrough-status-friendly (readthrough))
(defgeneric readthrough-active-p (readthrough))
(defgeneric readthrough-started-at (readthrough))
(defgeneric readthrough-ended-at (readthrough))

(defmethod readthrough-id ((readthrough (eql nil)))
  nil)

(defclass readthrough (entity)
  ((collection :initarg :collection :type collection :accessor readthrough-collection)
   (status :initarg :status :type string :accessor readthrough-status)
   (started-at :initarg :started-at :type dates:date :accessor readthrough-started-at)
   (ended-at :initarg :ended-at :type dates:date :accessor readthrough-ended-at)))

(defun make-readthrough (&key collection status started-at ended-at)
  (make-instance 'readthrough
                 :id nil
                 :created-at nil
                 :updated-at nil
                 :collection collection
                 :status status
                 :started-at started-at
                 :ended-at ended-at))

(defmethod print-object ((obj readthrough) stream)
  (flet ((write-date (date)
           (if date (dates:write-iso-date nil date) "???")))
    (print-unreadable-object (obj stream :type t)
      (format stream "~A (~A - ~A)"
              (collection-title (readthrough-collection obj))
              (write-date (readthrough-started-at obj))
              (write-date (readthrough-ended-at obj))))))

(defmethod readthrough-id ((readthrough readthrough))
  (entity-id readthrough))

(defmethod readthrough-status-friendly ((readthrough readthrough))
  (friendly (readthrough-status readthrough) +statuses+))

(defmethod readthrough-active-p ((readthrough readthrough))
  (member (readthrough-status readthrough)
          '("in-progress" "paused")
          :test #'equalp))

;;; Readings

(defgeneric reading-id (reading))
(defgeneric reading-readthrough (reading))
(defgeneric reading-part (reading))
(defgeneric reading-status (reading))
(defgeneric reading-status-friendly (reading))
(defgeneric reading-active-p (reading))
(defgeneric reading-started-at (reading))
(defgeneric reading-ended-at (reading))

(defmethod reading-id ((reading (eql nil)))
  nil)

(defclass reading (entity)
  ((readthrough :initarg :readthrough :type readthrough :accessor reading-readthrough)
   (part :initarg :part :type part :accessor reading-part)
   (status :initarg :status :type string :accessor reading-status)
   (started-at :initarg :started-at :type dates:date :accessor reading-started-at)
   (ended-at :initarg :ended-at :type dates:date :accessor reading-ended-at)))

(defun make-reading (&key readthrough part status started-at ended-at)
  (make-instance 'reading
                 :id nil
                 :created-at nil
                 :updated-at nil
                 :readthrough readthrough
                 :part part
                 :status status
                 :started-at started-at
                 :ended-at ended-at))

(defmethod print-object ((obj reading) stream)
  (flet ((write-date (date)
           (if date (dates:write-iso-date nil date) "???")))
    (print-unreadable-object (obj stream :type t)
      (format stream "~A (~A - ~A)"
              (part-title (reading-part obj))
              (write-date (reading-started-at obj))
              (write-date (reading-ended-at obj))))))

(defmethod reading-id ((reading reading))
  (entity-id reading))

(defmethod reading-status-friendly ((reading reading))
  (friendly (reading-status reading) +statuses+))

(defmethod reading-active-p ((reading reading))
  (member (reading-status reading)
          '("in-progress" "paused")
          :test #'equalp))

;;; Session

(defgeneric session-id (session))
(defgeneric session-reading (session))
(defgeneric session-at (session))
(defgeneric session-page-start (session))
(defgeneric session-page-end (session))
(defgeneric session-pages (session))
(defgeneric session-page-start-str (session))
(defgeneric session-page-end-str (session))
(defgeneric session-page-range (session))

(defmethod session-id ((session (eql nil)))
  nil)

(defclass session (entity)
  ((reading :initarg :reading :type reading :accessor session-reading)
   (at :initarg :at :type dates:date :accessor session-at)
   (page-start :initarg :page-start :type integer :accessor session-page-start)
   (page-end :initarg :page-end :type integer :accessor session-page-end)))

(defun make-session (&key reading at page-start page-end)
  (make-instance 'session
                 :id nil
                 :created-at nil
                 :updated-at nil
                 :reading reading
                 :at at
                 :page-start page-start
                 :page-end page-end))

(defmethod print-object ((obj session) stream)
  (flet ((write-date (date)
           (if date (dates:write-iso-date nil date) "???")))
    (print-unreadable-object (obj stream :type t)
      (format stream "~A (~A, pp. ~:d-~:d)"
              (part-title (reading-part (session-reading obj)))
              (write-date (session-at obj))
              (session-page-start obj)
              (session-page-end obj)))))

(defmethod session-id ((session session))
  (entity-id session))

(defmethod session-pages ((session session))
  (1+ (- (session-page-end session)
      (session-page-start session))))

(defmethod session-page-start-str ((session session))
  (part-page-str (reading-part (session-reading session))
                 (session-page-start session)))

(defmethod session-page-end-str ((session session))
  (part-page-str (reading-part (session-reading session))
                 (session-page-end session)))

(defmethod session-page-range ((session session))
  (format nil "pp. ~A-~A"
          (session-page-start-str session)
          (session-page-end-str session)))
