about summary refs log tree commit diff
path: root/configs/shared/emacs/.emacs.d/elpa/ghub-20180911.1858/ghub-graphql.el
diff options
context:
space:
mode:
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/ghub-20180911.1858/ghub-graphql.el')
-rw-r--r--configs/shared/emacs/.emacs.d/elpa/ghub-20180911.1858/ghub-graphql.el428
1 files changed, 0 insertions, 428 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/ghub-20180911.1858/ghub-graphql.el b/configs/shared/emacs/.emacs.d/elpa/ghub-20180911.1858/ghub-graphql.el
deleted file mode 100644
index b73329f410e5..000000000000
--- a/configs/shared/emacs/.emacs.d/elpa/ghub-20180911.1858/ghub-graphql.el
+++ /dev/null
@@ -1,428 +0,0 @@
-;;; ghub-graphql.el --- access Github API using GrapthQL  -*- lexical-binding: t -*-
-
-;; Copyright (C) 2016-2018  Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonas@bernoul.li>
-;; Homepage: https://github.com/magit/ghub
-
-;; This file is not part of GNU Emacs.
-
-;; 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, 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.
-
-;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt.
-
-;;; Code:
-
-(require 'dash)
-(require 'ghub)
-(require 'graphql)
-(require 'subr-x)
-(require 'treepy)
-
-;;; Api
-
-(cl-defun ghub-graphql (graphql &optional variables
-                                &key username auth host
-                                silent
-                                callback errorback value extra)
-  "Make a GraphQL request using GRAPHQL and VARIABLES.
-Return the response as a JSON-like alist.  Even if the response
-contains `errors', do not raise an error.  GRAPHQL is a GraphQL
-string.  VARIABLES is a JSON-like alist.  The other arguments
-behave as for `ghub-request' (which see)."
-  (cl-assert (stringp graphql))
-  (cl-assert (not (stringp variables)))
-  (ghub-request "POST" "/graphql" nil :payload
-                (json-encode `(("query" . ,graphql)
-                               ,@(and variables `(("variables" ,@variables)))))
-                :silent silent
-                :username username :auth auth :host host
-                :callback callback :errorback errorback
-                :extra extra :value value))
-
-(cl-defun ghub-graphql-rate-limit (&key username auth host)
-  "Return rate limit information."
-  (let-alist (ghub-graphql
-              "query { rateLimit { limit cost remaining resetAt }}"
-              nil :username username :auth auth :host host)
-    .data.rateLimit))
-
-(cl-defun ghub-repository-id (owner name &key username auth host)
-  "Return the id of the repository specified by OWNER, NAME and HOST."
-  (let-alist (ghub-graphql
-              "query ($owner:String!, $name:String!) {
-                 repository(owner:$owner, name:$name) { id }
-               }"
-              `((owner . ,owner)
-                (name  . ,name))
-              :username username :auth auth :host host)
-    .data.repository.id))
-
-;;; Api (drafts)
-
-(defconst ghub-fetch-repository
-  '(query
-    (repository
-     [(owner $owner String!)
-      (name  $name  String!)]
-     name
-     id
-     createdAt
-     updatedAt
-     nameWithOwner
-     description
-     (defaultBranchRef name)
-     isArchived
-     isFork
-     isLocked
-     isMirror
-     isPrivate
-     hasIssuesEnabled
-     hasWikiEnabled
-     (licenseInfo name)
-     (stargazers totalCount)
-     (watchers totalCount)
-     (issues         [(:edges t)
-                      (:singular issue number)
-                      (orderBy ((field . UPDATED_AT) (direction . DESC)))]
-                     number
-                     state
-                     (author login)
-                     title
-                     createdAt
-                     updatedAt
-                     closedAt
-                     locked
-                     (milestone id)
-                     body
-                     (comments [(:edges t)]
-                               databaseId
-                               (author login)
-	                       createdAt
-	                       updatedAt
-                               body))
-     (labels         [(:edges t)
-                      (:singular label id)]
-                     id
-                     name
-                     color
-                     description)
-     (pullRequests   [(:edges t)
-                      (:singular pullRequest number)
-                      (orderBy ((field . UPDATED_AT) (direction . DESC)))]
-                     number
-                     state
-                     (author login)
-                     title
-                     createdAt
-                     updatedAt
-                     closedAt
-                     mergedAt
-                     locked
-                     maintainerCanModify
-                     isCrossRepository
-                     (milestone id)
-                     body
-                     (baseRef name
-                              (repository nameWithOwner))
-                     (headRef name
-                              (repository (owner login)
-                                          nameWithOwner))
-                     (comments [(:edges t)]
-                               databaseId
-                               (author login)
-                               createdAt
-	                       updatedAt
-	                       body)))))
-
-(cl-defun ghub-fetch-repository (owner name callback
-                                       &optional until
-                                       &key username auth host forge)
-  "Asynchronously fetch forge data about the specified repository.
-Once all data has been collected, CALLBACK is called with the
-data as the only argument."
-  (ghub--graphql-vacuum ghub-fetch-repository
-                        `((owner . ,owner)
-                          (name  . ,name))
-                        callback until
-                        :narrow   '(repository)
-                        :username username
-                        :auth     auth
-                        :host     host
-                        :forge    forge))
-
-(cl-defun ghub-fetch-issue (owner name number callback
-                                  &optional until
-                                  &key username auth host forge)
-  "Asynchronously fetch forge data about the specified issue.
-Once all data has been collected, CALLBACK is called with the
-data as the only argument."
-  (ghub--graphql-vacuum (ghub--graphql-prepare-query
-                         ghub-fetch-repository
-                         `(repository issues (issue . ,number)))
-                        `((owner . ,owner)
-                          (name  . ,name))
-                        callback until
-                        :narrow   '(repository issue)
-                        :username username
-                        :auth     auth
-                        :host     host
-                        :forge    forge))
-
-(cl-defun ghub-fetch-pullreq (owner name number callback
-                                    &optional until
-                                    &key username auth host forge)
-  "Asynchronously fetch forge data about the specified pull-request.
-Once all data has been collected, CALLBACK is called with the
-data as the only argument."
-  (ghub--graphql-vacuum (ghub--graphql-prepare-query
-                         ghub-fetch-repository
-                         `(repository pullRequests (pullRequest . ,number)))
-                        `((owner . ,owner)
-                          (name  . ,name))
-                        callback until
-                        :narrow   '(repository pullRequest)
-                        :username username
-                        :auth     auth
-                        :host     host
-                        :forge    forge))
-
-;;; Internal
-
-(cl-defstruct (ghub--graphql-req
-               (:include ghub--req)
-               (:constructor ghub--make-graphql-req)
-               (:copier nil))
-  (query     nil :read-only t)
-  (variables nil :read-only t)
-  (until     nil :read-only t)
-  (pages     0   :read-only nil))
-
-(cl-defun ghub--graphql-vacuum (query variables callback
-                                      &optional until
-                                      &key narrow username auth host forge)
-  "Make a GraphQL request using QUERY and VARIABLES.
-See Info node `(ghub)GraphQL Support'."
-  (unless host
-    (setq host (ghub--host forge)))
-  (unless (or username (stringp auth) (eq auth 'none))
-    (setq username (ghub--username host forge)))
-  (ghub--graphql-retrieve
-   (ghub--make-graphql-req
-    :url       (url-generic-parse-url (concat "https://" host "/graphql"))
-    :method    "POST"
-    :headers   (ghub--headers nil host auth username forge)
-    :handler   'ghub--graphql-handle-response
-    :query     query
-    :variables variables
-    :until     until
-    :callback  (if narrow
-                   (lambda (data)
-                     (let ((path narrow) key)
-                       (while (setq key (pop path))
-                         (setq data (cdr (assq key data)))))
-                     (funcall callback data))
-                 callback))))
-
-(cl-defun ghub--graphql-retrieve (req &optional lineage cursor)
-  (let ((p (cl-incf (ghub--graphql-req-pages req))))
-    (when (> p 1)
-      (message "Fetching page %s..." p)))
-  (ghub--retrieve
-   (let ((json-false nil))
-     (ghub--encode-payload
-      `((query     . ,(ghub--graphql-encode
-                       (ghub--graphql-prepare-query
-                        (ghub--graphql-req-query req)
-                        lineage cursor)))
-        (variables . ,(ghub--graphql-req-variables req)))))
-   req))
-
-(defun ghub--graphql-prepare-query (query &optional lineage cursor)
-  (when lineage
-    (setq query (ghub--graphql-narrow-query query lineage cursor)))
-  (let ((loc (ghub--alist-zip query))
-        variables)
-    (cl-block nil
-      (while t
-        (let ((node (treepy-node loc)))
-          (when (vectorp node)
-            (let ((alist (cl-coerce node 'list))
-                  vars)
-              (when (assq :edges alist)
-                (push (list 'first 100) vars)
-                (setq loc  (treepy-up loc))
-                (setq node (treepy-node loc))
-                (setq loc  (treepy-replace
-                            loc `(,(car  node)
-                                  ,(cadr node)
-                                  (pageInfo endCursor hasNextPage)
-                                  (edges (node ,@(cddr node))))))
-                (setq loc  (treepy-down loc))
-                (setq loc  (treepy-next loc)))
-              (dolist (elt alist)
-                (cond ((keywordp (car elt)))
-                      ((= (length elt) 3)
-                       (push (list (nth 0 elt)
-                                   (nth 1 elt)) vars)
-                       (push (list (nth 1 elt)
-                                   (nth 2 elt)) variables))
-                      ((= (length elt) 2)
-                       (push elt vars))))
-              (setq loc (treepy-replace loc (cl-coerce vars 'vector))))))
-        (if (treepy-end-p loc)
-            (let ((node (copy-sequence (treepy-node loc))))
-              (when variables
-                (push (cl-coerce variables 'vector)
-                      (cdr node)))
-              (cl-return node))
-          (setq loc (treepy-next loc)))))))
-
-(defun ghub--graphql-handle-response (status req)
-  (let ((buffer (current-buffer)))
-    (unwind-protect
-        (progn
-          (set-buffer-multibyte t)
-          (let* ((headers (ghub--handle-response-headers status req))
-                 (payload (ghub--handle-response-payload req))
-                 (payload (ghub--handle-response-error status payload req))
-                 (err     (plist-get status :error))
-                 (errors  (cdr (assq 'errors payload)))
-                 (errors  (and errors
-                               (cons 'ghub-graphql-error errors)))
-                 (data    (assq 'data payload))
-                 (value   (ghub--req-value req)))
-            (setf (ghub--req-value req) value)
-            (if (or err errors)
-                (if-let ((errorback (ghub--req-errorback req)))
-                    (funcall errorback (or err errors) headers status req)
-                  (ghub--signal-error (or err errors)))
-              (ghub--graphql-walk-response value data req))))
-      (when (buffer-live-p buffer)
-        (kill-buffer buffer)))))
-
-(defun ghub--graphql-walk-response (loc data req)
-  (if (not loc)
-      (setf (ghub--req-value req)
-            (setq loc (ghub--alist-zip data)))
-    (setq data (ghub--graphql-narrow-data data (ghub--graphql-lineage loc)))
-    (setf (alist-get 'edges data)
-          (append (alist-get 'edges (treepy-node loc))
-                  (or (alist-get 'edges data)
-                      (error "BUG: Expected new nodes"))))
-    (setq loc (treepy-replace loc data)))
-  (cl-block nil
-    (while t
-      (when (eq (car-safe (treepy-node loc)) 'edges)
-        (setq loc (treepy-up loc))
-        (pcase-let ((`(,key . ,val) (treepy-node loc)))
-          (let-alist val
-            (let* ((cursor (and .pageInfo.hasNextPage
-                                .pageInfo.endCursor))
-                   (until (cdr (assq (intern (format "%s-until" key))
-                                     (ghub--graphql-req-until req))))
-                   (nodes (mapcar #'cdar .edges))
-                   (nodes (if until
-                              (--take-while
-                               (or (string> (cdr (assq 'updatedAt it)) until)
-                                   (setq cursor nil))
-                               nodes)
-                            nodes)))
-              (if cursor
-                  (progn
-                    (setf (ghub--req-value req) loc)
-                    (ghub--graphql-retrieve req
-                                            (ghub--graphql-lineage loc)
-                                            cursor)
-                    (cl-return))
-                (setq loc (treepy-replace loc (cons key nodes))))))))
-      (if (not (treepy-end-p loc))
-          (setq loc (treepy-next loc))
-        (funcall (ghub--req-callback req)
-                 (treepy-root loc))
-        (cl-return)))))
-
-(defun ghub--graphql-lineage (loc)
-  (let (lineage)
-    (while (treepy-up loc)
-      (push (car (treepy-node loc)) lineage)
-      (setq loc (treepy-up loc)))
-    lineage))
-
-(defun ghub--graphql-narrow-data (data lineage)
-  (let (key)
-    (while (setq key (pop lineage))
-      (if (consp (car lineage))
-          (progn (pop lineage)
-                 (setf data (cadr data)))
-        (setq data (assq key (cdr data))))))
-  data)
-
-(defun ghub--graphql-narrow-query (query lineage cursor)
-  (if (consp (car lineage))
-      (let* ((child  (cddr query))
-             (alist  (cl-coerce (cadr query) 'list))
-             (single (cdr (assq :singular alist))))
-        `(,(car single)
-          ,(vector (list (cadr single) (cdr (car lineage))))
-          ,@(if (cdr lineage)
-               (ghub--graphql-narrow-query child (cdr lineage) cursor)
-             child)))
-    (let* ((child  (or (assq (car lineage) (cdr query))
-                       (cl-find-if (lambda (c)
-                                     (and (listp c)
-                                          (vectorp (cadr c))
-                                          (eq (cadr (assq :singular
-                                                          (cl-coerce (cadr c)
-                                                                     'list)))
-                                              (car lineage))))
-                                   (cdr query))))
-           (object (car query))
-           (args   (and (vectorp (cadr query))
-                        (cadr query))))
-      `(,object
-        ,@(and args (list args))
-        ,(cond ((cdr lineage)
-                (ghub--graphql-narrow-query child (cdr lineage) cursor))
-               (cursor
-                `(,(car child)
-                  ,(vconcat `((after ,cursor))
-                            (cadr child))
-                  ,@(cddr child)))
-               (t
-                child))))))
-
-(defun ghub--graphql-encode (g)
-  (if (symbolp g)
-      (symbol-name g)
-    (let* ((object (car g))
-           (args   (and (vectorp (cadr g))
-                        (cl-coerce (cadr g) 'list)))
-           (fields (if args (cddr g) (cdr g))))
-       (concat
-        (graphql--encode-object object)
-        (and args
-             (format " (\n%s)"
-                     (mapconcat (pcase-lambda (`(,key ,val))
-                                  (graphql--encode-argument key val))
-                                args ",\n")))
-        (and fields
-             (format " {\n%s\n}"
-                     (mapconcat #'ghub--graphql-encode fields "\n")))))))
-
-(defun ghub--alist-zip (root)
-  (let ((branchp (lambda (elt) (and (listp elt) (listp (cdr elt)))))
-        (make-node (lambda (_ children) children)))
-    (treepy-zipper branchp #'identity make-node root)))
-
-;;; _
-(provide 'ghub-graphql)
-;;; ghub-graphql.el ends here