Codebase list ghub-el / 48aa06a5-4f49-4a5c-bf31-50e093c48b39/main gsexp.el
48aa06a5-4f49-4a5c-bf31-50e093c48b39/main

Tree @48aa06a5-4f49-4a5c-bf31-50e093c48b39/main (Download .tar.gz)

gsexp.el @48aa06a5-4f49-4a5c-bf31-50e093c48b39/main — raw · history · blame 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
;;; gsexp.el --- GraphQl as S-expressions  -*- lexical-binding: t -*-

;; Copyright (C) 2016-2021  Jonas Bernoulli

;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/magit/ghub
;; Keywords: tools
;; SPDX-License-Identifier: GPL-3.0-or-later

;; 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.

;;; Commentary:

;; This library encodes S-expressions as GraphQl documents.  Currently
;; it is rather incomplete and only intended for use by `ghub-graphql'
;; but I might fill the gaps and add documentation eventually.  I am
;; not in a hurry though.

;;; Code:

(require 'cl-lib)

(defun gsexp-encode (document)
  (gsexp--pp (gsexp--encode-field document)))

(defun gsexp--encode-field (field)
  (cond
   ((stringp field)
    field)
   ((symbolp field)
    (symbol-name field))
   ((listp (car field))
    (concat (format "%s: " (caar field))
            (gsexp--encode-field (cons (cadar field)
                                       (cdr field)))))
   (t
    (concat (symbol-name (pop field))
            (and (vectorp (car field))
                 (format " (\n%s)"
                         (mapconcat #'gsexp--encode-argument
                                    (append (pop field) nil)
                                    ",\n")))
            (and field
                 (format " {\n%s\n}"
                         (mapconcat #'gsexp--encode-field field "\n")))))))

(cl-defun gsexp--encode-argument ((argument value))
  (format "%s: %s" argument (gsexp--encode-value value)))

(defun gsexp--encode-value (value)
  (cond
   ((numberp value)
    (number-to-string value))
   ((symbolp value) ; including variables, enums, booleans and null
    (symbol-name value))
   ((stringp value)
    (prin1-to-string value))
   ((vectorp value)
    (format "(%s)" (mapconcat #'gsexp--encode-value value "")))
   ((listp value)
    (format "{%s}" (mapconcat
                    (pcase-lambda (`(,name ,value))
                      (format "%s: %s" name (gsexp--encode-value value)))
                    value ", ")))
   (t (error "Invalid field value: %S" value))))

(defun gsexp--pp (string)
  (with-temp-buffer
    (save-excursion
      (insert string))
    (while (< (point) (point-max))
      (unless (and (bolp) (eolp))
        (save-excursion
          (let ((level (car (syntax-ppss (point-at-bol)))))
            (when (looking-at "\\s-*\\s)")
              (cl-decf level))
            (indent-line-to (* 2 level)))))
      (forward-line 1))
    (buffer-string)))

;;; _
(provide 'gsexp)
;;; gsexp.el ends here