dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

forge-db.el (15040B)


      1 ;;; forge-db.el --- Database implementation       -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2018-2022  Jonas Bernoulli
      4 
      5 ;; Author: Jonas Bernoulli <jonas@bernoul.li>
      6 ;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
      7 ;; SPDX-License-Identifier: GPL-3.0-or-later
      8 
      9 ;; This file is not part of GNU Emacs.
     10 
     11 ;; Forge is free software; you can redistribute it and/or modify it
     12 ;; under the terms of the GNU General Public License as published by
     13 ;; the Free Software Foundation; either version 3, or (at your option)
     14 ;; any later version.
     15 ;;
     16 ;; Forge is distributed in the hope that it will be useful, but WITHOUT
     17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
     18 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
     19 ;; License for more details.
     20 ;;
     21 ;; You should have received a copy of the GNU General Public License
     22 ;; along with Forge.  If not, see http://www.gnu.org/licenses.
     23 
     24 ;;; Code:
     25 
     26 (require 'closql)
     27 (require 'eieio)
     28 (require 'emacsql)
     29 (require 'emacsql-sqlite)
     30 
     31 (defvar forge--db-table-schemata)
     32 
     33 ;; For `forge--db-maybe-update':
     34 (declare-function forge-get-issue "forge-core")
     35 (declare-function forge-get-pullreq "forge-core")
     36 (declare-function forge--object-id "forge-core")
     37 
     38 ;;; Options
     39 
     40 (defcustom forge-database-connector 'sqlite
     41   "The database connector used by Forge.
     42 
     43 This must be set before `forge' is loaded.  To use an alternative
     44 connector you must install the respective package explicitly.
     45 
     46 When `sqlite', then use the `emacsql-sqlite' library that is
     47 being maintained in the same repository as `emacsql' itself.
     48 
     49 When `sqlite-builtin', then use the builtin support in Emacs 29.
     50 When `sqlite-module', then use a module provided by the `sqlite3'
     51 package.  These two backends are experimental.
     52 See https://github.com/skeeto/emacsql/pull/86.
     53 
     54 When `libsqlite3', then use the `emacsql-libsqlite' library,
     55 which itself uses a module provided by the `sqlite3' package.
     56 This is still experimental and likely to be deprecated in
     57 favor of `sqlite-module'.
     58 
     59 When `sqlite3', then use the `emacsql-sqlite3' library, which
     60 uses the official `sqlite3' command-line tool, which I do not
     61 recommended because it is not suitable to be used like this,
     62 but has the advantage that you likely don't need a compiler.
     63 See https://nullprogram.com/blog/2014/02/06/."
     64   :package-version '(forge . "0.3.0")
     65   :group 'forge
     66   :type '(choice (const sqlite)
     67                  (const sqlite-builtin)
     68                  (const sqlite-module)
     69                  (const libsqlite3)
     70                  (const sqlite3)
     71                  (symbol :tag "other")))
     72 
     73 (defcustom forge-database-file
     74   (expand-file-name "forge-database.sqlite"  user-emacs-directory)
     75   "The file used to store the forge database."
     76   :package-version '(forge . "0.1.0")
     77   :group 'forge
     78   :type 'file)
     79 
     80 ;;; Core
     81 
     82 (declare-function forge-database--eieio-childp "forge-db.el" (obj) t)
     83 (cl-ecase forge-database-connector
     84   (sqlite
     85    (defclass forge-database (emacsql-sqlite-connection closql-database)
     86      ((object-class :initform 'forge-repository))))
     87   (sqlite-builtin
     88    (require (quote emacsql-sqlite-builtin))
     89    (with-no-warnings
     90      (defclass forge-database (emacsql-sqlite-builtin-connection closql-database)
     91        ((object-class :initform 'epkg-package)))))
     92   (sqlite-module
     93    (require (quote emacsql-sqlite-module))
     94    (with-no-warnings
     95      (defclass forge-database (emacsql-sqlite-module-connection closql-database)
     96        ((object-class :initform 'epkg-package)))))
     97   (libsqlite3
     98    (require (quote emacsql-libsqlite3))
     99    (with-no-warnings
    100      (defclass forge-database (emacsql-libsqlite3-connection closql-database)
    101        ((object-class :initform 'forge-repository)))))
    102   (sqlite3
    103    (require (quote emacsql-sqlite3))
    104    (with-no-warnings
    105      (defclass forge-database (emacsql-sqlite3-connection closql-database)
    106        ((object-class :initform 'forge-repository))))))
    107 
    108 (defconst forge--db-version 7)
    109 (defconst forge--sqlite-available-p
    110   (with-demoted-errors "Forge initialization: %S"
    111     (emacsql-sqlite-ensure-binary)
    112     t))
    113 
    114 (defvar forge--db-connection nil
    115   "The EmacSQL database connection.")
    116 
    117 (defun forge-db ()
    118   (unless (and forge--db-connection (emacsql-live-p forge--db-connection))
    119     (make-directory (file-name-directory forge-database-file) t)
    120     (closql-db 'forge-database 'forge--db-connection
    121                forge-database-file t)
    122     (let* ((db forge--db-connection)
    123            (version (closql--db-get-version db))
    124            (version (forge--db-maybe-update forge--db-connection version)))
    125       (cond
    126        ((> version forge--db-version)
    127         (emacsql-close db)
    128         (user-error
    129          "The Forge database was created with a newer Forge version.  %s"
    130          "You need to update the Forge package."))
    131        ((< version forge--db-version)
    132         (emacsql-close db)
    133         (error "BUG: The Forge database scheme changed %s"
    134                "and there is no upgrade path")))))
    135   forge--db-connection)
    136 
    137 ;;; Api
    138 
    139 (defun forge-sql (sql &rest args)
    140   (if (stringp sql)
    141       (emacsql (forge-db) (apply #'format sql args))
    142     (apply #'emacsql (forge-db) sql args)))
    143 
    144 ;;; Schemata
    145 
    146 (defconst forge--db-table-schemata
    147   '((repository
    148      [(class :not-null)
    149       (id :not-null :primary-key)
    150       forge-id
    151       forge
    152       owner
    153       name
    154       apihost
    155       githost
    156       remote
    157       sparse-p
    158       created
    159       updated
    160       pushed
    161       parent
    162       description
    163       homepage
    164       default-branch
    165       archived-p
    166       fork-p
    167       locked-p
    168       mirror-p
    169       private-p
    170       issues-p
    171       wiki-p
    172       stars
    173       watchers
    174       (assignees :default eieio-unbound)
    175       (forks     :default eieio-unbound)
    176       (issues    :default eieio-unbound)
    177       (labels    :default eieio-unbound)
    178       (revnotes  :default eieio-unbound)
    179       (pullreqs  :default eieio-unbound)
    180       selective-p
    181       worktree
    182       (milestones :default eieio-unbound)])
    183 
    184     (assignee
    185      [(repository :not-null)
    186       (id :not-null :primary-key)
    187       login
    188       name
    189       forge-id] ; Needed for Gitlab.
    190      (:foreign-key
    191       [repository] :references repository [id]
    192       :on-delete :cascade))
    193 
    194     (fork
    195      [(parent :not-null)
    196       (id :not-null :primary-key)
    197       owner
    198       name]
    199      (:foreign-key
    200       [parent] :references repository [id]
    201       :on-delete :cascade))
    202 
    203     (issue
    204      [(class :not-null)
    205       (id :not-null :primary-key)
    206       repository
    207       number
    208       state
    209       author
    210       title
    211       created
    212       updated
    213       closed
    214       unread-p
    215       locked-p
    216       milestone
    217       body
    218       (assignees    :default eieio-unbound)
    219       (cards        :default eieio-unbound)
    220       (edits        :default eieio-unbound)
    221       (labels       :default eieio-unbound)
    222       (participants :default eieio-unbound)
    223       (posts        :default eieio-unbound)
    224       (reactions    :default eieio-unbound)
    225       (timeline     :default eieio-unbound)
    226       (marks        :default eieio-unbound)
    227       note]
    228      (:foreign-key
    229       [repository] :references repository [id]
    230       :on-delete :cascade))
    231 
    232     (issue-assignee
    233      [(issue :not-null)
    234       (id :not-null)]
    235      (:foreign-key
    236       [issue] :references issue [id]
    237       :on-delete :cascade))
    238 
    239     (issue-label
    240      [(issue :not-null)
    241       (id :not-null)]
    242      (:foreign-key
    243       [issue] :references issue [id]
    244       :on-delete :cascade)
    245      (:foreign-key
    246       [id] :references label [id]
    247       :on-delete :cascade))
    248 
    249     (issue-mark
    250      [(issue :not-null)
    251       (id :not-null)]
    252      (:foreign-key
    253       [issue] :references issue [id]
    254       :on-delete :cascade)
    255      (:foreign-key
    256       [id] :references mark [id]
    257       :on-delete :cascade))
    258 
    259     (issue-post
    260      [(class :not-null)
    261       (id :not-null :primary-key)
    262       issue
    263       number
    264       author
    265       created
    266       updated
    267       body
    268       (edits :default eieio-unbound)
    269       (reactions :default eieio-unbound)]
    270      (:foreign-key
    271       [issue] :references issue [id]
    272       :on-delete :cascade))
    273 
    274     (label
    275      [(repository :not-null)
    276       (id :not-null :primary-key)
    277       name
    278       color
    279       description]
    280      (:foreign-key
    281       [repository] :references repository [id]
    282       :on-delete :cascade))
    283 
    284     (mark
    285      [;; For now this is always nil because it seems more useful to
    286       ;; share marks between repositories.  We cannot omit this slot
    287       ;; though because `closql--iref' expects `id' to be the second
    288       ;; slot.
    289       repository
    290       (id :not-null :primary-key)
    291       name
    292       face
    293       description])
    294 
    295     (milestone
    296      [(repository :not-null)
    297       (id :not-null :primary-key)
    298       number
    299       title
    300       created
    301       updated
    302       due
    303       closed
    304       description]
    305      (:foreign-key
    306       [repository] :references repository [id]
    307       :on-delete :cascade))
    308 
    309     (notification
    310      [(class :not-null)
    311       (id :not-null :primary-key)
    312       thread-id
    313       repository
    314       forge
    315       reason
    316       unread-p
    317       last-read
    318       updated
    319       title
    320       type
    321       topic
    322       url]
    323      (:foreign-key
    324       [repository] :references repository [id]
    325       :on-delete :cascade))
    326 
    327     (pullreq
    328      [(class :not-null)
    329       (id :not-null :primary-key)
    330       repository
    331       number
    332       state
    333       author
    334       title
    335       created
    336       updated
    337       closed
    338       merged
    339       unread-p
    340       locked-p
    341       editable-p
    342       cross-repo-p
    343       base-ref
    344       base-repo
    345       head-ref
    346       head-user
    347       head-repo
    348       milestone
    349       body
    350       (assignees       :default eieio-unbound)
    351       (cards           :default eieio-unbound)
    352       (commits         :default eieio-unbound)
    353       (edits           :default eieio-unbound)
    354       (labels          :default eieio-unbound)
    355       (participants    :default eieio-unbound)
    356       (posts           :default eieio-unbound)
    357       (reactions       :default eieio-unbound)
    358       (review-requests :default eieio-unbound)
    359       (reviews         :default eieio-unbound)
    360       (timeline        :default eieio-unbound)
    361       (marks           :default eieio-unbound)
    362       note]
    363      (:foreign-key
    364       [repository] :references repository [id]
    365       :on-delete :cascade))
    366 
    367     (pullreq-assignee
    368      [(pullreq :not-null)
    369       (id :not-null)]
    370      (:foreign-key
    371       [pullreq] :references pullreq [id]
    372       :on-delete :cascade))
    373 
    374     (pullreq-label
    375      [(pullreq :not-null)
    376       (id :not-null)]
    377      (:foreign-key
    378       [pullreq] :references pullreq [id]
    379       :on-delete :cascade)
    380      (:foreign-key
    381       [id] :references label [id]
    382       :on-delete :cascade))
    383 
    384     (pullreq-mark
    385      [(pullreq :not-null)
    386       (id :not-null)]
    387      (:foreign-key
    388       [pullreq] :references pullreq [id]
    389       :on-delete :cascade)
    390      (:foreign-key
    391       [id] :references mark [id]
    392       :on-delete :cascade))
    393 
    394     (pullreq-post
    395      [(class :not-null)
    396       (id :not-null :primary-key)
    397       pullreq
    398       number
    399       author
    400       created
    401       updated
    402       body
    403       (edits :default eieio-unbound)
    404       (reactions :default eieio-unbound)]
    405      (:foreign-key
    406       [pullreq] :references pullreq [id]
    407       :on-delete :cascade))
    408 
    409     (pullreq-review-request
    410      [(pullreq :not-null)
    411       (id :not-null)]
    412      (:foreign-key
    413       [pullreq] :references pullreq [id]
    414       :on-delete :cascade))
    415 
    416     (revnote
    417      [(class :not-null)
    418       (id :not-null :primary-key)
    419       repository
    420       commit
    421       file
    422       line
    423       author
    424       body]
    425      (:foreign-key
    426       [repository] :references repository [id]
    427       :on-delete :cascade))))
    428 
    429 (cl-defmethod closql--db-init ((db forge-database))
    430   (emacsql-with-transaction db
    431     (pcase-dolist (`(,table . ,schema) forge--db-table-schemata)
    432       (emacsql db [:create-table $i1 $S2] table schema))
    433     (closql--db-set-version db forge--db-version)))
    434 
    435 (defun forge--db-maybe-update (db version)
    436   (emacsql-with-transaction db
    437     (when (= version 2)
    438       (message "Upgrading Forge database from version 2 to 3...")
    439       (emacsql db [:create-table pullreq-review-request $S1]
    440                (cdr (assq 'pullreq-review-request forge--db-table-schemata)))
    441       (closql--db-set-version db (setq version 3))
    442       (message "Upgrading Forge database from version 2 to 3...done"))
    443     (when (= version 3)
    444       (message "Upgrading Forge database from version 3 to 4...")
    445       (emacsql db [:drop-table notification])
    446       (pcase-dolist (`(,table . ,schema) forge--db-table-schemata)
    447         (when (memq table '(notification
    448                             mark issue-mark pullreq-mark))
    449           (emacsql db [:create-table $i1 $S2] table schema)))
    450       (emacsql db [:alter-table issue   :add-column marks :default $s1] 'eieio-unbound)
    451       (emacsql db [:alter-table pullreq :add-column marks :default $s1] 'eieio-unbound)
    452       (closql--db-set-version db (setq version 4))
    453       (message "Upgrading Forge database from version 3 to 4...done"))
    454     (when (= version 4)
    455       (message "Upgrading Forge database from version 4 to 5...")
    456       (emacsql db [:alter-table repository :add-column selective-p :default nil])
    457       (closql--db-set-version db (setq version 5))
    458       (message "Upgrading Forge database from version 4 to 5...done"))
    459     (when (= version 5)
    460       (message "Upgrading Forge database from version 5 to 6...")
    461       (emacsql db [:alter-table repository :add-column worktree :default nil])
    462       (closql--db-set-version db (setq version 6))
    463       (message "Upgrading Forge database from version 5 to 6...done"))
    464     (when (= version 6)
    465       (message "Upgrading Forge database from version 6 to 7...")
    466       (emacsql db [:alter-table issue   :add-column note :default nil])
    467       (emacsql db [:alter-table pullreq :add-column note :default nil])
    468       (emacsql db [:create-table milestone $S1]
    469                (cdr (assq 'milestone forge--db-table-schemata)))
    470       (emacsql db [:alter-table repository :add-column milestones :default $s1]
    471                'eieio-unbound)
    472       (pcase-dolist (`(,repo-id ,issue-id ,milestone)
    473                      (emacsql db [:select [repository id milestone]
    474                                   :from issue
    475                                   :where (notnull milestone)]))
    476         (unless (stringp milestone)
    477           (oset (forge-get-issue issue-id) milestone
    478                 (forge--object-id repo-id (cdar milestone)))))
    479       (pcase-dolist (`(,repo-id ,pullreq-id ,milestone)
    480                      (emacsql db [:select [repository id milestone]
    481                                   :from pullreq
    482                                   :where (notnull milestone)]))
    483         (unless (stringp milestone)
    484           (oset (forge-get-pullreq pullreq-id) milestone
    485                 (forge--object-id repo-id (cdar milestone)))))
    486       (closql--db-set-version db (setq version 7))
    487       (message "Upgrading Forge database from version 6 to 7...done"))
    488     ;; Going forward create a backup before upgrading:
    489     ;; (message "Upgrading Forge database from version 7 to 8...")
    490     ;; (copy-file forge-database-file (concat forge-database-file "-v7"))
    491     version))
    492 
    493 ;;; _
    494 (provide 'forge-db)
    495 ;;; forge-db.el ends here