(use json list-of srfi-13 regex)

(define (json-fix jro)
  (cond ((null? jro) jro)
        ((vector? jro)
         (alist->hash-table (json-fix (vector->list jro))))
        ((pair? jro)
         (cons (json-fix (car jro))
               (json-fix (cdr jro))))
        (else jro)))

(define (json->scm port)
  (json-fix (json-read port)))

(define (scm->json obj port)
  (json-write obj port))

(define (mapcat f l)
  (foldr append '() (map f l)))

(define (partial f . args)
  (lambda more (apply f (append args more))))

(define (jt-array ins ops table args)
  (let ((jt* (lambda (x) (jt (cons x (cdr ins)) ops '(()) args))))
    (map (partial apply append)
         (list-of (list i j) (i in table) (j in (mapcat jt* (car ins)))))))

(define (jt-op-u ins ops table args)
  (jt (cdr ins) ops table (cdr args)))

(define (jt-op-p ins ops table args)
  (jt ins ops (map (lambda (x) (append x (list (car ins)))) table) (cdr args)))

(define (jt-op-d ins ops table args)
  (let ((val (hash-table-ref (car ins) (cadr args))))
    (jt (cons val ins) ops table (cddr args))))

(define (jt-op-lb ins ops table args)
  (let ((os (if (equal? '() (car ops))
              ops
              (cons (cons 'no-print (car ops)) (cdr ops)))))
    (jt ins (cons '() os) table (cdr args))))

(define (jt-op-rb ins ops table args)
  (let ((ps (if (string? (caar ops)) '("-p") '()))
        (us (list-of "-u" (i in (filter string? (car ops))))))
    (jt ins (cdr ops) table (append ps us (cdr args)))))

(define (jt-op-arg ins ops table args)
  (let ((ops* (cons (cons (car args) (car ops)) (cdr ops))))
    (jt ins ops* table (cons "-d" args))))

(define (jt-obj ins ops table args)
  ((cond
     ((equal? "-u" (car args)) jt-op-u)
     ((equal? "-p" (car args)) jt-op-p)
     ((equal? "-d" (car args)) jt-op-d)
     ((equal? "["  (car args)) jt-op-lb)
     ((equal? "]"  (car args)) jt-op-rb)
     (else                     jt-op-arg)) ins ops table args))

(define (jt ins ops table args)
  (cond
    ((equal? '() args) table)
    ((list? (car ins)) (jt-array ins ops table args))
    (else              (jt-obj ins ops table args))))

(define (json-table port args)
  (jt (list (json->scm port)) '(()) '(()) args))

(define (str x)
  (cond
    ((string?  x) x)
    ((number?  x) (number->string x))
    (else (call-with-output-string (partial scm->json x)))))

(define (print-row fs rs row)
  (display (string-append (string-join (map str row) fs) rs)))

(define (print-table table fs rs)
  (for-each (partial print-row fs rs) table))

(let lp ((args (command-line-arguments)) (fs "\t") (rs "\n"))
  (let* ((r (regexp "^-(F|R)(.)?$"))
         (m (string-search r (car args))))
    (if m
      (let* ((arg? (caddr m))
             (arg  (or arg? (cadr args)))
             (opt  (string->symbol (cadr m)))
             (args (if arg? (cdr args) (cddr args))))
        (case opt
          ('F (lp args arg rs))
          ('R (lp args fs arg))))
      (print-table (json-table (current-input-port) args) fs rs))))