diff options
| -rw-r--r-- | kolam/parse.scm | 66 |
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 <>))) |