feat(encoder): test-value building

test/test-encoder.scm

@@ -2,22 +2,43 @@
 !#
 (use-modules
  (toml builder)
- (json))
+ (json)
+ (srfi srfi-1)
+ (ice-9 textual-ports)
+ (ice-9 pretty-print))
 
 (define test-value?
   (lambda (expr)
-    (and
-     (string? (car expr)))
     (or
-     (vector? (cdr expr))
-     (equal? (map car (cdr expr)) '("value" "type")))))
+     (vector? expr)
+     (and
+      (list? expr)
+      (or (equal? (map car expr) '("type" "value"))
+          (equal? (map car expr) '("value" "type")))))))
+
+(define (build-atomic-value scm port)
+  (define (find-cdr-by-car s lst)
+    (cdr (find (lambda (x) (equal? (car x) s)) lst)))
+  (define type (find-cdr-by-car "type" scm))
+  (define value (find-cdr-by-car "value" scm))
+  (put-string port value))
+
+(define* (test-toml-build-value scm port #:key (newline? #t) (inline? #t))
+  (cond
+   ((vector? scm)
+    (toml-build-array scm port))
+   (else
+    (build-atomic-value scm port))))
 
 (set-port-conversion-strategy! (current-input-port) 'error)
 
 (define scm (json->scm (current-input-port)))
 
+(pretty-print scm)
+;; (test-value? '())
 
 ;;(value->scm test-value->scm)
-(define x (parameterize ((value? test-value?))
+(define x (parameterize ((toml-build-value test-toml-build-value)
+                         (value? test-value?))
             (scm->toml scm)))
 ;; (scm->toml scm)

toml/builder.scm

@@ -4,7 +4,7 @@
   #:use-module (srfi srfi-19)
   #:use-module (ice-9 textual-ports)
   #:use-module (ice-9 receive)
-  #:export (scm->toml value?))
+  #:export (scm->toml value? toml-build-value toml-build-array))
 
 (define-syntax-rule (log-exprs exp ...) (begin (format (current-error-port) "~a: ~S\n" (quote exp) exp) ...))
 
@@ -14,6 +14,10 @@
   (make-parameter
    (lambda (expr) (not (list? expr)))))
 
+(define (value-pair? scm)
+  (and (string? (car scm))
+       ((value?) (cdr scm))))
+
 ;; (define scm->value
 ;;   (lambda))
 (define (build-newline port newline?)
@@ -44,9 +48,11 @@
 
 (define (toml-build-tree scm port current-table)
   (define pairs scm)
+  (log-exprs pairs)
   (unless (null? pairs)
     (receive (keyvals tables)
-        (partition (value?) pairs)
+        (partition value-pair? pairs)
+      (log-exprs "-----------------" keyvals tables "--------------")
       (for-each (lambda (kv)
                   (build-object-pair kv port))
                 keyvals)
@@ -63,7 +69,8 @@
                (loop (cdr lst))))))
 
 (define (build-delimited-pairs lst port)
-  (let loop ((lst lst))
+  (log-exprs "a" lst (car 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)
@@ -90,29 +97,31 @@
   (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-value
+  (make-parameter
+   (lambda*
+       (scm port #:key (newline? #t) (inline? #f))
+     (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))
+      ((vector? scm) (toml-build-array scm port))
+      ((string? scm) (toml-build-string scm port)))
+     (build-newline port newline?))))
 
 
 (define* (toml-build scm port #:optional (current-table '())
                      #:key (newline? #t) (inline? #f))
-  ;; (log-exprs scm)
+  ;; (log-exprs "v" scm)
   (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))
+   (((value?) scm)
+    (log-exprs "v" scm)
+    ((toml-build-value) scm port #:newline? newline? #:inline? inline?))
    ((or (pair? scm) (null? scm))
     (if inline?
         (toml-build-inline-tree scm port)