feat(encoder): inline tables
This commit is contained in:
parent
44a0b29d22
commit
0f95d9315e
|
@ -1,16 +1,23 @@
|
|||
#!/usr/bin/env -S guile -s
|
||||
!#
|
||||
(use-modules
|
||||
(toml parser)
|
||||
(json)
|
||||
(ice-9 match)
|
||||
(ice-9 textual-ports)
|
||||
(ice-9 pretty-print))
|
||||
(toml builder)
|
||||
(json))
|
||||
|
||||
(define test-value?
|
||||
(lambda (expr)
|
||||
(and
|
||||
(string? (car expr)))
|
||||
(or
|
||||
(vector? (cdr expr))
|
||||
(equal? (map car (cdr expr)) '("value" "type")))))
|
||||
|
||||
(set-port-conversion-strategy! (current-input-port) 'error)
|
||||
|
||||
;; (define str (get-string-all (current-input-port)))
|
||||
|
||||
(define scm (json->scm (current-input-port)))
|
||||
|
||||
(display scm)
|
||||
|
||||
;;(value->scm test-value->scm)
|
||||
(define x (parameterize ((value? test-value?))
|
||||
(scm->toml scm)))
|
||||
;; (scm->toml scm)
|
||||
|
|
141
toml/builder.scm
141
toml/builder.scm
|
@ -4,10 +4,9 @@
|
|||
#:use-module (srfi srfi-19)
|
||||
#:use-module (ice-9 textual-ports)
|
||||
#:use-module (ice-9 receive)
|
||||
#:export (scm->toml))
|
||||
#:export (scm->toml value?))
|
||||
|
||||
|
||||
(define-syntax-rule (log-exprs exp ...) (begin (format #t "~a: ~S\n" (quote exp) exp) ...))
|
||||
(define-syntax-rule (log-exprs exp ...) (begin (format (current-error-port) "~a: ~S\n" (quote exp) exp) ...))
|
||||
|
||||
;; we want to be able to dynamically bind this functin in test-decoder.scm
|
||||
;; TODO fix duplicate
|
||||
|
@ -21,26 +20,16 @@
|
|||
(when newline?
|
||||
(newline port)))
|
||||
|
||||
|
||||
(define (build-object-pair p port)
|
||||
(define* (build-object-pair p port #:key (newline? #f) (inline? #f))
|
||||
(put-string port (car p))
|
||||
(put-string port " = ")
|
||||
(toml-build (cdr p) port))
|
||||
(toml-build (cdr p) port #:newline? newline? #:inline? inline?))
|
||||
|
||||
(define (toml-build-string s port)
|
||||
(put-string port "\"")
|
||||
(put-string port s)
|
||||
(put-string port "\""))
|
||||
|
||||
;; (define (values-first a b)
|
||||
;; (let ((av? ((value?) a))
|
||||
;; (bv? ((value?) b)))
|
||||
;; (cond
|
||||
;; ((and av? bv?) #t)
|
||||
;; (av? #t)
|
||||
;; (bv? #f))))
|
||||
|
||||
|
||||
(define (build-keys lst port)
|
||||
;; TODO unicode keys
|
||||
(put-string port (string-join lst ".")))
|
||||
|
@ -54,36 +43,68 @@
|
|||
(toml-build (cdr scm) port new-table))
|
||||
|
||||
(define (toml-build-tree scm port current-table)
|
||||
(let ((pairs scm))
|
||||
(unless (null? pairs)
|
||||
(receive (keyvals tables)
|
||||
(partition (value?) pairs)
|
||||
(for-each (lambda (kv)
|
||||
(build-object-pair kv port))
|
||||
keyvals)
|
||||
(for-each (lambda (t)
|
||||
(build-table t port current-table))
|
||||
tables)))))
|
||||
(define pairs scm)
|
||||
(unless (null? pairs)
|
||||
(receive (keyvals tables)
|
||||
(partition (value?) pairs)
|
||||
(for-each (lambda (kv)
|
||||
(build-object-pair kv port))
|
||||
keyvals)
|
||||
(for-each (lambda (t)
|
||||
(build-table t port current-table))
|
||||
tables))))
|
||||
|
||||
(define (build-delimited lst port)
|
||||
(let loop ((lst lst))
|
||||
(if (null? (cdr lst))
|
||||
(toml-build (car lst) port #:newline? #f #:inline? #t)
|
||||
(begin (toml-build (car lst) port #:newline? #f #:inline? #t)
|
||||
(put-string port ", ")
|
||||
(loop (cdr lst))))))
|
||||
|
||||
(define (build-delimited-pairs lst port)
|
||||
(let loop ((lst lst))
|
||||
(if (null? (cdr lst))
|
||||
(build-object-pair (car lst) port #:newline? #f #:inline? #t)
|
||||
(begin (build-object-pair (car lst) port #:newline? #f #:inline? #t)
|
||||
(put-string port ", ")
|
||||
(loop (cdr lst))))))
|
||||
|
||||
(define (toml-build-inline-tree scm port)
|
||||
;; (log-exprs scm)
|
||||
(define pairs scm)
|
||||
(put-string port "{")
|
||||
(unless (null? pairs)
|
||||
(build-delimited-pairs pairs port))
|
||||
;; (build-delimited pairs port))
|
||||
(put-string port "}"))
|
||||
|
||||
;; (build-object-pair (car pairs) port)
|
||||
;; (for-each (lambda (p)
|
||||
;; (build-object-pair p port))
|
||||
;; (cdr pairs))
|
||||
;; (newline port))))
|
||||
|
||||
(define (toml-build-array v port)
|
||||
(put-string port "[")
|
||||
(let loop ((lst (vector->list v)))
|
||||
(if (null? (cdr lst))
|
||||
(toml-build (car lst) port #:newline? #f)
|
||||
(begin (toml-build (car lst) port #:newline? #f)
|
||||
(put-string port ", ")
|
||||
(loop (cdr lst)))))
|
||||
(build-delimited (vector->list v) port)
|
||||
(put-string port "]"))
|
||||
|
||||
;; (define (toml-build-value scm port)
|
||||
;; (cond
|
||||
;; ;; ((eq? scm null) (toml-build-null port))
|
||||
;; ;; ((boolean? scm) (toml-build-boolean scm port))
|
||||
;; ;; ((toml-number? scm) (toml-build-number scm port))
|
||||
;; ;; ((symbol? scm) (toml-build-string (symbol->string scm) port))
|
||||
;; ((string? scm) (toml-build-string scm port))
|
||||
;; ((vector? scm) (toml-build-array scm port))
|
||||
;; ((or (pair? scm) (null? scm))
|
||||
;; (toml-build-tree scm port current-table)))
|
||||
;; (build-newline port newline?))
|
||||
|
||||
|
||||
(define* (toml-build scm port #:optional (current-table '())
|
||||
#:key (newline? #t))
|
||||
#:key (newline? #t) (inline? #f))
|
||||
;; (log-exprs scm)
|
||||
(cond
|
||||
;; ((eq? scm null) (toml-build-null port))
|
||||
|
@ -93,7 +114,10 @@
|
|||
((string? scm) (toml-build-string scm port))
|
||||
((vector? scm) (toml-build-array scm port))
|
||||
((or (pair? scm) (null? scm))
|
||||
(toml-build-tree scm port current-table)))
|
||||
(if inline?
|
||||
(toml-build-inline-tree scm port)
|
||||
(toml-build-tree scm port current-table))))
|
||||
|
||||
(build-newline port newline?))
|
||||
;; (else (throw 'toml-invalid scm))))
|
||||
|
||||
|
@ -103,26 +127,35 @@
|
|||
|
||||
;; (scm->toml '(("a" . "b") ("c" . "d")))
|
||||
;; (scm->toml '(("yo" ("a" . "b"))))
|
||||
(scm->toml '(("hi"
|
||||
("yo" ("a" . "b") ("c" . "d"))
|
||||
;; ("e" . #("f" "b" (("a" . "b")))) TODO inline-tables
|
||||
("e" . #("f" "b" "g")))
|
||||
("g" . "p")))
|
||||
;; (scm->toml '(("hi"
|
||||
;; ("yo" ("a" . "b") ("c" . "d"))
|
||||
;; ;; ("e" . #("f" "b" (("a" . "b")))) TODO inline-tables
|
||||
;; ("e" . #("f" "b" "g")))
|
||||
;; ("g" . "p")))
|
||||
|
||||
'(("servers"
|
||||
("beta" ("role" . "backend") ("ip" . "10.0.0.2"))
|
||||
("alpha"
|
||||
("role" . "frontend")
|
||||
("ip" . "10.0.0.1")))
|
||||
("database"
|
||||
("temp_targets" ("case" . 72.0) ("cpu" . 79.5))
|
||||
("data" . #(#("delta" "phi") #(3.14)))
|
||||
("ports" . #(8000 8001 8002))
|
||||
("enabled" . #t))
|
||||
("owner"
|
||||
("dob"
|
||||
. "date")
|
||||
("name" . "Tom Preston-Werner"))
|
||||
("title" . "TOML Example"))
|
||||
;; '(("servers"
|
||||
;; ("beta" ("role" . "backend") ("ip" . "10.0.0.2"))
|
||||
;; ("alpha"
|
||||
;; ("role" . "frontend")
|
||||
;; ("ip" . "10.0.0.1")))
|
||||
;; ("database"
|
||||
;; ("temp_targets" ("case" . 72.0) ("cpu" . 79.5))
|
||||
;; ("data" . #(#("delta" "phi") #(3.14)))
|
||||
;; ("ports" . #(8000 8001 8002))
|
||||
;; ("enabled" . #t))
|
||||
;; ("owner"
|
||||
;; ("dob"
|
||||
;; . "date")
|
||||
;; ("name" . "Tom Preston-Werner"))
|
||||
;; ("title" . "TOML Example"))
|
||||
|
||||
'()
|
||||
;; '()
|
||||
|
||||
|
||||
;; (define (values-first a b)
|
||||
;; (let ((av? ((value?) a))
|
||||
;; (bv? ((value?) b)))
|
||||
;; (cond
|
||||
;; ((and av? bv?) #t)
|
||||
;; (av? #t)
|
||||
;; (bv? #f))))
|
||||
|
|
Loading…
Reference in New Issue