(define-library (zambyte meta json)
  ;; portable
  (export json
	  define-json-record-type
	  json->typeless-json
	  json-ref
	  json-value?

	  json-record-from-string-allow-missing-keys
	  json-key-not-found)
  ;; non-portable
  (export json-object
	  json-list
	  json-null

	  json-object?
	  json-list?
	  json-null?
	  json-object-contains-key?

	  string->json
	  json->string

	  json-object-ref
	  json-object-set!
	  json-list-ref
	  json-list-length

	  json-object-map
	  json-list-map

	  json-object->alist
	  json-list->list)
  (import (scheme base))
  ;; portable
  (begin
    (define-syntax json
      (syntax-rules (object list null true false)
	((_ (object (key . value) ...))
	 (json-object `(key . ,(json value)) ...))
	((_ (list vs ...))
	 (json-list (json vs) ...))
	((_ null) json-null)
	((_ true) #t)
	((_ false) #f)
	((_ value)
	 (if (json-value? value)
	     value
	     (error "json: not a json value" value)))))

    (define-syntax handle-field-declarations
      (syntax-rules ()
	((_ (field accessor))
	 (define (accessor obj)
	   (json-object-ref obj 'field)))
	((_ (field accessor mutator))
	 (begin
	   (define (accessor obj)
	     (json-object-ref obj 'field))
	   (define (mutator obj value)
	     (json-object-set! (json-record->fields obj) 'field value))))))

    (define-syntax get-accessor
      (syntax-rules ()
	((_ (field accessor rest ...))
	 `(field . ,accessor))))

    (define-syntax get-mutator
      (syntax-rules ()
	((_ (field _ mutator))
	 `(field . ,mutator))
	((_ (field _))
	 `(field . #f))))

    (define-syntax define-json-record-type
      (syntax-rules ()
	((_ type
	    (constructor fields ...)
	    from-json-string
	    predicate
	    field-declarations ...)
	 (begin
	   (define-values (constructor predicate from-json-string)
	     ((lambda ()
		(define-record-type type
		  (make-tag)
		  pred?)
		(define tag (make-tag))
		(define (constructor fields ...)
		  (make-json-record 'type
				    tag
				    (json-object `(fields . ,fields) ...)
				    from-json-string
				    (list (get-accessor field-declarations) ...)
				    (list (get-mutator field-declarations) ...)))

		(define (predicate obj)
		  (cond
		   ((json-record? obj) (pred? (json-record->tag obj)))
		   ((json-object? obj) (and (json-object-contains-key? obj 'fields) ...))
		   (else #f)))

		(define (from-json-string str)
		  (let ((json (string->json str)))
		    (if (json-record-from-string-allow-missing-keys)
			(make-json-record 'type
					  tag
					  (string->json str)
					  from-json-string
					  (list (get-accessor field-declarations) ...)
					  (list (get-mutator field-declarations) ...))
			(parameterize ((json-key-not-found
					(lambda ()
					  (error "key not found in json string when converting to a record" 'type))))
			  (constructor (json-object-ref json 'fields) ...)))))
		(values constructor predicate from-json-string))))
	   (handle-field-declarations field-declarations) ...))))

    (define-record-type <json-record>
      (make-json-record name tag fields from-json-string accessors mutators)
      json-record?
      (name json-record->name)
      (tag json-record->tag)
      (fields json-record->fields)
      (from-json-string json-record->from-json-string)
      (accessors json-record->accessors)
      (mutators json-record->mutators))

    (define json-record-from-string-allow-missing-keys (make-parameter #f))

    (define (json->typeless-json json)
      (cond
       ((json-record? json)
	(json->typeless-json (json-record->fields json)))
       ((json-object? json)
	(json-object-map (lambda (k v) (values k (json->typeless-json v))) json))
       ((json-list? json)
	(json-list-map (lambda (v) (json->typeless-json v)) json))
       (else json)))

    (define (json-ref json key . keys)
      (let ((ref (cond ((json-object? json) json-object-ref)
		       ((json-list? json) json-list-ref)
		       (else (error "json-ref: cannot get reference on json value" json)))))
	(if (null? keys)
	    (ref json key)
	    (apply json-ref (ref json key) keys))))

    (define (json-value? obj)
      (or (boolean? obj)
	  (number? obj)
	  (string? obj)
	  (json-null? obj)
	  (json-list? obj)
	  (json-object? obj)))

    (define json-key-not-found (make-parameter (lambda () (values)))))
  ;; non-portable
  (cond-expand
   ((and (library (macduffie json)) (library (srfi 69)))
    (include-library-declarations "macduffie.scm"))
   ((and guile (library (json)))
    (import (only (guile) include-from-path import))
    (begin (include-from-path "zambyte/meta/guile-json.scm")))
   (gauche
    (include-library-declarations "gauche.scm"))
   (gerbil
    (include-library-declarations "gerbil.scm"))
   (sagittarius
    (include-library-declarations "sagittarius.scm"))
   ((library (chibi json))
    (include-library-declarations "chibi.scm"))
   ((library (srfi 180))
    (include-library-declarations "180.scm"))
   (else
    (error "No implementation of JSON library available."))))