;; https://ktakashi.github.io/sections/section762.html
(import (text json)
	(srfi 1)
	(srfi 2)
	(util vector)
	(scheme case-lambda))
(begin
  (define (json-object . pairs)
    (let ((pairs (map (lambda (p) (cons (symbol->string (car p)) (cdr p))) pairs)))
      (if (eq? (*json-map-type*) 'vector)
	  (apply vector pairs)
	  (apply list pairs))))

  (define (json-list . objs)
    (if (eq? (*json-map-type*) 'vector)
	(apply list objs)
	(apply vector objs)))

  (define json-null 'null)

  (define (json-object? json)
    (or (json-record? json)
	(if (eq? (*json-map-type*) 'vector)
	    (vector? json)
	    (list? json))))

  (define (json-list? json)
    (if (eq? (*json-map-type*) 'vector)
	(list? json)
	(vector? json)))

  (define (json-null? obj)
    (eq? obj json-null))

  (define (json-object-contains-key? obj key)
    (or (and ((if (eq? (*json-map-type*) 'vector) vector? list?) obj)
	     (assoc key (json-object->alist obj))
	     #t)
	(and (json-record? obj)
	     (json-object-contains-key? (json-record->fields obj) key))))

  (define (string->json str)
    (call-with-port (open-input-string str)
      (lambda (port)
	(json-read port))))

  (define (json->string json)
    (call-with-port (open-output-string)
      (lambda (port)
	(json-write (json->typeless-json json) port)
	(get-output-string port))))

  (define (json-object-ref json key)
    (cond
     ((and (not (json-record? json)) (json-object? json))
      (let ((pair (assoc key (json-object->alist json))))
	(if pair
	    (cdr pair)
	    ((json-key-not-found)))))
     ((json-record? json)
      (json-object-ref (json-record->fields json) key))
     (else ((json-key-not-found)))))

  (define (json-object-set! json key value)
    (cond
     ((and (not (json-record? json))
	   (json-object? json)
	   (json-object-contains-key? json key))
      (set-cdr! (if (eq? (*json-map-type*) 'vector)
		    (vector-find (lambda (pair) (eq? (string->symbol (car pair)) key)) json)
		    (assoc (symbol->string key) json))
		value)
      json)
     ((json-record? json)
      (or (and-let* ((pair (assoc key (json-record->mutators json)))
		     (mutator (cdr pair)))
	    (set! json (mutator json value))
	    json)
	  (error "json-object-set!: no mutator for field" (json-record->name json) key)))))

  (define (json-list-ref json index)
    (list-ref (json-list->list json) index))

  (define (json-list-length json)
    (if (eq? (*json-map-type*) 'vector)
	(length json)
	(vector-length json)))

  (define (json-object-map proc json)
    ((if (eq? (*json-map-type*) 'vector)
	 vector-map
	 map)
     (lambda (pair)
       (call-with-values (lambda () (proc (string->symbol (car pair)) (cdr pair)))
	 (case-lambda
	   ((key value) (cons (symbol->string key) value))
	   (_ (error "json-object-map: proc did not return two values")))))
     json))

  (define (json-list-map proc json-list)
    (if (eq? (*json-map-type*) 'vector)
	(map proc json-list)
	(vector-map proc json-list)))

  (define (json-object->alist json)
    (cond
     ((and (not (json-record? json)) (json-object? json))
      (map (lambda (p) (cons (string->symbol (car p)) (cdr p)))
	   (if (eq? (*json-map-type*) 'vector)
	       (vector->list json)
	       json)))
     ((json-record? json) (json-object->alist (json->typeless-json obj)))
     (else (error "json-object->alist: not an object" obj))))

  (define (json-list->list json)
    (if (eq? (*json-map-type*) 'vector)
	json
	(vector->list json))))