forge-github.el (32672B)
1 ;;; forge-github.el --- Github 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 'ghub) 27 28 (require 'forge) 29 (require 'forge-issue) 30 (require 'forge-pullreq) 31 32 ;;; Class 33 34 (defclass forge-github-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#issuecomment-%I") 38 (pullreqs-url-format :initform "https://%h/%o/%n/pulls") 39 (pullreq-url-format :initform "https://%h/%o/%n/pull/%i") 40 (pullreq-post-url-format :initform "https://%h/%o/%n/pull/%i#issuecomment-%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/compare") 46 (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*"))) 47 48 ;;; Pull 49 ;;;; Repository 50 51 (cl-defmethod forge--pull ((repo forge-github-repository) until 52 &optional callback) 53 (let ((buf (current-buffer)) 54 (dir default-directory) 55 (selective-p (oref repo selective-p))) 56 (ghub-fetch-repository 57 (oref repo owner) 58 (oref repo name) 59 (lambda (data) 60 (forge--msg repo t t "Pulling REPO") 61 (forge--msg repo t nil "Storing REPO") 62 (emacsql-with-transaction (forge-db) 63 (let-alist data 64 (forge--update-repository repo data) 65 (forge--update-assignees repo .assignableUsers) 66 (forge--update-forks repo .forks) 67 (forge--update-labels repo .labels) 68 (forge--update-milestones repo .milestones) 69 (forge--update-issues repo .issues t) 70 (forge--update-pullreqs repo .pullRequests t) 71 (forge--update-revnotes repo .commitComments)) 72 (oset repo sparse-p nil)) 73 (forge--msg repo t t "Storing REPO") 74 (cond 75 (selective-p) 76 (callback (funcall callback)) 77 (forge-pull-notifications 78 (forge--pull-notifications (eieio-object-class repo) 79 (oref repo githost) 80 (lambda () (forge--git-fetch buf dir repo)))) 81 (t (forge--git-fetch buf dir repo)))) 82 `((issues-until . ,(forge--topics-until repo until 'issue)) 83 (pullRequests-until . ,(forge--topics-until repo until 'pullreq))) 84 :host (oref repo apihost) 85 :auth 'forge 86 :sparse selective-p))) 87 88 (cl-defmethod forge--pull-topic ((repo forge-github-repository) 89 (topic forge-topic)) 90 (let ((buffer (current-buffer)) 91 (fetch #'ghub-fetch-issue) 92 (update #'forge--update-issue) 93 (errorback (lambda (err _headers _status _req) 94 (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND") 95 (forge--pull-topic 96 repo (forge-pullreq :repository (oref repo id) 97 :number (oref topic number))))))) 98 (when (cl-typep topic 'forge-pullreq) 99 (setq fetch #'ghub-fetch-pullreq) 100 (setq update #'forge--update-pullreq) 101 (setq errorback nil)) 102 (funcall 103 fetch 104 (oref repo owner) 105 (oref repo name) 106 (oref topic number) 107 (lambda (data) 108 (funcall update repo data nil) 109 (with-current-buffer 110 (if (buffer-live-p buffer) buffer (current-buffer)) 111 (magit-refresh))) 112 nil 113 :errorback errorback 114 :host (oref repo apihost) 115 :auth 'forge))) 116 117 (cl-defmethod forge--update-repository ((repo forge-github-repository) data) 118 (let-alist data 119 (oset repo created .createdAt) 120 (oset repo updated .updatedAt) 121 (oset repo pushed .pushedAt) 122 (oset repo parent .parent.nameWithOwner) 123 (oset repo description .description) 124 (oset repo homepage (and (not (equal .homepageUrl "")) .homepageUrl)) 125 (oset repo default-branch .defaultBranchRef.name) 126 (oset repo archived-p .isArchived) 127 (oset repo fork-p .isFork) 128 (oset repo locked-p .isLocked) 129 (oset repo mirror-p .isMirror) 130 (oset repo private-p .isPrivate) 131 (oset repo issues-p .hasIssuesEnabled) 132 (oset repo wiki-p .hasWikiEnabled) 133 (oset repo stars .stargazers.totalCount) 134 (oset repo watchers .watchers.totalCount))) 135 136 (cl-defmethod forge--update-issues ((repo forge-github-repository) data bump) 137 (emacsql-with-transaction (forge-db) 138 (mapc (lambda (e) (forge--update-issue repo e bump)) data))) 139 140 (cl-defmethod forge--update-issue ((repo forge-github-repository) data bump) 141 (emacsql-with-transaction (forge-db) 142 (let-alist data 143 (let* ((issue-id (forge--object-id 'forge-issue repo .number)) 144 (issue (or (forge-get-issue repo .number) 145 (closql-insert 146 (forge-db) 147 (forge-issue :id issue-id 148 :repository (oref repo id) 149 :number .number))))) 150 (oset issue id issue-id) 151 (oset issue state (pcase-exhaustive .state 152 ("CLOSED" 'closed) 153 ("OPEN" 'open))) 154 (oset issue author .author.login) 155 (oset issue title .title) 156 (oset issue created .createdAt) 157 (oset issue updated (cond (bump (or .updatedAt .createdAt)) 158 ((slot-boundp issue 'updated) 159 (oref issue updated)) 160 (t "0"))) 161 (oset issue closed .closedAt) 162 (oset issue locked-p .locked) 163 (oset issue milestone (and .milestone.id 164 (forge--object-id (oref repo id) 165 .milestone.id))) 166 (oset issue body (forge--sanitize-string .body)) 167 .databaseId ; Silence Emacs 25 byte-compiler. 168 (dolist (c .comments) 169 (let-alist c 170 (closql-insert 171 (forge-db) 172 (forge-issue-post 173 :id (forge--object-id issue-id .databaseId) 174 :issue issue-id 175 :number .databaseId 176 :author .author.login 177 :created .createdAt 178 :updated .updatedAt 179 :body (forge--sanitize-string .body)) 180 t))) 181 (when bump 182 (forge--set-id-slot repo issue 'assignees .assignees) 183 (unless (magit-get-boolean "forge.kludge-for-issue-294") 184 (forge--set-id-slot repo issue 'labels .labels))) 185 issue)))) 186 187 (cl-defmethod forge--update-pullreqs ((repo forge-github-repository) data bump) 188 (emacsql-with-transaction (forge-db) 189 (mapc (lambda (e) (forge--update-pullreq repo e bump)) data))) 190 191 (cl-defmethod forge--update-pullreq ((repo forge-github-repository) data bump) 192 (emacsql-with-transaction (forge-db) 193 (let-alist data 194 (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .number)) 195 (pullreq (or (forge-get-pullreq repo .number) 196 (closql-insert 197 (forge-db) 198 (forge-pullreq :id pullreq-id 199 :repository (oref repo id) 200 :number .number))))) 201 (oset pullreq state (pcase-exhaustive .state 202 ("MERGED" 'merged) 203 ("CLOSED" 'closed) 204 ("OPEN" 'open))) 205 (oset pullreq author .author.login) 206 (oset pullreq title .title) 207 (oset pullreq created .createdAt) 208 (oset pullreq updated (cond (bump (or .updatedAt .createdAt)) 209 ((slot-boundp pullreq 'updated) 210 (oref pullreq updated)) 211 (t "0"))) 212 (oset pullreq closed .closedAt) 213 (oset pullreq merged .mergedAt) 214 (oset pullreq locked-p .locked) 215 (oset pullreq editable-p .maintainerCanModify) 216 (oset pullreq cross-repo-p .isCrossRepository) 217 (oset pullreq base-ref .baseRef.name) 218 (oset pullreq base-repo .baseRef.repository.nameWithOwner) 219 (oset pullreq head-ref .headRef.name) 220 (oset pullreq head-user .headRef.repository.owner.login) 221 (oset pullreq head-repo .headRef.repository.nameWithOwner) 222 (oset pullreq milestone (and .milestone.id 223 (forge--object-id (oref repo id) 224 .milestone.id))) 225 (oset pullreq body (forge--sanitize-string .body)) 226 .databaseId ; Silence Emacs 25 byte-compiler. 227 (dolist (p .comments) 228 (let-alist p 229 (closql-insert 230 (forge-db) 231 (forge-pullreq-post 232 :id (forge--object-id pullreq-id .databaseId) 233 :pullreq pullreq-id 234 :number .databaseId 235 :author .author.login 236 :created .createdAt 237 :updated .updatedAt 238 :body (forge--sanitize-string .body)) 239 t))) 240 (when bump 241 (forge--set-id-slot repo pullreq 'assignees .assignees) 242 (forge--set-id-slot repo pullreq 'review-requests 243 (--map (cdr (cadr (car it))) 244 .reviewRequests)) 245 (unless (magit-get-boolean "forge.kludge-for-issue-294") 246 (forge--set-id-slot repo pullreq 'labels .labels))) 247 pullreq)))) 248 249 (cl-defmethod forge--update-revnotes ((repo forge-github-repository) data) 250 (emacsql-with-transaction (forge-db) 251 (mapc (apply-partially 'forge--update-revnote repo) data))) 252 253 (cl-defmethod forge--update-revnote ((repo forge-github-repository) data) 254 (emacsql-with-transaction (forge-db) 255 (let-alist data 256 (closql-insert 257 (forge-db) 258 (forge-revnote 259 :id (forge--object-id 'forge-revnote repo .id) 260 :repository (oref repo id) 261 :commit .commit.oid 262 :file .path 263 :line .position 264 :author .author.login 265 :body .body) 266 t)))) 267 268 (cl-defmethod forge--update-assignees ((repo forge-github-repository) data) 269 (oset repo assignees 270 (with-slots (id) repo 271 (mapcar (lambda (row) 272 (let-alist row 273 (list (forge--object-id id .id) 274 .login 275 .name 276 .id))) 277 (delete-dups data))))) 278 279 (cl-defmethod forge--update-forks ((repo forge-github-repository) data) 280 (oset repo forks 281 (with-slots (id) repo 282 (mapcar (lambda (row) 283 (let-alist row 284 (nconc (forge--repository-ids 285 (eieio-object-class repo) 286 (oref repo githost) 287 .owner.login 288 .name) 289 (list .owner.login 290 .name)))) 291 (delete-dups data))))) 292 293 (cl-defmethod forge--update-labels ((repo forge-github-repository) data) 294 (oset repo labels 295 (with-slots (id) repo 296 (mapcar (lambda (row) 297 (let-alist row 298 (list (forge--object-id id .id) 299 .name 300 (concat "#" (downcase .color)) 301 .description))) 302 (delete-dups data))))) 303 304 (cl-defmethod forge--update-milestones ((repo forge-github-repository) data) 305 (oset repo milestones 306 (with-slots (id) repo 307 (mapcar (lambda (row) 308 (let-alist row 309 (list (forge--object-id id .id) 310 .number 311 .title 312 .createdAt 313 .updatedAt 314 .dueOn 315 .closedAt 316 .description))) 317 (delete-dups data))))) 318 319 ;;;; Notifications 320 321 (cl-defmethod forge--pull-notifications 322 ((_class (subclass forge-github-repository)) githost &optional callback) 323 ;; The GraphQL API doesn't support notifications and also likes to 324 ;; timeout for handcrafted requests, forcing us to perform a major 325 ;; rain dance. 326 (let ((spec (assoc githost forge-alist))) 327 (unless spec 328 (error "No entry for %S in forge-alist" githost)) 329 (forge--msg nil t nil "Pulling notifications") 330 (pcase-let* 331 ((`(,_ ,apihost ,forge ,_) spec) 332 (notifs (-keep (lambda (data) 333 ;; Github may return notifications for repos 334 ;; the user no longer has access to. Trying 335 ;; to retrieve information for such a repo 336 ;; leads to an error, which we suppress. See #164. 337 (with-demoted-errors "forge--pull-notifications: %S" 338 (forge--ghub-massage-notification 339 data forge githost))) 340 (forge--ghub-get nil "/notifications" 341 '((all . "true")) 342 :host apihost :unpaginate t))) 343 (groups (-partition-all 50 notifs)) 344 (pages (length groups)) 345 (page 0) 346 (result nil)) 347 (cl-labels 348 ((cb (&optional data _headers _status _req) 349 (when data 350 (setq result (nconc result (cdr data)))) 351 (if groups 352 (progn (cl-incf page) 353 (forge--msg nil t nil 354 "Pulling notifications (page %s/%s)" 355 page pages) 356 (ghub--graphql-vacuum 357 (cons 'query (-keep #'caddr (pop groups))) 358 nil #'cb nil :auth 'forge :host apihost)) 359 (forge--msg nil t t "Pulling notifications") 360 (forge--msg nil t nil "Storing notifications") 361 (emacsql-with-transaction (forge-db) 362 (forge-sql [:delete-from notification 363 :where (= forge $s1)] forge) 364 (pcase-dolist (`(,key ,repo ,query ,obj) notifs) 365 (closql-insert (forge-db) obj) 366 (forge--zap-repository-cache (forge-get-repository obj)) 367 (when query 368 (oset (funcall (if (eq (oref obj type) 'issue) 369 #'forge--update-issue 370 #'forge--update-pullreq) 371 repo (cdr (cadr (assq key result))) nil) 372 unread-p (oref obj unread-p))))) 373 (forge--msg nil t t "Storing notifications") 374 (when callback 375 (funcall callback))))) 376 (cb))))) 377 378 (defun forge--ghub-massage-notification (data forge githost) 379 (let-alist data 380 (let* ((type (intern (downcase .subject.type))) 381 (type (if (eq type 'pullrequest) 'pullreq type))) 382 (and (memq type '(pullreq issue)) 383 (let* ((number (and (string-match "[0-9]*\\'" .subject.url) 384 (string-to-number (match-string 0 .subject.url)))) 385 (repo (forge-get-repository 386 (list githost 387 .repository.owner.login 388 .repository.name) 389 nil 'create)) 390 (repoid (oref repo id)) 391 (owner (oref repo owner)) 392 (name (oref repo name)) 393 (id (forge--object-id repoid (string-to-number .id))) 394 (alias (intern (concat "_" (replace-regexp-in-string 395 "=" "_" id))))) 396 (list alias repo 397 `((,alias repository) 398 [(name ,name) 399 (owner ,owner)] 400 ,@(cddr 401 (caddr 402 (ghub--graphql-prepare-query 403 ghub-fetch-repository 404 (if (eq type 'issue) 405 `(repository issues (issue . ,number)) 406 `(repository pullRequest (pullRequest . ,number))) 407 )))) 408 (forge-notification 409 :id id 410 :thread-id .id 411 :repository repoid 412 :forge forge 413 :reason (intern (downcase .reason)) 414 :unread-p .unread 415 :last-read .last_read_at 416 :updated .updated_at 417 :title .subject.title 418 :type type 419 :topic number 420 :url .subject.url))))))) 421 422 (cl-defmethod forge-topic-mark-read ((_ forge-github-repository) topic) 423 (when (oref topic unread-p) 424 (oset topic unread-p nil) 425 (when-let ((notif (forge-get-notification topic))) 426 (oset topic unread-p nil) 427 (forge--ghub-patch notif "/notifications/threads/:thread-id")))) 428 429 ;;;; Miscellaneous 430 431 (cl-defmethod forge--add-user-repos 432 ((class (subclass forge-github-repository)) host user) 433 (forge--fetch-user-repos 434 class (forge--as-apihost host) user 435 (apply-partially 'forge--batch-add-callback (forge--as-githost host) user))) 436 437 (cl-defmethod forge--add-organization-repos 438 ((class (subclass forge-github-repository)) host org) 439 (forge--fetch-organization-repos 440 class (forge--as-apihost host) org 441 (apply-partially 'forge--batch-add-callback (forge--as-githost host) org))) 442 443 (cl-defmethod forge--fetch-user-repos 444 ((_ (subclass forge-github-repository)) host user callback) 445 (ghub--graphql-vacuum 446 '(query (user 447 [(login $login String!)] 448 (repositories 449 [(:edges t) 450 (ownerAffiliations . (OWNER))] 451 name))) 452 `((login . ,user)) 453 (lambda (d) 454 (funcall callback 455 (--map (alist-get 'name it) 456 (let-alist d .user.repositories)))) 457 nil :auth 'forge :host host)) 458 459 (cl-defmethod forge--fetch-organization-repos 460 ((_ (subclass forge-github-repository)) host org callback) 461 (ghub--graphql-vacuum 462 '(query (organization 463 [(login $login String!)] 464 (repositories [(:edges t)] name))) 465 `((login . ,org)) 466 (lambda (d) 467 (funcall callback 468 (--map (alist-get 'name it) 469 (let-alist d .organization.repositories)))) 470 nil :auth 'forge :host host)) 471 472 (defun forge--batch-add-callback (host owner names) 473 (let ((repos (cl-mapcan (lambda (name) 474 (let ((repo (forge-get-repository 475 (list host owner name) 476 nil 'create))) 477 (and (oref repo sparse-p) 478 (list repo)))) 479 names)) 480 cb) 481 (setq cb (lambda () 482 (when-let ((repo (pop repos))) 483 (message "Adding %s..." (oref repo name)) 484 (forge--pull repo nil cb)))) 485 (funcall cb))) 486 487 ;;; Mutations 488 489 (cl-defmethod forge--create-pullreq-from-issue ((repo forge-github-repository) 490 (issue forge-issue) 491 source target) 492 (pcase-let* ((`(,base-remote . ,base-branch) 493 (magit-split-branch-name target)) 494 (`(,head-remote . ,head-branch) 495 (magit-split-branch-name source)) 496 (head-repo (forge-get-repository 'stub head-remote))) 497 (forge--ghub-post repo "/repos/:owner/:repo/pulls" 498 `((issue . ,(oref issue number)) 499 (base . ,base-branch) 500 (head . ,(if (equal head-remote base-remote) 501 head-branch 502 (concat (oref head-repo owner) ":" 503 head-branch))) 504 (maintainer_can_modify . t)) 505 :callback (lambda (&rest _) 506 (closql-delete issue) 507 (forge-pull)) 508 :errorback (lambda (&rest _) (forge-pull))))) 509 510 (cl-defmethod forge--submit-create-pullreq ((_ forge-github-repository) repo) 511 (let-alist (forge--topic-parse-buffer) 512 (pcase-let* ((`(,base-remote . ,base-branch) 513 (magit-split-branch-name forge--buffer-base-branch)) 514 (`(,head-remote . ,head-branch) 515 (magit-split-branch-name forge--buffer-head-branch)) 516 (head-repo (forge-get-repository 'stub head-remote)) 517 (url-mime-accept-string 518 ;; Support draft pull-requests. 519 "application/vnd.github.shadow-cat-preview+json")) 520 (forge--ghub-post repo "/repos/:owner/:repo/pulls" 521 `((title . , .title) 522 (body . , .body) 523 (base . ,base-branch) 524 (head . ,(if (equal head-remote base-remote) 525 head-branch 526 (concat (oref head-repo owner) ":" 527 head-branch))) 528 (draft . ,(and (member .draft '("t" "true" "yes")) 529 t)) 530 (maintainer_can_modify . t)) 531 :callback (forge--post-submit-callback) 532 :errorback (forge--post-submit-errorback))))) 533 534 (cl-defmethod forge--submit-create-issue ((_ forge-github-repository) repo) 535 (let-alist (forge--topic-parse-buffer) 536 (forge--ghub-post repo "/repos/:owner/:repo/issues" 537 `((title . , .title) 538 (body . , .body) 539 ,@(and .labels (list (cons 'labels .labels))) 540 ,@(and .assignees (list (cons 'assignees .assignees)))) 541 :callback (forge--post-submit-callback) 542 :errorback (forge--post-submit-errorback)))) 543 544 (cl-defmethod forge--submit-create-post ((_ forge-github-repository) topic) 545 (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/comments" 546 `((body . ,(string-trim (buffer-string)))) 547 :callback (forge--post-submit-callback) 548 :errorback (forge--post-submit-errorback))) 549 550 (cl-defmethod forge--submit-edit-post ((_ forge-github-repository) post) 551 (forge--ghub-patch post 552 (cl-typecase post 553 (forge-pullreq "/repos/:owner/:repo/pulls/:number") 554 (forge-issue "/repos/:owner/:repo/issues/:number") 555 (forge-post "/repos/:owner/:repo/issues/comments/:number")) 556 (if (cl-typep post 'forge-topic) 557 (let-alist (forge--topic-parse-buffer) 558 `((title . , .title) 559 (body . , .body))) 560 `((body . ,(string-trim (buffer-string))))) 561 :callback (forge--post-submit-callback) 562 :errorback (forge--post-submit-errorback))) 563 564 (cl-defmethod forge--set-topic-title 565 ((_repo forge-github-repository) topic title) 566 (forge--ghub-patch topic 567 "/repos/:owner/:repo/issues/:number" 568 `((title . ,title)) 569 :callback (forge--set-field-callback))) 570 571 (cl-defmethod forge--set-topic-state 572 ((_repo forge-github-repository) topic) 573 (forge--ghub-patch topic 574 "/repos/:owner/:repo/issues/:number" 575 `((state . ,(cl-ecase (oref topic state) 576 (closed "OPEN") 577 (open "CLOSED")))) 578 :callback (forge--set-field-callback))) 579 580 (cl-defmethod forge--set-topic-milestone 581 ((repo forge-github-repository) topic milestone) 582 (forge--ghub-patch topic 583 "/repos/:owner/:repo/issues/:number" 584 `((milestone 585 . ,(caar (forge-sql [:select [number] 586 :from milestone 587 :where (and (= repository $s1) 588 (= title $s2))] 589 (oref repo id) 590 milestone)))) 591 :callback (forge--set-field-callback))) 592 593 (cl-defmethod forge--set-topic-labels 594 ((_repo forge-github-repository) topic labels) 595 (forge--ghub-put topic "/repos/:owner/:repo/issues/:number/labels" nil 596 :payload labels 597 :callback (forge--set-field-callback))) 598 599 (cl-defmethod forge--delete-comment 600 ((_repo forge-github-repository) post) 601 (forge--ghub-delete post "/repos/:owner/:repo/issues/comments/:number") 602 (closql-delete post) 603 (magit-refresh)) 604 605 (cl-defmethod forge--set-topic-assignees 606 ((_repo forge-github-repository) topic assignees) 607 (let ((value (mapcar #'car (closql--iref topic 'assignees)))) 608 (when-let ((add (cl-set-difference assignees value :test #'equal))) 609 (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/assignees" 610 `((assignees . ,add)))) 611 (when-let ((remove (cl-set-difference value assignees :test #'equal))) 612 (forge--ghub-delete topic "/repos/:owner/:repo/issues/:number/assignees" 613 `((assignees . ,remove))))) 614 (forge-pull)) 615 616 (cl-defmethod forge--set-topic-review-requests 617 ((_repo forge-github-repository) topic reviewers) 618 (let ((value (mapcar #'car (closql--iref topic 'review-requests)))) 619 (when-let ((add (cl-set-difference reviewers value :test #'equal))) 620 (forge--ghub-post topic 621 "/repos/:owner/:repo/pulls/:number/requested_reviewers" 622 `((reviewers . ,add)))) 623 (when-let ((remove (cl-set-difference value reviewers :test #'equal))) 624 (forge--ghub-delete topic 625 "/repos/:owner/:repo/pulls/:number/requested_reviewers" 626 `((reviewers . ,remove))))) 627 (forge-pull)) 628 629 (cl-defmethod forge--topic-templates ((repo forge-github-repository) 630 (_ (subclass forge-issue))) 631 (when-let ((files (magit-revision-files (oref repo default-branch)))) 632 (let ((case-fold-search t)) 633 (if-let ((file (--first (string-match-p "\ 634 \\`\\(\\|docs/\\|\\.github/\\)issue_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it) 635 files))) 636 (list file) 637 (setq files 638 (--filter (string-match-p "\\`\\.github/ISSUE_TEMPLATE/[^/]*" it) 639 files)) 640 (if-let ((conf (cl-find-if 641 (lambda (f) 642 (equal (file-name-nondirectory f) "config.yml")) 643 files))) 644 (nconc (delete conf files) 645 (list conf)) 646 files))))) 647 648 (cl-defmethod forge--topic-templates ((repo forge-github-repository) 649 (_ (subclass forge-pullreq))) 650 (when-let ((files (magit-revision-files (oref repo default-branch)))) 651 (let ((case-fold-search t)) 652 (if-let ((file (--first (string-match-p "\ 653 \\`\\(\\|docs/\\|\\.github/\\)pull_request_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it) 654 files))) 655 (list file) 656 ;; Unlike for issues, the web interface does not support 657 ;; multiple pull-request templates. The API does though, 658 ;; but due to this limitation I doubt many people use them, 659 ;; so Forge doesn't support them either. 660 )))) 661 662 (cl-defmethod forge--fork-repository ((repo forge-github-repository) fork) 663 (with-slots (owner name) repo 664 (forge--ghub-post repo 665 (format "/repos/%s/%s/forks" owner name) 666 (and (not (equal fork (ghub--username (ghub--host nil)))) 667 `((organization . ,fork)))) 668 (ghub-wait (format "/repos/%s/%s" fork name) nil :auth 'forge))) 669 670 (cl-defmethod forge--merge-pullreq ((_repo forge-github-repository) 671 topic hash method) 672 (forge--ghub-put topic 673 "/repos/:owner/:repo/pulls/:number/merge" 674 `((merge_method . ,(symbol-name method)) 675 ,@(and hash `((sha . ,hash)))))) 676 677 ;;; Utilities 678 679 (cl-defun forge--ghub-get (obj resource 680 &optional params 681 &key query payload headers 682 silent unpaginate noerror reader 683 host 684 callback errorback) 685 (declare (indent defun)) 686 (ghub-get (if obj (forge--format-resource obj resource) resource) 687 params 688 :host (or host (oref (forge-get-repository obj) apihost)) 689 :auth 'forge 690 :query query :payload payload :headers headers 691 :silent silent :unpaginate unpaginate 692 :noerror noerror :reader reader 693 :callback callback :errorback errorback)) 694 695 (cl-defun forge--ghub-put (obj resource 696 &optional params 697 &key query payload headers 698 silent unpaginate noerror reader 699 host 700 callback errorback) 701 (declare (indent defun)) 702 (ghub-put (if obj (forge--format-resource obj resource) resource) 703 params 704 :host (or host (oref (forge-get-repository obj) apihost)) 705 :auth 'forge 706 :query query :payload payload :headers headers 707 :silent silent :unpaginate unpaginate 708 :noerror noerror :reader reader 709 :callback callback :errorback errorback)) 710 711 (cl-defun forge--ghub-post (obj resource 712 &optional params 713 &key query payload headers 714 silent unpaginate noerror reader 715 host callback errorback) 716 (declare (indent defun)) 717 (ghub-post (forge--format-resource obj resource) 718 params 719 :host (or host (oref (forge-get-repository obj) apihost)) 720 :auth 'forge 721 :query query :payload payload :headers headers 722 :silent silent :unpaginate unpaginate 723 :noerror noerror :reader reader 724 :callback callback :errorback errorback)) 725 726 (cl-defun forge--ghub-patch (obj resource 727 &optional params 728 &key query payload headers 729 silent unpaginate noerror reader 730 host callback errorback) 731 (declare (indent defun)) 732 (ghub-patch (forge--format-resource obj resource) 733 params 734 :host (or host (oref (forge-get-repository obj) apihost)) 735 :auth 'forge 736 :query query :payload payload :headers headers 737 :silent silent :unpaginate unpaginate 738 :noerror noerror :reader reader 739 :callback callback :errorback errorback)) 740 741 (cl-defun forge--ghub-delete (obj resource 742 &optional params 743 &key query payload headers 744 silent unpaginate noerror reader 745 host callback errorback) 746 (declare (indent defun)) 747 (ghub-delete (forge--format-resource obj resource) 748 params 749 :host (or host (oref (forge-get-repository obj) apihost)) 750 :auth 'forge 751 :query query :payload payload :headers headers 752 :silent silent :unpaginate unpaginate 753 :noerror noerror :reader reader 754 :callback callback :errorback errorback)) 755 756 ;;; _ 757 (provide 'forge-github) 758 ;;; forge-github.el ends here