(define-library (json-rpc gambit)

(export alist-ref
        call-with-output-string
        json-read
        scheme->json-string
        with-output-to-string
        tcp-read-timeout
        tcp-accept
        tcp-close
        tcp-connect
        tcp-listen)

(import (gambit)
        (scheme case-lambda)
        (only (scheme inexact) infinite? nan?)
        (srfi 145)
        (srfi 180))

(begin
  (define (alist-ref key alist)
    (let ((p (assoc key alist)))
      (if p
          (cdr p)
          #f)))

  (define scheme->json-string
    (make-parameter (lambda (scm)
                      (call-with-output-string
                       (lambda (p) (json-write scm p))))))

  (define (call-with-output-string proc)
    (define out-port (open-output-string))
    (dynamic-wind
        (lambda () #t)
        (lambda ()
          (proc out-port)
          (get-output-string out-port))
        (lambda ()
          (when (output-port-open? out-port)
              (close-output-port out-port)))))

  (define (with-output-to-string thunk)
    (define out-port (open-output-string))
    (dynamic-wind
        (lambda () #t)
        (lambda ()
          (parameterize ((current-output-port out-port))
            (thunk)
            (get-output-string out-port)))
        (lambda ()
          (when (output-port-open? out-port)
            (close-output-port out-port)))))

  ;; ignored for now
  (define tcp-read-timeout (make-parameter #f))

  (define (tcp-listen port-number)
    (open-tcp-server port-number))

  (define (tcp-accept listener)
    (let ((p (read listener)))
      (values p p)))

  (define (tcp-close listener)
    (close-port listener))

  (define (tcp-connect tcp-address tcp-port-number)
    (let ((p (open-tcp-client tcp-port-number)))
      (values p p)))))