[elpa] externals/graphql b0bd6c5fd8 02/56: Create DSL and basic encoder

[ELPA Syncer]

branch: externals/graphql
commit b0bd6c5fd85eb78bf3d95cf0b22907e56f769720
Author: Sean Allred <code@seanallred.com>
Commit: Sean Allred <code@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 <code@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