Re: guile-json: simple alist to json

[Jan Nieuwenhuizen]

Aleix Conchillo Flaqué writes:

Hi Aleix,

> thanks for the patch! I have tried with guile 2.0.11 and it's giving me th
> ​e error at the end. I had zero time to fix it, but I believe it's 
> complaining because of this:
>
> scheme@(guile-user)> (symbol 'a)
> ERROR: In procedure string:
> ERROR: In procedure string: Wrong type (expecting character): a
>
> ​"a" is already a symbol.

Ouch.  Yes, I get that too...

I have been running this for quite some time but aparrently I prepared
patches and sent untested, "cleaned-up" code.  Sorry.

Please find a new patch set attached.

Greetings,
Jan

>From 518feb262370855550a3af61eafa650f3452ac24 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <address@hidden>
Date: Wed, 5 Aug 2015 08:21:13 +0200
Subject: [PATCH 1/2] builder: convert symbols to string.

* json/builder.scm (->string): New function.
* json/builder.scm (json-build-string): Use it.
---
 json/builder.scm | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/json/builder.scm b/json/builder.scm
index c725b19..f12dee8 100644
--- a/json/builder.scm
+++ b/json/builder.scm
@@ -1,6 +1,7 @@
 ;;; (json builder) --- Guile JSON implementation.
 
 ;; Copyright (C) 2013 Aleix Conchillo Flaque <address@hidden>
+;; Copyright (C) 2015 Jan Nieuwenhuizen <address@hidden>
 ;;
 ;; This file is part of guile-json.
 ;;
@@ -105,6 +106,12 @@
       (display (number->string (exact->inexact scm)) port)
       (display (number->string scm) port)))
 
+(define (->string x)
+  (cond ((char? x) (make-string 1 x))
+        ((number? x) (number->string x))
+        ((symbol? x) (symbol->string x))
+        (else x)))
+
 (define (json-build-string scm port escape)
   (display "\"" port)
   (display
@@ -121,7 +128,7 @@
                      ((#\ht) '(#\\ #\t))
                      ((#\/) (if escape `(#\\ ,c) (list c)))
                      (else (string->list (build-char-string c)))))
-                 (string->list scm))))
+                 (string->list (->string scm)))))
    port)
   (display "\"" port))
 
@@ -155,6 +162,7 @@
    ((eq? scm #nil) (json-build-null port))
    ((boolean? scm) (json-build-boolean scm port))
    ((number? scm) (json-build-number scm port))
+   ((symbol? scm) (json-build-string (symbol->string scm) port escape))
    ((string? scm) (json-build-string scm port escape))
    ((list? scm) (json-build-array scm port escape pretty level))
    ((hash-table? scm) (json-build-object scm port escape pretty level))
-- 
2.6.3

>From d45b1be0805bdabef65d9f8edad122ee5e9f07e0 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <address@hidden>
Date: Sat, 13 Feb 2016 21:16:46 +0100
Subject: [PATCH 2/2] builder: build objects from alists.

* json/builder.scm (atom?): New function.
* json/builder.scm (json-alist?): New function.
* json/builder.scm (json-build-object): SCM is an alist.
* json/builder.scm (json-build): Use it to support building objects from both
  hash-tables and alists.
---
 json/builder.scm | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/json/builder.scm b/json/builder.scm
index f12dee8..e1339b2 100644
--- a/json/builder.scm
+++ b/json/builder.scm
@@ -1,7 +1,7 @@
 ;;; (json builder) --- Guile JSON implementation.
 
 ;; Copyright (C) 2013 Aleix Conchillo Flaque <address@hidden>
-;; Copyright (C) 2015 Jan Nieuwenhuizen <address@hidden>
+;; Copyright (C) 2015,2016 Jan Nieuwenhuizen <address@hidden>
 ;;
 ;; This file is part of guile-json.
 ;;
@@ -112,6 +112,17 @@
         ((symbol? x) (symbol->string x))
         (else x)))
 
+(define (atom? x)
+  (or (char? x) (number? x) (string? x) (symbol? x)))
+
+(define (json-alist? x)
+  (and (pair? x)
+       (let loop ((x x))
+         (or (null? x)
+             (null? (car x))
+             (and (pair? (car x)) (atom? (caar x))
+                  (loop (cdr x)))))))
+
 (define (json-build-string scm port escape)
   (display "\"" port)
   (display
@@ -146,7 +157,7 @@
   (build-newline port pretty)
   (simple-format port "~A{" (indent-string pretty level))
   (build-newline port pretty)
-  (let ((pairs (hash-map->list cons scm)))
+  (let ((pairs scm))
     (unless (null? pairs)
       (build-object-pair (car pairs) port escape pretty (+ level 1))
       (for-each (lambda (p)
@@ -164,8 +175,10 @@
    ((number? scm) (json-build-number scm port))
    ((symbol? scm) (json-build-string (symbol->string scm) port escape))
    ((string? scm) (json-build-string scm port escape))
+   ((json-alist? scm) (json-build-object scm port escape pretty level))
    ((list? scm) (json-build-array scm port escape pretty level))
-   ((hash-table? scm) (json-build-object scm port escape pretty level))
+   ((hash-table? scm)
+    (json-build-object (hash-map->list cons scm) port escape pretty level))
    (else (throw 'json-invalid))))
 
 ;;
-- 
2.6.3


-- 
Jan Nieuwenhuizen <address@hidden> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl