dotemacs

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

forge-gitlab.el (28081B)


      1 ;;; forge-gitlab.el --- Gitlab support            -*- 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 'glab)
     27 
     28 (require 'forge)
     29 (require 'forge-issue)
     30 (require 'forge-pullreq)
     31 
     32 ;;; Class
     33 
     34 (defclass forge-gitlab-repository (forge-repository)
     35   ((issues-url-format         :initform "https://%h/%o/%n/issues")
     36    (issue-url-format          :initform "https://%h/%o/%n/issues/%i")
     37    (issue-post-url-format     :initform "https://%h/%o/%n/issues/%i#note_%I")
     38    (pullreqs-url-format       :initform "https://%h/%o/%n/merge_requests")
     39    (pullreq-url-format        :initform "https://%h/%o/%n/merge_requests/%i")
     40    (pullreq-post-url-format   :initform "https://%h/%o/%n/merge_requests/%i#note_%I")
     41    (commit-url-format         :initform "https://%h/%o/%n/commit/%r")
     42    (branch-url-format         :initform "https://%h/%o/%n/commits/%r")
     43    (remote-url-format         :initform "https://%h/%o/%n")
     44    (create-issue-url-format   :initform "https://%h/%o/%n/issues/new")
     45    (create-pullreq-url-format :initform "https://%h/%o/%n/merge_requests/new")
     46    (pullreq-refspec :initform "+refs/merge-requests/*/head:refs/pullreqs/*")))
     47 
     48 ;;; Pull
     49 ;;;; Repository
     50 
     51 (cl-defmethod forge--pull ((repo forge-gitlab-repository) until)
     52   (let ((cb (let ((buf (and (derived-mode-p 'magit-mode)
     53                             (current-buffer)))
     54                   (dir default-directory)
     55                   (val nil))
     56               (lambda (cb &optional v)
     57                 (when v (if val (push v val) (setq val v)))
     58                 (let-alist val
     59                   (cond
     60                    ((not val)
     61                     (forge--fetch-repository repo cb))
     62                    ((not (assq 'assignees val))
     63                     (forge--fetch-assignees repo cb))
     64                    ((not (assq 'forks val))
     65                     (forge--fetch-forks repo cb))
     66                    ((not (assq 'labels val))
     67                     (forge--fetch-labels repo cb))
     68                    ((and .issues_enabled
     69                          (not (assq 'issues val)))
     70                     (forge--fetch-issues repo cb until))
     71                    ((and .merge_requests_enabled
     72                          (not (assq 'pullreqs val)))
     73                     (forge--fetch-pullreqs repo cb until))
     74                    (t
     75                     (forge--msg repo t t   "Pulling REPO")
     76                     (forge--msg repo t nil "Storing REPO")
     77                     (emacsql-with-transaction (forge-db)
     78                       (forge--update-repository repo val)
     79                       (forge--update-assignees  repo .assignees)
     80                       (forge--update-labels     repo .labels)
     81                       (dolist (v .issues)   (forge--update-issue repo v))
     82                       (dolist (v .pullreqs) (forge--update-pullreq repo v))
     83                       (oset repo sparse-p nil))
     84                     (forge--msg repo t t "Storing REPO")
     85                     (unless (oref repo selective-p)
     86                       (forge--git-fetch buf dir repo)))))))))
     87     (funcall cb cb)))
     88 
     89 (cl-defmethod forge--fetch-repository ((repo forge-gitlab-repository) callback)
     90   (forge--glab-get repo "/projects/:project" nil
     91     :callback (lambda (value _headers _status _req)
     92                 (cond ((oref repo selective-p)
     93                        (setq value (append '((assignees) (forks) (labels)
     94                                              (issues) (pullreqs))
     95                                            value)))
     96                       ((magit-get-boolean "forge.omitExpensive")
     97                        (setq value (append '((assignees) (forks) (labels))
     98                                            value))))
     99                 (funcall callback callback value))))
    100 
    101 (cl-defmethod forge--update-repository ((repo forge-gitlab-repository) data)
    102   (let-alist data
    103     (oset repo created        .created_at)
    104     (oset repo updated        .last_activity_at)
    105     (oset repo pushed         nil)
    106     (oset repo parent         .forked_from_project.path_with_namespace)
    107     (oset repo description    .description)
    108     (oset repo homepage       nil)
    109     (oset repo default-branch .default_branch)
    110     (oset repo archived-p     .archived)
    111     (oset repo fork-p         (and .forked_from_project.path_with_namespace t))
    112     (oset repo locked-p       nil)
    113     (oset repo mirror-p       .mirror)
    114     (oset repo private-p      (equal .visibility "private"))
    115     (oset repo issues-p       .issues_enabled)
    116     (oset repo wiki-p         .wiki_enabled)
    117     (oset repo stars          .star_count)
    118     (oset repo watchers       .star_count)))
    119 
    120 (cl-defmethod forge--split-url-path
    121   ((_class (subclass forge-gitlab-repository)) path)
    122   (and (string-match "\\`\\(?:~?\\(.+\\)/\\)?\\([^/]+?\\)\\'" path)
    123        (list (match-string 1 path)
    124              (match-string 2 path))))
    125 
    126 ;;;; Issues
    127 
    128 (cl-defmethod forge--fetch-issues ((repo forge-gitlab-repository) callback until)
    129   (let ((cb (let (val cur cnt pos)
    130               (lambda (cb &optional v)
    131                 (cond
    132                  ((not pos)
    133                   (if (setq cur (setq val v))
    134                       (progn
    135                         (setq pos 1)
    136                         (setq cnt (length val))
    137                         (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt)
    138                         (forge--fetch-issue-posts repo cur cb))
    139                     (forge--msg repo t t "Pulling REPO issues")
    140                     (funcall callback callback (cons 'issues val))))
    141                  (t
    142                   (if (setq cur (cdr cur))
    143                       (progn
    144                         (cl-incf pos)
    145                         (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt)
    146                         (forge--fetch-issue-posts repo cur cb))
    147                     (forge--msg repo t t "Pulling REPO issues")
    148                     (funcall callback callback (cons 'issues val)))))))))
    149     (forge--msg repo t nil "Pulling REPO issues")
    150     (forge--glab-get repo "/projects/:project/issues"
    151       `((per_page . 100)
    152         (order_by . "updated_at")
    153         (updated_after . ,(forge--topics-until repo until 'issue)))
    154       :unpaginate t
    155       :callback (lambda (value _headers _status _req)
    156                   (funcall cb cb value)))))
    157 
    158 (cl-defmethod forge--fetch-issue-posts ((repo forge-gitlab-repository) cur cb)
    159   (let-alist (car cur)
    160     (forge--glab-get repo
    161       (format "/projects/%s/issues/%s/notes" .project_id .iid)
    162       '((per_page . 100))
    163       :unpaginate t
    164       :callback (lambda (value _headers _status _req)
    165                   (setf (alist-get 'notes (car cur)) value)
    166                   (funcall cb cb)))))
    167 
    168 (cl-defmethod forge--update-issue ((repo forge-gitlab-repository) data)
    169   (emacsql-with-transaction (forge-db)
    170     (let-alist data
    171       (let* ((issue-id (forge--object-id 'forge-issue repo .iid))
    172              (issue
    173               (forge-issue
    174                :id           issue-id
    175                :repository   (oref repo id)
    176                :number       .iid
    177                :state        (pcase-exhaustive .state
    178                                ("closed" 'closed)
    179                                ("opened" 'open))
    180                :author       .author.username
    181                :title        .title
    182                :created      .created_at
    183                :updated      .updated_at
    184                ;; `.closed_at' may be nil even though the issues is
    185                ;; closed.  In such cases use 1, so that this slots
    186                ;; at least can serve as a boolean.
    187                :closed       (or .closed_at (and (equal .state "closed") 1))
    188                :locked-p     .discussion_locked
    189                :milestone    .milestone.iid
    190                :body         (forge--sanitize-string .description))))
    191         (closql-insert (forge-db) issue t)
    192         (unless (magit-get-boolean "forge.omitExpensive")
    193           (forge--set-id-slot repo issue 'assignees .assignees)
    194           (forge--set-id-slot repo issue 'labels .labels))
    195         .body .id ; Silence Emacs 25 byte-compiler.
    196         (dolist (c .notes)
    197           (let-alist c
    198             (let ((post
    199                    (forge-issue-post
    200                     :id      (forge--object-id issue-id .id)
    201                     :issue   issue-id
    202                     :number  .id
    203                     :author  .author.username
    204                     :created .created_at
    205                     :updated .updated_at
    206                     :body    (forge--sanitize-string .body))))
    207               (closql-insert (forge-db) post t))))))))
    208 
    209 ;;;; Pullreqs
    210 
    211 (cl-defmethod forge--fetch-pullreqs ((repo forge-gitlab-repository) callback until)
    212   (let ((cb (let (val cur cnt pos)
    213               (lambda (cb &optional v)
    214                 (cond
    215                  ((not pos)
    216                   (if (setq cur (setq val v))
    217                       (progn
    218                         (setq pos 1)
    219                         (setq cnt (length val))
    220                         (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt)
    221                         (forge--fetch-pullreq-posts repo cur cb))
    222                     (forge--msg repo t t "Pulling REPO pullreqs")
    223                     (funcall callback callback (cons 'pullreqs val))))
    224                  ((not (assq 'source_project (car cur)))
    225                   (forge--fetch-pullreq-source-repo repo cur cb))
    226                  ((not (assq 'target_project (car cur)))
    227                   (forge--fetch-pullreq-target-repo repo cur cb))
    228                  (t
    229                   (if (setq cur (cdr cur))
    230                       (progn
    231                         (cl-incf pos)
    232                         (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt)
    233                         (forge--fetch-pullreq-posts repo cur cb))
    234                     (forge--msg repo t t "Pulling REPO pullreqs")
    235                     (funcall callback callback (cons 'pullreqs val)))))))))
    236     (forge--msg repo t nil "Pulling REPO pullreqs")
    237     (forge--glab-get repo "/projects/:project/merge_requests"
    238       `((per_page . 100)
    239         (order_by . "updated_at")
    240         (updated_after . ,(forge--topics-until repo until 'pullreq)))
    241       :unpaginate t
    242       :callback (lambda (value _headers _status _req)
    243                   (funcall cb cb value)))))
    244 
    245 (cl-defmethod forge--fetch-pullreq-posts
    246   ((repo forge-gitlab-repository) cur cb)
    247   (let-alist (car cur)
    248     (forge--glab-get repo
    249       (format "/projects/%s/merge_requests/%s/notes" .target_project_id .iid)
    250       '((per_page . 100))
    251       :unpaginate t
    252       :callback (lambda (value _headers _status _req)
    253                   (setf (alist-get 'notes (car cur)) value)
    254                   (funcall cb cb)))))
    255 
    256 (cl-defmethod forge--fetch-pullreq-source-repo
    257   ((repo forge-gitlab-repository) cur cb)
    258   ;; If the fork no longer exists, then `.source_project_id' is nil.
    259   ;; This will lead to difficulties later on but there is nothing we
    260   ;; can do about it.
    261   (let-alist (car cur)
    262     (if .source_project_id
    263         (forge--glab-get repo (format "/projects/%s" .source_project_id) nil
    264           :errorback (lambda (_err _headers _status _req)
    265                        (setf (alist-get 'source_project (car cur)) nil)
    266                        (funcall cb cb))
    267           :callback (lambda (value _headers _status _req)
    268                       (setf (alist-get 'source_project (car cur)) value)
    269                       (funcall cb cb)))
    270       (setf (alist-get 'source_project (car cur)) nil)
    271       (funcall cb cb))))
    272 
    273 (cl-defmethod forge--fetch-pullreq-target-repo
    274   ((repo forge-gitlab-repository) cur cb)
    275   (let-alist (car cur)
    276     (forge--glab-get repo (format "/projects/%s" .target_project_id) nil
    277       :errorback (lambda (_err _headers _status _req)
    278                    (setf (alist-get 'source_project (car cur)) nil)
    279                    (funcall cb cb))
    280       :callback (lambda (value _headers _status _req)
    281                   (setf (alist-get 'target_project (car cur)) value)
    282                   (funcall cb cb)))))
    283 
    284 (cl-defmethod forge--update-pullreq ((repo forge-gitlab-repository) data)
    285   (emacsql-with-transaction (forge-db)
    286     (let-alist data
    287       (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .iid))
    288              (pullreq
    289               (forge-pullreq
    290                :id           pullreq-id
    291                :repository   (oref repo id)
    292                :number       .iid
    293                :state        (pcase-exhaustive .state
    294                                ("merged" 'merged)
    295                                ("closed" 'closed)
    296                                ("opened" 'open))
    297                :author       .author.username
    298                :title        .title
    299                :created      .created_at
    300                :updated      .updated_at
    301                ;; `.merged_at' and `.closed_at' may both be nil even
    302                ;; though the pullreq is merged or otherwise closed.
    303                ;; In such cases use 1, so that these slots at least
    304                ;; can serve as booleans.
    305                :closed       (or .closed_at
    306                                  (and (member .state '("closed" "merged")) 1))
    307                :merged       (or .merged_at
    308                                  (and (equal .state "merged") 1))
    309                :locked-p     .discussion_locked
    310                :editable-p   .allow_maintainer_to_push
    311                :cross-repo-p (not (equal .source_project_id
    312                                          .target_project_id))
    313                :base-ref     .target_branch
    314                :base-repo    .target_project.path_with_namespace
    315                :head-ref     .source_branch
    316                :head-user    .source_project.owner.username
    317                :head-repo    .source_project.path_with_namespace
    318                :milestone    .milestone.iid
    319                :body         (forge--sanitize-string .description))))
    320         (closql-insert (forge-db) pullreq t)
    321         (unless (magit-get-boolean "forge.omitExpensive")
    322           (forge--set-id-slot repo pullreq 'assignees (list .assignee))
    323           (forge--set-id-slot repo pullreq 'labels .labels))
    324         .body .id ; Silence Emacs 25 byte-compiler.
    325         (dolist (c .notes)
    326           (let-alist c
    327             (let ((post
    328                    (forge-pullreq-post
    329                     :id      (forge--object-id pullreq-id .id)
    330                     :pullreq pullreq-id
    331                     :number  .id
    332                     :author  .author.username
    333                     :created .created_at
    334                     :updated .updated_at
    335                     :body    (forge--sanitize-string .body))))
    336               (closql-insert (forge-db) post t))))))))
    337 
    338 ;;;; Other
    339 
    340 ;; The extend of the documentation for "GET /projects/:id/users" is
    341 ;; "Get the users list of a project."  I don't know what that means,
    342 ;; but it stands to reason that this must at least overlap with the
    343 ;; set of users that can be assigned to topics.
    344 
    345 (cl-defmethod forge--fetch-assignees ((repo forge-gitlab-repository) callback)
    346   (forge--glab-get repo "/projects/:project/users"
    347     '((per_page . 100))
    348     :unpaginate t
    349     :callback (lambda (value _headers _status _req)
    350                 (funcall callback callback (cons 'assignees value)))))
    351 
    352 (cl-defmethod forge--update-assignees ((repo forge-gitlab-repository) data)
    353   (oset repo assignees
    354         (with-slots (id) repo
    355           (mapcar (lambda (row)
    356                     (let-alist row
    357                       ;; For other forges we don't need to store `id'
    358                       ;; but here we do because that's what has to be
    359                       ;; used when assigning issues.
    360                       (list (forge--object-id id .id)
    361                             .username
    362                             .name
    363                             .id)))
    364                   data))))
    365 
    366 (cl-defmethod forge--fetch-forks ((repo forge-gitlab-repository) callback)
    367   (forge--glab-get repo "/projects/:project/forks"
    368     '((per_page . 100)
    369       (simple . "true"))
    370     :unpaginate t
    371     :callback (lambda (value _headers _status _req)
    372                 (funcall callback callback (cons 'forks value)))))
    373 
    374 (cl-defmethod forge--update-forks ((repo forge-gitlab-repository) data)
    375   (oset repo forks
    376         (with-slots (id) repo
    377           (mapcar (lambda (row)
    378                     (let-alist row
    379                       (nconc (forge--repository-ids
    380                               (eieio-object-class repo)
    381                               (oref repo githost)
    382                               .namespace.path
    383                               .path)
    384                              (list .namespace.path
    385                                    .path))))
    386                   data))))
    387 
    388 (cl-defmethod forge--fetch-labels ((repo forge-gitlab-repository) callback)
    389   (forge--glab-get repo "/projects/:project/labels"
    390     '((per_page . 100))
    391     :unpaginate t
    392     :callback (lambda (value _headers _status _req)
    393                 (funcall callback callback (cons 'labels value)))))
    394 
    395 (cl-defmethod forge--update-labels ((repo forge-gitlab-repository) data)
    396   (oset repo labels
    397         (with-slots (id) repo
    398           (mapcar (lambda (row)
    399                     (let-alist row
    400                       ;; We should use the label's `id' instead of its
    401                       ;; `name' but a topic's `labels' field is a list
    402                       ;; of names instead of a list of ids or an alist.
    403                       ;; As a result of this we cannot recognize when
    404                       ;; a label is renamed and a topic continues to be
    405                       ;; tagged with the old label name until it itself
    406                       ;; is modified somehow.  Additionally it leads to
    407                       ;; name conflicts between group and project
    408                       ;; labels.  See #160.
    409                       (list (forge--object-id id .name)
    410                             .name
    411                             (downcase .color)
    412                             .description)))
    413                   ;; For now simply remove one of the duplicates.
    414                   (cl-delete-duplicates data
    415                                         :key (apply-partially #'alist-get 'name)
    416                                         :test #'equal)))))
    417 
    418 ;;;; Notifications
    419 
    420 ;; The closest to notifications that Gitlab provides are "events" as
    421 ;; described at https://docs.gitlab.com/ee/api/events.html.  This
    422 ;; allows us to see the last events that took place, but that is not
    423 ;; good enough because we are mostly interested in events we haven't
    424 ;; looked at yet.  Gitlab doesn't make a distinction between unread
    425 ;; and read events, so this is rather useless and we don't use it for
    426 ;; the time being.
    427 
    428 ;;; Mutations
    429 
    430 (cl-defmethod forge--submit-create-pullreq ((_ forge-gitlab-repository) base-repo)
    431   (let-alist (forge--topic-parse-buffer)
    432     (pcase-let* ((`(,base-remote . ,base-branch)
    433                   (magit-split-branch-name forge--buffer-base-branch))
    434                  (`(,head-remote . ,head-branch)
    435                   (magit-split-branch-name forge--buffer-head-branch))
    436                  (head-repo (forge-get-repository 'stub head-remote)))
    437       (forge--glab-post head-repo "/projects/:project/merge_requests"
    438         `(,@(and (not (equal head-remote base-remote))
    439                  `((target_project_id . ,(oref base-repo forge-id))))
    440           (target_branch . ,base-branch)
    441           (source_branch . ,head-branch)
    442           (title         . , .title)
    443           (description   . , .body)
    444           (allow_collaboration . t))
    445         :callback  (forge--post-submit-callback)
    446         :errorback (forge--post-submit-errorback)))))
    447 
    448 (cl-defmethod forge--submit-create-issue ((_ forge-gitlab-repository) repo)
    449   (let-alist (forge--topic-parse-buffer)
    450     (forge--glab-post repo "/projects/:project/issues"
    451       `((title       . , .title)
    452         (description . , .body))
    453       :callback  (forge--post-submit-callback)
    454       :errorback (forge--post-submit-errorback))))
    455 
    456 (cl-defmethod forge--submit-create-post ((_ forge-gitlab-repository) topic)
    457   (forge--glab-post topic
    458     (if (forge-issue-p topic)
    459         "/projects/:project/issues/:number/notes"
    460       "/projects/:project/merge_requests/:number/notes")
    461     `((body . ,(string-trim (buffer-string))))
    462     :callback  (forge--post-submit-callback)
    463     :errorback (forge--post-submit-errorback)))
    464 
    465 (cl-defmethod forge--submit-edit-post ((_ forge-gitlab-repository) post)
    466   (forge--glab-put post
    467     (cl-etypecase post
    468       (forge-pullreq "/projects/:project/merge_requests/:number")
    469       (forge-issue   "/projects/:project/issues/:number")
    470       (forge-issue-post "/projects/:project/issues/:topic/notes/:number")
    471       (forge-pullreq-post "/projects/:project/merge_requests/:topic/notes/:number"))
    472     (if (cl-typep post 'forge-topic)
    473         (let-alist (forge--topic-parse-buffer)
    474           ;; Keep Gitlab from claiming that the user
    475           ;; changed the description when that isn't
    476           ;; true.  The same isn't necessary for the
    477           ;; title; in that case Gitlab performs the
    478           ;; necessary check itself.
    479           `((title . , .title)
    480             ,@(and (not (equal .body (oref post body)))
    481                    `((description . , .body)))))
    482       `((body . ,(string-trim (buffer-string)))))
    483     :callback  (forge--post-submit-callback)
    484     :errorback (forge--post-submit-errorback)))
    485 
    486 (cl-defmethod forge--set-topic-field
    487   ((_repo forge-gitlab-repository) topic field value)
    488   (forge--glab-put topic
    489     (cl-typecase topic
    490       (forge-pullreq "/projects/:project/merge_requests/:number")
    491       (forge-issue   "/projects/:project/issues/:number"))
    492     `((,field . ,value))
    493     :callback (forge--set-field-callback)))
    494 
    495 (cl-defmethod forge--set-topic-title
    496   ((repo forge-gitlab-repository) topic title)
    497   (forge--set-topic-field repo topic 'title title))
    498 
    499 (cl-defmethod forge--set-topic-state
    500   ((repo forge-gitlab-repository) topic)
    501   (forge--set-topic-field repo topic 'state_event
    502                           (cl-ecase (oref topic state)
    503                             (closed "reopen")
    504                             (open   "close"))))
    505 
    506 (cl-defmethod forge--set-topic-labels
    507   ((repo forge-gitlab-repository) topic labels)
    508   (forge--set-topic-field repo topic 'labels
    509                           (mapconcat #'identity labels ",")))
    510 
    511 (cl-defmethod forge--set-topic-assignees
    512   ((repo forge-gitlab-repository) topic assignees)
    513   (let ((users (mapcar #'cdr (oref repo assignees))))
    514     (cl-typecase topic
    515       (forge-pullreq ; Can only be assigned to a single user.
    516        (forge--set-topic-field repo topic 'assignee_id
    517                                (caddr (assoc (car assignees) users))))
    518       (forge-issue
    519        (forge--set-topic-field repo topic 'assignee_ids
    520                                (--map (caddr (assoc it users)) assignees))))))
    521 
    522 (cl-defmethod forge--delete-comment
    523   ((_repo forge-gitlab-repository) post)
    524   (forge--glab-delete post
    525     (cl-etypecase post
    526       (forge-pullreq-post
    527        "/projects/:project/merge_requests/:topic/notes/:number")
    528       (forge-issue-post
    529        "/projects/:project/issues/:topic/notes/:number")))
    530   (closql-delete post)
    531   (magit-refresh))
    532 
    533 (cl-defmethod forge--topic-templates ((repo forge-gitlab-repository)
    534                                       (_ (subclass forge-issue)))
    535   (--filter (string-match-p "\\`\\.gitlab/issue_templates/.+\\.md\\'" it)
    536             (magit-revision-files (oref repo default-branch))))
    537 
    538 (cl-defmethod forge--topic-templates ((repo forge-gitlab-repository)
    539                                       (_ (subclass forge-pullreq)))
    540   (--filter (string-match-p "\\`\\.gitlab/merge_request_templates/.+\\.md\\'" it)
    541             (magit-revision-files (oref repo default-branch))))
    542 
    543 (cl-defmethod forge--fork-repository ((repo forge-gitlab-repository) fork)
    544   (with-slots (owner name) repo
    545     (forge--glab-post repo (format "/projects/%s%%2F%s/fork" owner name)
    546       (and (not (equal fork (ghub--username (ghub--host nil))))
    547            `((namespace . ,fork)))
    548       :noerror t)
    549     (ghub-wait (format "/projects/%s%%2F%s" fork name)
    550                nil :auth 'forge :forge 'gitlab)))
    551 
    552 (cl-defmethod forge--merge-pullreq ((_repo forge-gitlab-repository)
    553                                     topic hash method)
    554   (forge--glab-put topic
    555     "/projects/:project/merge_requests/:number/merge"
    556     `((squash . ,(if (eq method 'squash) "true" "false"))
    557       ,@(and hash `((sha . ,hash))))))
    558 
    559 ;;; Utilities
    560 
    561 (cl-defmethod forge--topic-type-prefix ((_repo forge-gitlab-repository) type)
    562   (if (eq type 'pullreq) "!" "#"))
    563 
    564 (cl-defun forge--glab-get (obj resource
    565                                &optional params
    566                                &key query payload headers
    567                                silent unpaginate noerror reader
    568                                host callback errorback)
    569   (declare (indent defun))
    570   (glab-get (if obj (forge--format-resource obj resource) resource)
    571             params
    572             :host (or host (oref (forge-get-repository obj) apihost))
    573             :auth 'forge
    574             :query query :payload payload :headers headers
    575             :silent silent :unpaginate unpaginate
    576             :noerror noerror :reader reader
    577             :callback callback
    578             :errorback (or errorback (and callback t))))
    579 
    580 (cl-defun forge--glab-put (obj resource
    581                                &optional params
    582                                &key query payload headers
    583                                silent unpaginate noerror reader
    584                                host callback errorback)
    585   (declare (indent defun))
    586   (glab-put (if obj (forge--format-resource obj resource) resource)
    587             params
    588             :host (or host (oref (forge-get-repository obj) apihost))
    589             :auth 'forge
    590             :query query :payload payload :headers headers
    591             :silent silent :unpaginate unpaginate
    592             :noerror noerror :reader reader
    593             :callback callback
    594             :errorback (or errorback (and callback t))))
    595 
    596 (cl-defun forge--glab-post (obj resource
    597                                 &optional params
    598                                 &key query payload headers
    599                                 silent unpaginate noerror reader
    600                                 host callback errorback)
    601   (declare (indent defun))
    602   (glab-post (forge--format-resource obj resource)
    603              params
    604              :host (or host (oref (forge-get-repository obj) apihost))
    605              :auth 'forge
    606              :query query :payload payload :headers headers
    607              :silent silent :unpaginate unpaginate
    608              :noerror noerror :reader reader
    609              :callback callback
    610              :errorback (or errorback (and callback t))))
    611 
    612 (cl-defun forge--glab-delete (obj resource
    613                                   &optional params
    614                                   &key query payload headers
    615                                   silent unpaginate noerror reader
    616                                   host callback errorback)
    617   (declare (indent defun))
    618   (glab-delete (forge--format-resource obj resource)
    619                params
    620                :host (or host (oref (forge-get-repository obj) apihost))
    621                :auth 'forge
    622                :query query :payload payload :headers headers
    623                :silent silent :unpaginate unpaginate
    624                :noerror noerror :reader reader
    625                :callback callback
    626                :errorback (or errorback (and callback t))))
    627 
    628 ;;; _
    629 (provide 'forge-gitlab)
    630 ;;; forge-gitlab.el ends here