aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--kolam/parse.scm66
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 <>)))