scheme json encoder; assumes gambit scheme tables for dicts

json-encoder.scm

(load "~~/lib/syntax-case")

(define-syntax case-cond
  (syntax-rules
    (else)
    ((_ e (c r) ... (else d))
     (cond ((c e) r) ... (else d)))))

(define (curry f . c) (lambda x (apply f (append c x))))

(define (string-append-list lst)
  (apply string-append lst))

(define (string-join joiner . s)
  (apply string-append 
    (cons (car s)
          (map (lambda (e)
                 (string-append joiner e))
               (cdr s)))))

(define (string-join-list joiner lst)
  (string-append-list
    (cons (car lst)
          (map (lambda (e) 
                 (string-append joiner e))
               (cdr lst)))))

(define (string-indent indent object)
  (string-append 
    (string-append-list
      (map (lambda n "    ") (range indent)))
    object))

(define (string-indent-list indent lst)
  (map (curry string-indent indent) lst))

(define (encode-boolean object)
  (case object
    ((#t) "true")
    ((#f) "false")
    (else (raise 'invalid-boolean))))

(define (encode-null object)
  "null")

(define (encode-number object)
  (number->string object))

(define (encode-string object)
  (string-append "'" object "'"))

(define (range n)
  (define (range-acc n acc)
    (if (< n 0)
      acc
      (range-acc (- n 1) (cons n acc))))
  (range-acc (- n 1) '()))

(define (encode-list indent object)
  (string-append 
    "[\n"
    (string-join-list 
      ",\n" (string-indent-list
              (+ indent 1)
              (map 
                (curry encode-value (+ indent 1))
                object))) 
    "\n" (string-indent indent "]")))

(define (encode-table indent object)
  (string-append 
    "{\n"
    (string-join-list 
      ",\n"
      (string-indent-list
        (+ indent 1)
        (map (lambda (pair)
               (string-join 
                 ": "
                 (encode-value (+ indent 1) (car pair))
                 (encode-value (+ indent 1) (cdr pair))))
             (table->list object))))
    "\n" (string-indent indent "}")))

(define (encode-value indent object)
  (case-cond 
    object
    (null? (encode-null object))
    (table? (encode-table indent object))
    (list? (encode-list indent object))
    (number? (encode-number object))
    (string? (encode-string object))
    (boolean? (encode-boolean object))
    (else (raise 'unsupported-type))))

(define (encode-json object)
  (string-append (encode-value 0 object) "\n"))