#lang scheme
(require "base.ss"
"depend.ss"
"request.ss"
"response.ss"
(planet bzlib/parseq:1:3/example/json)
)
(define json (make-cond-registry))
(registry-set! json null? (lambda (v) "null"))
(registry-set! json void? (lambda (v) "undefined"))
(registry-set! json number? number->string)
(registry-set! json string? (lambda (v) (format "~s" v)))
(define (unknown v)
(error 'any->json "unknown type: ~v" v))
(define (any->json v)
((registry-ref json v unknown) v))
(define (vector->json v)
(string-append "["
(string-join (vector->list (vector-map any->json v)) ",")
"]"))
(registry-set! json vector? vector->json)
(define (hash->json v) (string-append "{"
(string-join (hash-map v
(lambda (k v)
(string-append (any->json k)
":"
(any->json v))))
",")
"}"))
(registry-set! json hash? hash->json)
(define-struct (exn:extend exn) (code type inner) #:transparent)
(define (exn->type e)
(cond ((exn:extend? e) (exn:extend-type e))
((exn:break? e) "break")
((exn:fail:user? e) "fail:user")
((exn:fail:unsupported? e) "fail:unsupported")
((exn:fail:out-of-memory? e) "out of memory")
((exn:fail:network? e) "network")
((exn:fail:filesystem:version? e) "filesystem:version")
((exn:fail:filesystem:exists? e) "filesystem:exists")
((exn:fail:filesystem? e) "filesystem")
((exn:fail:read:non-char? e) "reader:non-char")
((exn:fail:read:eof? e) "reader:eof")
((exn:fail:read? e) "reader")
((exn:fail:syntax? e) "syntax")
((exn:fail:contract:variable? e) "contract:variable")
((exn:fail:contract:continuation? e) "contract:continuation")
((exn? e) "error")
(else "not an error")))
(define (exn->code e)
(cond ((exn:extend? e) (exn:extend-code e))
(else "")))
(define (exn->message e)
(exn-message e))
(define (error->xexpr e)
`(error (type ,(exn->type e))
(code ,(exn->code e))
(message ,(exn->message e))))
(define (error->json e)
(string-append "new Error(" (any->json (exn-message e)) ")"))
(registry-set! json exn? error->json)
(define (any->json-set! cond convert)
(unless (registry-ref json cond)
(registry-set! json cond convert)))
(define (handle-json-result result)
(define (helper json callback)
(if callback
(string-join (list "return" callback "(" json ");") " ")
json))
($content-type "text/json; charset=utf-8")
(helper (any->json result) ($query "~jsonp")))
(provide handle-json-result
any->json
any->json-set!)
(provide read-json)