SXPath like JSON query tools (scratch)

tools.scm

(import (rnrs) (srfi :1) (json) (pp))

(define data (call-with-input-file "data.json" json-read))
(pp data)

(define (json:first-node data)
  (cond ((vector? data) (vector-ref data 0))
	((pair? data) (if (pair? (cdr data)) (cadr data) (cdr data)))
	(else data))) ;; value node?

;; we don't consider value as node (should be leaf...)
(define (json:node? data)
  (or (vector? data) ;; associated array
      ;; array
      (and (pair? data) (string? (car data)) (not (null? (cdr data))))))

(define (json:as-nodeset data)
  (if (and (pair? data) (json:node? (car data)))
      data
      (list data)))
(define (json:child-nodes data)
  (cond ((pair? data) (cdr data)) ;; first one is property
	((vector? data) (vector->list data))
	(else data))) ;; value node?

;; misc
;; returns a list whatever the data is
(define (json:map1 proc data)
  (cond ((pair? data) 
	 (if (pair? (cdr data))
	     (map proc (cdr data))
	     (list (proc (cdr data)))))
	((vector? data)
	 (do ((len (vector-length data)) (i 0 (+ i 1))
	      (r '() (cons (proc (vector-ref data i)) r)))
	     ((= i len) (reverse! r))))
	(else '())))

(define (json:filter pred?)
  (lambda (node-list)
    (let loop ((lst (json:as-nodeset node-list)) (r '()))
      (if (null? lst)
	  (reverse! r)
	  (let ((result (pred? (car lst))))
	    (loop (cdr lst) (if (and result (not (null? result)))
				(cons (car lst) r)
				r)))))))
(define (json:parent pred?)
  (lambda (root)
    (lambda (node)
      ;; make alist of (child . parent)
      (let loop ((pairs (json:map1 (lambda (root-n) (cons root-n root))
				   root)))
	(if (null? pairs)
	    '()
	    (let ((pair (car pairs)))
	      (if (eq? (car pair) node)
		  ((json:filter pred?) (list (cdr pair)))
		  ;; create first child's (child . parent) alist
		  ;; and append it
		  (loop (append (json:map1 
				 (lambda (root) (cons root (car pair)))
				 (car pair)) (cdr pairs))))))))))

(pp (((json:parent (lambda (node) #t)) data)
     (cadr (vector-ref data 2))))