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

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

;;; Call `method` with given `params`. Optionally provide in/out-ports,
;;; which default to current-input/output-port respectivelly.
;;; This procedure is synchronous and returns the result of the given
;;; `method`.
(define json-rpc-call
  (case-lambda
   ((method params in-port out-port)
    (json-rpc-write `((id . ,(last-id))
                      (method . ,method)
                      (params . ,params))
                    out-port)
    (flush-output-port out-port)
    (increment-last-id!)
    (json-rpc-read in-port))
   ((method params)
    (json-rpc-call method params (current-input-port) (current-output-port)))))

;;; Call `method` with given `params`. Optionally provide in/out-ports,
;;; which default to current-input/output-port respectivelly.
;;; Notifications are requests where the client is not interested in
;;; the response. So the response is undefined and should be ignored.
(define json-rpc-send-notification
  (case-lambda
   ((method params)
    (json-rpc-send-notification method params (current-output-port)))
   ((method params out-port)
    (write-log 'debug
               (format "json-rpc-send-notification method: ~s ~s"
                       method
                       params))
    (json-rpc-write `((method . ,method)
                      (params . ,params))
                    out-port)
    (flush-output-port out-port))))

(define json-rpc-send-request json-rpc-call)

;;; Like `json-rpc-call`, but instead of in/out-ports the caller
;;; must provide a `tcp-address` and a `tcp-port-number` (both strings).
(define (json-rpc-call/tcp method params tcp-address tcp-port-number)
  (call-with-values (lambda () (tcp-connect tcp-address tcp-port-number))
    (lambda (in-port out-port)
      (let ((res (json-rpc-call method params in-port out-port)))
        (close-output-port out-port)
        (close-input-port in-port)
        res))))

;;; Starts a TCP JSON-RPC server. You should parameterize
;;; `json-rpc-handler-table` before calling this. See tests/server.scm
;;; for an example.
(define json-rpc-start-server/tcp
  (case-lambda
   ((tcp-port-number tcp-error-port-number)
    (call-with-values (lambda ()
                        (tcp-connect "127.0.0.1" tcp-error-port-number))
      (lambda (in-err-port out-err-port)
        (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 ~s with log level ~s~%"
                           tcp-port-number
                           (json-rpc-log-level)))
        (let loop ()
          (call-with-values (lambda () (tcp-accept listener))
            (lambda (in-port out-port)
              (guard
                  (condition
                   (else (write-log 'debug (format "error signaled ~a" condition))
                         (when (input-port-open? in-port)
                           (close-input-port in-port))
                         (when (output-port-open? out-port)
                           (close-output-port out-port))
                         (close-input-port in-port)
                         (close-output-port out-port)
                         (tcp-close listener)))
                (cond ((eqv? (json-rpc-loop in-port out-port) 'json-rpc-exit)
                       (when (input-port-open? in-port)
                         (close-input-port in-port))
                       (when (output-port-open? out-port)
                         (close-output-port out-port))
                       (tcp-close listener))
                      (else
                       (write-log 'debug (format "Accepted incoming request"))
                       (loop))))))))))))

;;; Dynamically install a handler (procedure accepting a single
;;; argument) for a given method name (string).
(define (json-rpc-install-handler! method handler)
  (hash-table-set! (json-rpc-handler-table) method handler))

;;; Remove a given handler my name (string).
(define (json-rpc-delete-handler! method)
  (hash-table-delete! (json-rpc-handler-table) method))

;;; Helper macro which allows to define and install a handler at once.
;;; Its syntax is of the form
;;;  (define-request-handler (my-handler "my-method" params)
;;;    (... ))
;;; See tests/run.scm for same examples.
(define-syntax define-request-handler
  (syntax-rules ()
    ((define-request-handler (handler method params #:exit? exit?) body ...)
     (begin
       (define (handler params)
         body ...)
       (json-rpc-install-handler! method handler)))
    ((define-request-handler (handler method params) body ...)
     (define-request-handler (handler method params #:exit? #f) body ...))))