TakeV
/
guile-toml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix(encoder): array-tables at the very end

This commit is contained in:
hylo 2022-12-30 17:53:13 +01:00
parent 9f6912f6e5
commit 612e23e9ad
1 changed files with 36 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
toml/builder.scm
View File

@ -19,6 +19,15 @@
(and (string? (car scm))
((value?) (cdr scm))))
(define (table-or-array-table? scm)
(or (not (value-pair? scm))
(array-table? (cdr scm))))
(define (array-table? v)
(and (vector? v) (not (any (value?) (vector->list v)))))
(define (array-table-pair? scm)
(array-table? (cdr scm)))
;; (define scm->value
;; (lambda))
(define (build-newline port newline?)
@ -41,10 +50,6 @@
(toml-build (car entries) port keys)
(loop (cdr entries)))))
(define (array-table? v)
;; (log-exprs v)
(and (vector? v) (not (any (value?) (vector->list v)))))
(define* (build-object-pair p port #:optional (current-table '())#:key (newline? #t) (inline? #f))
(if (array-table? (cdr p))
(toml-build-array-table p port current-table)
@ -124,30 +129,39 @@
(define (toml-build-tree scm port current-table)
(define pairs scm)
(unless (null? pairs)
(receive (keyvals tables)
(partition value-pair? pairs)
(receive (tables keyvals)
(partition table-or-array-table? pairs)
;; (log-exprs "." tables keyvals ".")
(for-each (lambda (kv)
(build-object-pair kv port current-table))
(sort keyvals values-then-array-tables))
(for-each (lambda (t)
(build-table t port current-table))
tables))))
keyvals)
(receive (array-tables std-tables)
(partition array-table-pair? tables)
;; (log-exprs "_" array-tables std-tables "_")
(for-each (lambda (t)
(build-table t port current-table))
std-tables)
(for-each (lambda (kv)
(build-object-pair kv port current-table))
array-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))))))
(unless (null? lst)
(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))))))
(unless (null? lst)
(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)
(define pairs scm)