From 3112aded28ad8d17d30980168d6340b6391f0d14 Mon Sep 17 00:00:00 2001
From: Jonas Bernoulli <jonas@bernoul.li>
Date: Tue, 12 Jan 2021 21:32:50 +0100
Subject: [PATCH] forge-merge: New command

Upstream documentation at:
- https://docs.gitlab.com/ee/api/merge_requests.html#accept-mr
- https://docs.github.com/en/free-pro-team@latest/rest/reference/pulls#merge-a-pull-request

Closes #96.
---
 lisp/forge-commands.el | 30 ++++++++++++++++++++++++++++++
 lisp/forge-github.el   |  7 +++++++
 lisp/forge-gitlab.el   |  7 +++++++
 lisp/forge.el          |  3 +++
 4 files changed, 47 insertions(+)

diff --git a/lisp/forge-commands.el b/lisp/forge-commands.el
index 5a4ac370..ecee1d5d 100644
--- a/lisp/forge-commands.el
+++ b/lisp/forge-commands.el
@@ -915,6 +915,36 @@ This may take a while.  Only Github is supported at the moment."
          (read-string "Organization: ")))
   (forge--add-organization-repos 'forge-github-repository host organization))
 
+;;;###autoload
+(defun forge-merge (n method)
+  "Merge the current pull-request using METHOD using the forge's API.
+
+If there is no current pull-request or with a prefix argument,
+then read pull-request N to visit instead.
+
+Use of this command is discouraged.  Unless the remote repository
+is configured to disallow that, you should instead merge locally
+and then push the target branch.  Forges detect that you have
+done that and respond by automatically marking the pull-request
+as merged."
+  (interactive
+   (list (forge-read-pullreq "Merge pull-request" t)
+         (if (forge--childp (forge-get-repository t) 'forge-gitlab-repository)
+             (magit-read-char-case "Merge method " t
+               (?m "[m]erge"  'merge)
+               (?s "[s]quash" 'squash))
+           (magit-read-char-case "Merge method " t
+             (?m "[m]erge"  'merge)
+             (?s "[s]quash" 'squash)
+             (?r "[r]ebase" 'rebase)))))
+  (forge--merge-pullreq (forge-get-repository t)
+                        (forge-get-pullreq n)
+                        (magit-rev-hash
+                         (forge--pullreq-branch-internal
+                          (forge-get-pullreq n)))
+                        method)
+  (forge-pull))
+
 ;;;###autoload
 (defun forge-remove-repository (host owner name)
   "Remove a repository from the database."
diff --git a/lisp/forge-github.el b/lisp/forge-github.el
index 52acff24..fc676ef3 100644
--- a/lisp/forge-github.el
+++ b/lisp/forge-github.el
@@ -652,6 +652,13 @@
            `((organization . ,fork))))
     (ghub-wait (format "/repos/%s/%s" fork name) nil :auth 'forge)))
 
+(cl-defmethod forge--merge-pullreq ((_repo forge-github-repository)
+                                    topic hash method)
+  (forge--ghub-put topic
+    "/repos/:owner/:repo/pulls/:number/merge"
+    `((merge_method . ,(symbol-name method))
+      ,@(and hash `((sha . ,hash))))))
+
 ;;; Utilities
 
 (cl-defun forge--ghub-get (obj resource
diff --git a/lisp/forge-gitlab.el b/lisp/forge-gitlab.el
index c5d2700f..32f74fbf 100644
--- a/lisp/forge-gitlab.el
+++ b/lisp/forge-gitlab.el
@@ -543,6 +543,13 @@
     (ghub-wait (format "/projects/%s%%2F%s" fork name)
                nil :auth 'forge :forge 'gitlab)))
 
+(cl-defmethod forge--merge-pullreq ((_repo forge-gitlab-repository)
+                                    topic hash method)
+  (forge--glab-put topic
+    "/projects/:project/merge_requests/:number/merge"
+    `((squash . ,(if (eq method 'squash) "true" "false"))
+      ,@(and hash `((sha . ,hash))))))
+
 ;;; Utilities
 
 (cl-defmethod forge--topic-type-prefix ((_repo forge-gitlab-repository) type)
diff --git a/lisp/forge.el b/lisp/forge.el
index 2277d884..0d8b6eec 100644
--- a/lisp/forge.el
+++ b/lisp/forge.el
@@ -105,6 +105,9 @@
 (transient-append-suffix 'magit-status-jump "'p"
   '("'i" "issues" forge-jump-to-issues))
 
+(transient-append-suffix 'magit-merge "a"
+  '(7 "f" "Merge using API" forge-merge))
+
 ;;; Startup Asserts
 
 (defconst forge--minimal-git "2.7.0")