(define last-id (make-parameter 0))

(define (increment-last-id!)
  (last-id (+ 1 (last-id))))

(define (json-rpc-call in-port out-port method params)
  (json-rpc-write `((id . ,(last-id))
                    (method . ,method)
                    (params . ,params))
                  out-port)
  (increment-last-id!)
  (let ((response (json-rpc-read in-port)))
    (write-log 'debug
               (format "json-rpc-call response: ~a" response))
    (cond ((list? response)
           (let ((result (assoc 'result response))
                 (err (assoc 'error response)))
             (cond (result => cdr)
                   (err (error (cdr err)))
                   (else (error "invalid response: " err)))))
          (else response))))

(define (json-rpc-call/tcp tcp-address tcp-port-number method params)
  (let-values (((in-port out-port)
                (tcp-connect tcp-address tcp-port-number)))
    (let ((res (json-rpc-call in-port out-port method params)))
      (close-output-port out-port)
      (close-input-port in-port)
      res)))

(define json-rpc-start-server/tcp
  (case-lambda
   ((tcp-port-number tcp-error-port-number)
    (let-values (((in-err-port out-err-port)
                  (tcp-connect "127.0.0.1" tcp-error-port-number)))
      (parameterize ((current-error-port out-err-port))
        (json-rpc-start-server/tcp tcp-port-number))))
   ((tcp-port-number)
    (parameterize ((tcp-read-timeout #f))
      (let ((listener (tcp-listen tcp-port-number)))
        (write-log 'info
                   (format "listening on port ~a with log level ~a~%"
                           tcp-port-number
                           (json-rpc-log-level)))
        (guard
         (condition (#t (begin
                          (write-log 'error (format "JSON-RPC error: ~a" condition))
                          (cond-expand (chicken (print-error-message condition))
                                       (else (display condition)))
                          #f)))
         (let loop ()
           (let-values (((in-port out-port)
                         (tcp-accept listener)))
             (if (eqv? (json-rpc-loop in-port out-port) 'json-rpc-exit)
                 (begin
                   (close-port in-port)
                   (cond-expand
                    ;;; gambit and guile return a single bidirectional
                    ;;; port, so we close only one of them
                    (chicken (close-output-port out-port))
                    (else #t))
                   (tcp-close listener))
                 (begin
                   (write-log 'debug (format "Accepted incoming request"))
                   (loop)))))))))))