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

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

(define json-rpc-call
  (case-lambda
   ((method params in-port out-port)
    (json-rpc-write `((id . ,(last-id))
                      (method . ,method)
                      (params . ,params))
                    out-port)
    (increment-last-id!)
    (json-rpc-read in-port))
   ((method params)
    (json-rpc-call method params (current-input-port) (current-output-port)))))


(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))))

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

(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))))

(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))
                      (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)
                      (close-input-port in-port)
                      (close-output-port out-port)
                      (tcp-close listener))
                     (else
                      (write-log 'debug (format "Accepted incoming request"))
                      (loop))))))))))))

(define (json-rpc-install-handler! method handler)
  (hash-table-set! (json-rpc-handler-table) method handler))

(define (json-rpc-delete-handler! method handler)
  (hash-table-delete! (json-rpc-handler-table) method))

(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 ...))))

;;; Notification handlers always return #f, what causes json-rpc-loop not
;;; to send an answer to the caller.
(define-syntax define-notification-handler
  (syntax-rules ()
    ((define-notification-handler (handler method params #:exit? exit?) body ...)
     (begin
       (define (handler params)
         body ... #f)
       (json-rpc-install-handler! method handler)))
    ((define-notification-handler (handler method params) body ...)
     (define-notification-handler (handler method params #:exit? #f) body ...))))