166 lines
6.5 KiB
EmacsLisp
166 lines
6.5 KiB
EmacsLisp
;;; forge-client.el --- GraphQL and REST support -*- 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 'forge)
|
|
|
|
;;; GraphQL
|
|
|
|
(cl-defun forge--query ( obj-or-host query variables
|
|
&key callback errorback noerror narrow until)
|
|
(declare (indent defun))
|
|
(pcase-let ((`(,host ,forge) (forge--host-arguments obj-or-host)))
|
|
(ghub-query query variables
|
|
:auth 'forge :host host :forge forge
|
|
:callback callback :errorback errorback :noerror noerror
|
|
:narrow narrow :until until)))
|
|
|
|
(cl-defmacro forge-query ( obj-or-host query variables
|
|
&key callback errorback noerror narrow until)
|
|
(declare (indent defun))
|
|
`(forge--query ,obj-or-host
|
|
'(query ,query)
|
|
,(forge--prepare-variables variables)
|
|
:callback ,callback :errorback ,errorback :noerror ,noerror
|
|
:narrow ,narrow :until ,until))
|
|
|
|
(cl-defmacro forge-mutate ( obj-or-host mutation variables
|
|
&key callback errorback noerror)
|
|
(declare (indent defun))
|
|
`(forge--query ,obj-or-host
|
|
',(ghub--prepare-mutation mutation)
|
|
(list (cons 'input ,(forge--prepare-variables variables)))
|
|
:callback ,callback :errorback ,errorback :noerror ,noerror))
|
|
|
|
(cl-defmacro forge--mutate-field (topic mutation variables)
|
|
(declare (indent defun))
|
|
`(let ((topic ,topic))
|
|
(forge--query topic
|
|
',(ghub--prepare-mutation mutation)
|
|
(list (cons 'input ,(forge--prepare-variables variables)))
|
|
:callback (forge--set-field-callback topic))))
|
|
|
|
;;; REST
|
|
|
|
(cl-defun forge--rest ( obj-or-host method resource &optional params
|
|
&key callback errorback noerror unpaginate)
|
|
(declare (indent defun))
|
|
(pcase-let ((`(,host ,forge) (forge--host-arguments obj-or-host)))
|
|
(ghub-request method
|
|
(if (cl-typep obj-or-host 'forge-object)
|
|
(forge--format-resource obj-or-host resource)
|
|
resource)
|
|
params
|
|
:auth 'forge :host host :forge forge
|
|
:callback callback :errorback errorback :noerror noerror
|
|
:unpaginate unpaginate)))
|
|
|
|
(cl-defmacro forge-rest ( obj-or-host method resource &optional params
|
|
&key callback errorback noerror unpaginate)
|
|
(declare (indent defun))
|
|
`(forge--rest ,obj-or-host ,method ,resource
|
|
,(forge--prepare-variables params)
|
|
:callback ,callback :errorback ,errorback :noerror ,noerror
|
|
:unpaginate ,unpaginate))
|
|
|
|
;;; Internal
|
|
|
|
(defun forge--host-arguments (obj-or-host)
|
|
(let* ((repo (and (cl-typep obj-or-host 'forge-object)
|
|
(forge-get-repository obj-or-host)))
|
|
(host (if (stringp obj-or-host)
|
|
obj-or-host
|
|
(oref repo apihost))))
|
|
(list host (pcase (if repo
|
|
(eieio-object-class-name repo)
|
|
(nth 3 (cl-find host forge-alist
|
|
:key #'cadr :test #'equal)))
|
|
('forge-github-repository 'github)
|
|
('forge-gitlab-repository 'gitlab)
|
|
(_ 'github)))))
|
|
|
|
(defun ghub--prepare-mutation (mutation &optional var)
|
|
`(mutation
|
|
(,mutation
|
|
[(input ,(if var (intern (format "$%s" var)) '$input)
|
|
,(let ((name (symbol-name mutation)))
|
|
(intern (format "%s%sInput!"
|
|
(upcase (substring name 0 1))
|
|
(substring name 1)))))]
|
|
;; We ignore the payload, but GraphQL requires that at least one
|
|
;; field is specified. On Github this field is available for all
|
|
;; mutations. On Gitlab there is no field that is available for
|
|
;; all mutations, but luckily using an invalid fields does not
|
|
;; result in an error.
|
|
clientMutationId)))
|
|
|
|
(defun forge--prepare-variables (variables)
|
|
`(delq nil (list ,@(mapcar (lambda (binding)
|
|
(pcase-exhaustive binding
|
|
(`(,var ,val)
|
|
`(cons ',var ,val))
|
|
(`(and ,cond (,var ,val))
|
|
`(and ,cond (cons ',var ,val)))))
|
|
variables))))
|
|
|
|
(defun forge--set-field-callback (topic)
|
|
(let ((repo (forge-get-repository topic)))
|
|
(cond
|
|
((forge-gitlab-repository--eieio-childp repo)
|
|
;; TODO Fetch single topic for Gitlab as well.
|
|
(lambda (&rest _)
|
|
(forge--pull repo #'forge-refresh-buffer)))
|
|
((forge-discussion--eieio-childp topic)
|
|
;; See comment in `forge--update-status'.
|
|
(let ((status (oref topic status)))
|
|
(lambda (&rest _)
|
|
(forge--query repo
|
|
(ghub--graphql-prepare-query
|
|
forge--github-repository-query
|
|
`(repository discussions (discussion . ,(oref topic number))))
|
|
`((owner . ,(oref repo owner))
|
|
(name . ,(oref repo name)))
|
|
:callback (lambda (data)
|
|
(forge--update-discussion repo (cdr (cadr (cadr data))))
|
|
(oset topic status status)
|
|
(forge-refresh-buffer))))))
|
|
((lambda (&rest _)
|
|
(forge--pull-topic (forge-get-repository topic) topic))))))
|
|
|
|
;;; _
|
|
;; 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-client)
|
|
;;; forge-client.el ends here
|