;;; forge-db.el --- Database implementation  -*- lexical-binding:t -*-

;; Copyright (C) 2018-2026 Jonas Bernoulli

;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>

;; SPDX-License-Identifier: GPL-3.0-or-later

;; This file is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this file.  If not, see <https://www.gnu.org/licenses/>.

;;; Code:

(require 'closql)
(require 'compat)
(require 'eieio)
(require 'emacsql)

;; For `closql--db-update-schema':
(declare-function forge--object-id "forge-core")
(declare-function forge-get-issue "forge-core")
(declare-function forge-get-pullreq "forge-core")
(declare-function forge-get-repository "forge-core" (demand))

(eval-when-compile
  (cl-pushnew 'milestone eieio--known-slot-names)  ; forge-{issue,pullreq}
  (cl-pushnew 'number    eieio--known-slot-names)) ; forge-{issue,pullreq,...}

;;; Options

(defcustom forge-database-file
  (expand-file-name "forge-database.sqlite" user-emacs-directory)
  "The file used to store the forge database."
  :package-version '(forge . "0.1.0")
  :group 'forge
  :type 'file)

;;; Core

(defclass forge-database (closql-database)
  ((name         :initform "Forge")
   (object-class :initform 'forge-repository)
   (file         :initform 'forge-database-file)
   (schemata     :initform 'forge--db-table-schemata)
   (version      :initform 15)))

(defvar forge--override-connection-class nil)

(defun forge-db (&optional livep)
  (closql-db 'forge-database livep forge--override-connection-class))

(defun forge-sql (sql &rest args)
  (if (stringp sql)
      (emacsql (forge-db) (apply #'format sql args))
    (apply #'emacsql (forge-db) sql args)))

(defun forge-sql1 (sql &rest args)
  (caar (apply #'forge-sql sql args)))

(defun forge-sql-car (sql &rest args)
  (mapcar #'car (apply #'forge-sql sql args)))

(defun forge-sql-cdr (sql &rest args)
  (mapcar #'cdr (apply #'forge-sql sql args)))

(defun forge-connect-database-once ()
  "Try to connect Forge database on first use of `magit-status' only."
  (remove-hook 'magit-status-mode-hook #'forge-connect-database-once)
  (forge-db))
(add-hook 'magit-status-mode-hook #'forge-connect-database-once)

(defun forge-enable-sql-logging ()
  "Enable logging Forge's SQL queries."
  (interactive)
  (let ((conn (oref (forge-db) connection)))
    (emacsql-enable-debugging conn)
    (switch-to-buffer-other-window (oref conn log-buffer))))

;;; Schemata

(defconst forge--db-table-schemata
  '((repository
     [(class :not-null)
      (id :not-null :primary-key)
      forge-id
      forge
      owner
      name
      apihost
      githost
      remote
      condition
      created
      updated
      pushed
      parent
      description
      homepage
      default-branch
      archived-p
      fork-p
      locked-p
      mirror-p
      private-p
      issues-p
      wiki-p
      stars
      watchers
      (assignees :default eieio-unbound)
      (forks     :default eieio-unbound)
      (issues    :default eieio-unbound)
      (labels    :default eieio-unbound)
      (revnotes  :default eieio-unbound)
      (pullreqs  :default eieio-unbound)
      selective-p
      worktree
      (milestones :default eieio-unbound)
      issues-until
      pullreqs-until
      teams
      (discussion-categories :default eieio-unbound)
      (discussions           :default eieio-unbound)
      discussions-p
      discussions-until
      ])

    (assignee
     [(repository :not-null)
      (id :not-null :primary-key)
      login
      name
      forge-id]
     (:foreign-key
      [repository] :references repository [id]
      :on-delete :cascade))

    (discussion
     [(class :not-null)
      (id :not-null :primary-key)
      repository
      number
      answer
      state
      author
      title
      created
      updated
      closed
      status
      locked-p
      category
      body
      (cards        :default eieio-unbound)
      (edits        :default eieio-unbound)
      (labels       :default eieio-unbound)
      (participants :default eieio-unbound)
      (posts        :default eieio-unbound)
      (reactions    :default eieio-unbound)
      (timeline     :default eieio-unbound)
      (marks        :default eieio-unbound)
      note
      their-id
      slug
      saved-p]
     (:foreign-key
      [repository] :references repository [id]
      :on-delete :cascade))

    (discussion-category
     [(repository :not-null)
      (id :not-null :primary-key)
      their-id
      name
      emoji
      answerable-p
      description]
     (:foreign-key
      [repository] :references repository [id]
      :on-delete :cascade))

    (discussion-label
     [(discussion :not-null)
      (id :not-null)]
     (:foreign-key
      [discussion] :references discussion [id]
      :on-delete :cascade)
     (:foreign-key
      [id] :references label [id]
      :on-delete :cascade))

    (discussion-mark
     [(discussion :not-null)
      (id :not-null)]
     (:foreign-key
      [discussion] :references discussion [id]
      :on-delete :cascade)
     (:foreign-key
      [id] :references mark [id]
      :on-delete :cascade))

    (discussion-post ; aka top-level answer
     [(class :not-null)
      (id :not-null :primary-key)
      their-id
      number
      discussion
      author
      created
      updated
      body
      (edits        :default eieio-unbound)
      (reactions    :default eieio-unbound)
      (replies      :default eieio-unbound)]
     (:foreign-key
      [discussion] :references discussion [id]
      :on-delete :cascade))

    (discussion-reply ; aka nested reply to top-level answer
     [(class :not-null)
      (id :not-null :primary-key)
      their-id
      number
      post
      discussion
      author
      created
      updated
      body
      (edits        :default eieio-unbound)
      (reactions    :default eieio-unbound)]
     (:foreign-key
      [post] :references discussion-post [id]
      :on-delete :cascade)
     (:foreign-key
      [discussion] :references discussion [id]
      :on-delete :cascade))

    (fork
     [(parent :not-null)
      (id :not-null :primary-key)
      owner
      name]
     (:foreign-key
      [parent] :references repository [id]
      :on-delete :cascade))

    (issue
     [(class :not-null)
      (id :not-null :primary-key)
      repository
      number
      state
      author
      title
      created
      updated
      closed
      status
      locked-p
      milestone
      body
      (assignees    :default eieio-unbound)
      (cards        :default eieio-unbound)
      (edits        :default eieio-unbound)
      (labels       :default eieio-unbound)
      (participants :default eieio-unbound)
      (posts        :default eieio-unbound)
      (reactions    :default eieio-unbound)
      (timeline     :default eieio-unbound)
      (marks        :default eieio-unbound)
      note
      their-id
      slug
      saved-p]
     (:foreign-key
      [repository] :references repository [id]
      :on-delete :cascade))

    (issue-assignee
     [(issue :not-null)
      (id :not-null)]
     (:foreign-key
      [issue] :references issue [id]
      :on-delete :cascade))

    (issue-label
     [(issue :not-null)
      (id :not-null)]
     (:foreign-key
      [issue] :references issue [id]
      :on-delete :cascade)
     (:foreign-key
      [id] :references label [id]
      :on-delete :cascade))

    (issue-mark
     [(issue :not-null)
      (id :not-null)]
     (:foreign-key
      [issue] :references issue [id]
      :on-delete :cascade)
     (:foreign-key
      [id] :references mark [id]
      :on-delete :cascade))

    (issue-post
     [(class :not-null)
      (id :not-null :primary-key)
      issue
      number
      author
      created
      updated
      body
      (edits :default eieio-unbound)
      (reactions :default eieio-unbound)]
     (:foreign-key
      [issue] :references issue [id]
      :on-delete :cascade))

    (label
     [(repository :not-null)
      (id :not-null :primary-key)
      name
      color
      description]
     (:foreign-key
      [repository] :references repository [id]
      :on-delete :cascade))

    (mark
     [;; For now this is always nil because it seems more useful to
      ;; share marks between repositories.  We cannot omit this slot
      ;; though because `closql--iref' expects `id' to be the second
      ;; slot.
      repository
      (id :not-null :primary-key)
      name
      face
      description])

    (milestone
     [(repository :not-null)
      (id :not-null :primary-key)
      number
      title
      created
      updated
      due
      closed
      description]
     (:foreign-key
      [repository] :references repository [id]
      :on-delete :cascade))

    (notification
     [(class :not-null)
      (id :not-null :primary-key)
      thread-id
      repository
      type
      topic
      url
      title
      reason
      last-read
      updated]
     (:foreign-key
      [repository] :references repository [id]
      :on-delete :cascade))

    (pullreq
     [(class :not-null)
      (id :not-null :primary-key)
      repository
      number
      state
      author
      title
      created
      updated
      closed
      merged
      status
      locked-p
      editable-p
      cross-repo-p
      base-ref
      base-repo
      head-ref
      head-user
      head-repo
      milestone
      body
      (assignees       :default eieio-unbound)
      (cards           :default eieio-unbound)
      (commits         :default eieio-unbound)
      (edits           :default eieio-unbound)
      (labels          :default eieio-unbound)
      (participants    :default eieio-unbound)
      (posts           :default eieio-unbound)
      (reactions       :default eieio-unbound)
      (review-requests :default eieio-unbound)
      (reviews         :default eieio-unbound)
      (timeline        :default eieio-unbound)
      (marks           :default eieio-unbound)
      note
      base-rev
      head-rev
      draft-p
      their-id
      slug
      saved-p]
     (:foreign-key
      [repository] :references repository [id]
      :on-delete :cascade))

    (pullreq-assignee
     [(pullreq :not-null)
      (id :not-null)]
     (:foreign-key
      [pullreq] :references pullreq [id]
      :on-delete :cascade))

    (pullreq-label
     [(pullreq :not-null)
      (id :not-null)]
     (:foreign-key
      [pullreq] :references pullreq [id]
      :on-delete :cascade)
     (:foreign-key
      [id] :references label [id]
      :on-delete :cascade))

    (pullreq-mark
     [(pullreq :not-null)
      (id :not-null)]
     (:foreign-key
      [pullreq] :references pullreq [id]
      :on-delete :cascade)
     (:foreign-key
      [id] :references mark [id]
      :on-delete :cascade))

    (pullreq-post
     [(class :not-null)
      (id :not-null :primary-key)
      pullreq
      number
      author
      created
      updated
      body
      (edits :default eieio-unbound)
      (reactions :default eieio-unbound)]
     (:foreign-key
      [pullreq] :references pullreq [id]
      :on-delete :cascade))

    (pullreq-review-request
     [(pullreq :not-null)
      (id :not-null)]
     (:foreign-key
      [pullreq] :references pullreq [id]
      :on-delete :cascade))

    (revnote
     [(class :not-null)
      (id :not-null :primary-key)
      repository
      commit
      file
      line
      author
      body]
     (:foreign-key
      [repository] :references repository [id]
      :on-delete :cascade))))

(cl-defmethod closql--db-update-schema ((db forge-database))
  (let ((version (closql--db-get-version db)))
    (when (< version (oref-default 'forge-database version))
      (forge--backup-database db)
      (closql-with-transaction db
        (forge--db-update-schema db version)))
    (cl-call-next-method)))

(defun forge--db-update-schema (db version)
  (cl-macrolet
      ((up (to &rest body)
         `(when (= (1+ version) ,to)
            (message "Upgrading Forge database from version %s to %s..."
                     version ,to)
            ,@body
            (closql--db-set-version db ,to)
            (message "Upgrading Forge database from version %s to %s...done"
                     version ,to)
            (setq version ,to))))
    (up 3
        (emacsql db [:create-table pullreq-review-request $S1]
                 (cdr (assq 'pullreq-review-request forge--db-table-schemata))))
    (up 4
        (emacsql db [:drop-table notification])
        (pcase-dolist (`(,table . ,schema) forge--db-table-schemata)
          (when (memq table '(notification
                              mark issue-mark pullreq-mark))
            (emacsql db [:create-table $i1 $S2] table schema)))
        (emacsql db [:alter-table issue   :add-column marks :default $s1] 'eieio-unbound)
        (emacsql db [:alter-table pullreq :add-column marks :default $s1] 'eieio-unbound))
    (up 5
        (emacsql db [:alter-table repository :add-column selective-p :default nil]))
    (up 6
        (emacsql db [:alter-table repository :add-column worktree :default nil]))
    (up 7
        (emacsql db [:alter-table issue   :add-column note :default nil])
        (emacsql db [:alter-table pullreq :add-column note :default nil])
        (emacsql db [:create-table milestone $S1]
                 (cdr (assq 'milestone forge--db-table-schemata)))
        (emacsql db [:alter-table repository :add-column milestones :default $s1]
                 'eieio-unbound)
        (pcase-dolist (`(,repo-id ,issue-id ,milestone)
                       (emacsql db [:select [repository id milestone]
                                    :from issue
                                    :where (notnull milestone)]))
          (unless (stringp milestone)
            (oset (forge-get-issue issue-id) milestone
                  (forge--object-id repo-id (cdar milestone)))))
        (pcase-dolist (`(,repo-id ,pullreq-id ,milestone)
                       (emacsql db [:select [repository id milestone]
                                    :from pullreq
                                    :where (notnull milestone)]))
          (unless (stringp milestone)
            (oset (forge-get-pullreq pullreq-id) milestone
                  (forge--object-id repo-id (cdar milestone))))))
    (up 8
        (emacsql db [:alter-table pullreq :add-column base-rev :default nil])
        (emacsql db [:alter-table pullreq :add-column head-rev :default nil])
        (emacsql db [:alter-table pullreq :add-column draft-p  :default nil]))
    (up 9
        (emacsql db [:alter-table pullreq :add-column their-id :default nil])
        (emacsql db [:alter-table issue   :add-column their-id :default nil]))
    (up 10
        (emacsql db [:alter-table pullreq :add-column slug :default nil])
        (emacsql db [:alter-table issue   :add-column slug :default nil])
        (pcase-dolist (`(,id ,number ,type)
                       (emacsql
                        db
                        [:select [pullreq:id pullreq:number repository:class]
                         :from pullreq
                         :join repository
                         :on (= pullreq:repository repository:id)]))
          (let ((gitlabp (memq type
                               (append (closql-where-class-in
                                        'forge-gitlab-repository--eieio-childp)
                                       nil))))
            (emacsql db [:update pullreq :set (= slug $s1) :where (= id $s2)]
                     (format "%s%s" (if gitlabp "!" "#") number)
                     id)))
        (pcase-dolist (`(,id ,number)
                       (emacsql db [:select [id number] :from issue]))
          (emacsql db [:update issue :set (= slug $s1) :where (= id $s2)]
                   (format "#%s" number)
                   id)))
    (up 11
        (emacsql db [:drop-table notification])
        (emacsql db [:create-table notification $S1]
                 (cdr (assq 'notification forge--db-table-schemata)))
        (emacsql db [:alter-table pullreq :rename-column unread-p :to status])
        (emacsql db [:alter-table issue   :rename-column unread-p :to status])
        (emacsql db [:alter-table pullreq :add-column saved-p :default nil])
        (emacsql db [:alter-table issue   :add-column saved-p :default nil]))
    (up 12
        (emacsql db [:drop-table notification])
        (emacsql db [:create-table notification $S1]
                 (cdr (assq 'notification forge--db-table-schemata)))
        (dolist (id (emacsql db [:select id :from issue :where (= state 'closed)]))
          (emacsql db [:update issue :set (= state 'completed) :where (= id $s1)]
                   id))
        (dolist (id (emacsql db [:select id :from issue :where (isnull status)]))
          (emacsql db [:update issue :set (= state 'done) :where (= id $s1)]
                   id))
        (dolist (id (emacsql db [:select id :from pullreq :where (= state 'closed)]))
          (emacsql db [:update pullreq :set (= state 'rejected) :where (= id $s1)]
                   id))
        (dolist (id (emacsql db [:select id :from pullreq :where (isnull status)]))
          (emacsql db [:update pullreq :set (= state 'done) :where (= id $s1)]
                   id))
        (emacsql db [:alter-table repository :add-column issues-until :default nil])
        (emacsql db [:alter-table repository :add-column pullreqs-until :default nil]))
    (up 13
        (dolist (id (emacsql db [:select id :from repository
                                 :where (isnull issues-until)]))
          (emacsql
           db [:update repository :set (= issues-until $s1) :where (= id $s2)]
           (forge-sql1 [:select [updated] :from issue
                        :where (= repository $s1)
                        :order-by [(desc updated)]
                        :limit 1]
                       id)
           id))
        (dolist (id (emacsql db [:select id :from repository
                                 :where (isnull pullreqs-until)]))
          (emacsql
           db [:update repository :set (= pullreqs-until $s1) :where (= id $s2)]
           (forge-sql1 [:select [updated] :from pullreq
                        :where (= repository $s1)
                        :order-by [(desc updated)]
                        :limit 1]
                       id)
           id))
        (emacsql db [:alter-table repository :rename-column sparse-p :to condition])
        (pcase-dolist (`(,id ,not-tracked)
                       (emacsql db [:select [id condition] :from repository]))
          (emacsql
           db [:update repository :set (= condition $s1) :where (= id $s2)]
           (if not-tracked :known :tracked)
           id)))
    (up 14
        (emacsql db [:alter-table repository :add-column teams :default nil]))
    (up 15
        (emacsql db [:create-table discussion $S1]
                 (cdr (assq 'discussion forge--db-table-schemata)))
        (emacsql db [:create-table discussion-category $S1]
                 (cdr (assq 'discussion-category forge--db-table-schemata)))
        (emacsql db [:create-table discussion-label $S1]
                 (cdr (assq 'discussion-label forge--db-table-schemata)))
        (emacsql db [:create-table discussion-mark $S1]
                 (cdr (assq 'discussion-mark forge--db-table-schemata)))
        (emacsql db [:create-table discussion-post $S1]
                 (cdr (assq 'discussion-post forge--db-table-schemata)))
        (emacsql db [:create-table discussion-reply $S1]
                 (cdr (assq 'discussion-reply forge--db-table-schemata)))
        (emacsql db [:alter-table repository :add-column discussion-categories
                     :default 'eieio-unbound])
        (emacsql db [:alter-table repository :add-column discussions
                     :default 'eieio-unbound])
        (emacsql db [:alter-table repository :add-column discussions-p
                     :default nil])
        (emacsql db [:alter-table repository :add-column discussions-until
                     :default nil]))
    ))

(defun forge--backup-database (db)
  (let ((dst (concat (file-name-sans-extension forge-database-file)
                     (format "-v%s" (caar (emacsql (oref db connection)
                                                   [:pragma user-version])))
                     (format-time-string "-%Y%m%d-%H%M")
                     ".sqlite")))
    (message "Copying Forge database to %s..." dst)
    (copy-file forge-database-file dst)
    (message "Copying Forge database to %s...done" dst)))

;;; _
;; Local Variables:
;; read-symbol-shorthands: (
;;   ("and$"          . "cond-let--and$")
;;   ("thread$"       . "cond-let--thread$")
;;   ("when$"         . "cond-let--when$")
;;   ("and-let*"      . "cond-let--and-let*")
;;   ("and-let"       . "cond-let--and-let")
;;   ("if-let*"       . "cond-let--if-let*")
;;   ("if-let"        . "cond-let--if-let")
;;   ("when-let*"     . "cond-let--when-let*")
;;   ("when-let"      . "cond-let--when-let")
;;   ("while-let*"    . "cond-let--while-let*")
;;   ("while-let"     . "cond-let--while-let"))
;; End:
(provide 'forge-db)
;;; forge-db.el ends here