branch: externals/graphql
commit b0bd6c5fd85eb78bf3d95cf0b22907e56f769720
Author: Sean Allred <c...@seanallred.com>
Commit: Sean Allred <c...@seanallred.com>
Create DSL and basic encoder
---
.gitignore | 1 +
examples.el | 27 ++++++++++++
graphql.el | 106 ++++++++++++++++++++++++++++++++++++++++++++++++
test/graphql.el-test.el | 41 +++++++++++++++++++
4 files changed, 175 insertions(+)
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000000..28f0a7dc05
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+.cask/
diff --git a/examples.el b/examples.el
new file mode 100644
index 0000000000..5c48e8ca4b
--- /dev/null
+++ b/examples.el
@@ -0,0 +1,27 @@
+(require 'json)
+(require 'ghub)
+(require 'graphql)
+
+;;; The following functions create
+
+(defun ghubp--graphql-submit (type object)
+ (thread-last (graphql-encode object)
+ (cons type)
+ (list)
+ (json-encode)
+ (ghub-post "/graphql" nil)))
+(defun ghubp-graphql-query (query)
+ (ghubp--graphql-submit "query" (cons 'query query)))
+(defun ghubp-graphql-mutation (mutation)
+ (ghubp--graphql-submit "mutation" (cons 'mutation mutation)))
+
+;;; Begin examples
+
+(ghubp-graphql-query
+ ;; Get the first hundred issues from vermiculus/magithub
+ '((repository
+ :arguments ((owner . "vermiculus")
+ (name . "magithub"))
+ (issues :arguments ((first . 100))
+ (edges
+ (node number title url id))))))
diff --git a/graphql.el b/graphql.el
new file mode 100644
index 0000000000..ba1995139a
--- /dev/null
+++ b/graphql.el
@@ -0,0 +1,106 @@
+;;; graphql.el --- GraphQL utilities -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2017 Sean Allred
+
+;; Author: Sean Allred <c...@seanallred.com>
+;; Keywords: hypermedia, tools, lisp
+;; Package-Version: 0
+
+;; This program 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 program 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 program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Graphql.el provides a generally-applicable domain-specific language
+;; for creating and executing GraphQL queries against your favorite
+;; web services.
+
+;;; Code:
+
+(require 'pcase)
+
+(defun graphql--encode-atom (g)
+ (cond
+ ((stringp g)
+ g)
+ ((symbolp g)
+ (symbol-name g))
+ ((numberp g)
+ (number-to-string g))
+ ((and (consp g)
+ (not (consp (cdr g))))
+ (symbol-name (car g)))))
+(defun graphql--encode-list (l)
+ (when (and (consp l) (consp (car l)))
+ (mapconcat #'graphql--encode l " ")))
+(defun graphql--encode-parameter-pair (pair)
+ (graphql--encode-parameter (car pair) (cdr pair)))
+(defun graphql--encode-parameter (key value)
+ (format "%s:%s"
+ key
+ (cond
+ ((symbolp value)
+ (symbol-name value))
+ ((listp value)
+ (format "{%s}" (mapconcat #'graphql--encode-parameter-pair value
",")))
+ ((stringp value)
+ (format "\"%s\"" value))
+ ((numberp value)
+ value)
+ (t
+ (graphql--encode value)))))
+
+(defun graphql--get-keys (g)
+ (let (graph keys)
+ (while g
+ (if (keywordp (car g))
+ (let* ((param (pop g))
+ (value (pop g)))
+ (push (cons param value) keys))
+ (push (pop g) graph)))
+ (list keys (nreverse graph))))
+
+(defun graphql--encode (g)
+ "Encode G as a GraphQL string."
+ (or (graphql--encode-atom g)
+ (graphql--encode-list g)
+ (pcase (graphql--get-keys g)
+ (`(,keys ,graph)
+ (let ((root (car graph))
+ (name (alist-get :name keys))
+ (arguments (alist-get :arguments keys))
+ (rest (cdr graph)))
+ (concat
+ (symbol-name root)
+ (when arguments
+ ;; Format arguments "key:value, ..."
+ (format "(%s)"
+ (mapconcat #'graphql--encode-parameter-pair arguments
",")))
+ (when (or name rest) " ")
+ (when name
+ (format "%S ") name)
+ (when rest
+ (format "{ %s }"
+ (if (listp rest)
+ (mapconcat #'graphql--encode rest " ")
+ (graphql--encode rest))))))))))
+
+(defun graphql-encode (g)
+ "Encode G as a GraphQL string."
+ (let ((s (graphql--encode g)))
+ ;; clean up
+ (set-text-properties 0 (length s) nil s)
+ s))
+
+(provide 'graphql)
+;;; graphql.el ends here
diff --git a/test/graphql.el-test.el b/test/graphql.el-test.el
new file mode 100644
index 0000000000..31158630a1
--- /dev/null
+++ b/test/graphql.el-test.el
@@ -0,0 +1,41 @@
+;;; graphql.el-test.el --- Tests for graphql.el
+
+(ert-deftest encode-basic ()
+ (should (string= (graphql-encode
+ '(query
+ hello-world))
+ "query { hello-world }"))
+
+ (should (string= (graphql-encode
+ '(query
+ :arguments ((one . "1")
+ (two . "2"))
+ hello-world))
+ "query(one:\"1\",two:\"2\") { hello-world }")))
+
+(ert-deftest encode-recursive ()
+ (should (string= (graphql-encode
+ '(query
+ (repository
+ :arguments ((owner . "my-owner")
+ (name . "my-repo-name")))))
+ "query {
repository(owner:\"my-owner\",name:\"my-repo-name\") }"))
+
+ (should (string= (graphql-encode
+ '(query
+ (repository
+ :arguments ((owner . "my-owner")
+ (name . "my-repo-name"))
+ (issues
+ :arguments ((first . 20))
+ (edges (node number title url))))))
+ (concat
+ "query {
repository(owner:\"my-owner\",name:\"my-repo-name\") "
+ "{ issues(first:20) { edges { node { number title url } }
} } }")))
+
+ (should (string= (graphql-encode
+ '(addReaction :arguments ((input . ((subjectId .
"MDU6SXNzdWUxNzc2MzA3Mjk=")
+ (content . HOORAY))))))
+
"addReaction(input:{subjectId:\"MDU6SXNzdWUxNzc2MzA3Mjk=\",content:HOORAY})")))
+
+;;; graphql.el-test.el ends here
