kolam: Implement GraphQL document serializer.

* kolam/parse.scm: Import (srfi srfi-28) and (kolam utils).
(indent-level, serialize-arguments, serialize-node,
serialize-selection): New functions.
(scm->graphql, scm->graphql-string): New public functions.

1 files changed, 65 insertions, 1 deletions

diff --git a/kolam/parse.scm b/kolam/parse.scm
index fa05148..3658963 100644
--- a/kolam/parse.scm
+++ b/kolam/parse.scm
@@ -22,11 +22,15 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-28)
   #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module ((ice-9 textual-ports) #:select (unget-string))
+  #:use-module (kolam utils)
   #:export (graphql->scm
-            graphql-string->scm))
+            graphql-string->scm
+            scm->graphql
+            scm->graphql-string))
 
 
 ;;; Lexer
@@ -566,3 +570,63 @@ return #f."
 (define (graphql-string->scm str)
   (call-with-input-string str
     graphql->scm))
+
+(define (indent-level port level)
+  "Emit whitespaces to PORT corresponding to nesting LEVEL."
+  (display (make-string (* 2 level) #\space) port))
+
+(define (serialize-arguments arguments)
+  "Serialize ARGUMENTS, and return the serialized string."
+  (string-join (map (match-lambda
+                      ((key . value)
+                       (format "~a: ~s"
+                               (keyword->symbol key)
+                               value)))
+                    (pairify arguments))
+               ", "))
+
+(define (serialize-node node)
+  "Serialize NODE, and return the serialized string."
+  (match node
+    (#((? symbol? name) (? symbol? alias) arguments ...)
+     (format "~a: ~a(~a)" alias name (serialize-arguments arguments)))
+    (#((? symbol? name) arguments ...)
+     (format "~a(~a)" name (serialize-arguments arguments)))
+    ((? symbol? name) name)
+    (_ (error "Invalid GraphQL node" node))))
+
+(define (serialize-selection selection port level)
+  "Serialize SELECTION to PORT at indentation LEVEL."
+  (indent-level port level)
+  (match selection
+    ((root selections ...)
+     (display (format "~a {~%" (serialize-node root))
+              port)
+     (for-each (cut serialize-selection <> port (1+ level))
+               selections)
+     (indent-level port level)
+     (display (format "}~%") port))
+    (leaf
+     (display (format "~a~%" (serialize-node leaf))
+              port))))
+
+(define* (scm->graphql document #:optional (port (current-output-port)) (level 0))
+  "Serialize GraphQL DOCUMENT to PORT."
+  (match document
+    (('document queries ...)
+     (for-each (match-lambda
+                 (('query selections ...)
+                  (display "query {" port)
+                  (newline port)
+                  (for-each (cut serialize-selection <> port (1+ level))
+                            selections)
+                  (display "}" port)
+                  (newline port))
+                 (operation (error "Invalid GraphQL operation" operation)))
+               queries))
+    (_ (error "Invalid GraphQL document" document))))
+
+(define (scm->graphql-string document)
+  "Serialize GraphQL DOCUMENT, and return the serialized string."
+  (call-with-output-string
+    (cut scm->graphql document <>)))