(import (chicken file)
        (chicken port)
        (chicken process)
        (json-rpc)
        (json-rpc lolevel)
        medea
        r7rs
        scheme
        srfi-18
        test)

(define server-in-file (create-temporary-file))
(define server-out-file (create-temporary-file))

(define (run-server)
  (define server-pid
    (process-fork
     (lambda ()
       (parameterize
           ((json-rpc-handler-table
             `(("hello" . ,(lambda (params)
                             (let ((name (cdr (assoc 'name params))))
                               (string-append "Hello " name))))
               ("crash" . ,(lambda (params)
                             (raise (make-json-rpc-internal-error
                                     "Crash"))))
               ("exit" . ,(lambda (params)
                            (json-rpc-exit)
                            #f))))
            (json-rpc-log-level 0))
         (call-with-input-file server-in-file
           (lambda (in-port)
             (call-with-output-file server-out-file
               (lambda (out-port)
                 (json-rpc-loop in-port out-port))
               #:text))
           #:text)))))
  (process-wait server-pid))

(define (run-test method params expected-result)
  (call-with-input-file server-out-file
    (lambda (in-port)
      (call-with-output-file server-in-file
        (lambda (out-port)
          (guard (condition (#t))
            (json-rpc-call in-port
                           out-port
                           method
                           '((name . "World!")))
            (run-server))
          (with-input-from-file server-out-file
            (lambda ()
              (read-line) ;;ignore Content-Length header
              (let ((response (read-json)))
                (if expected-result
                    (begin
                      (test "Hello World!" (alist-ref 'result response))
                      (test #f (alist-ref 'error response)))
                    (begin
                      (test-assert
                          (alist-ref 'error response))
                      (test #f (alist-ref 'result response))))))))
        #:text))
    #:text))

(test-begin "json-rpc tests")

(run-test "hello" '((name . "World!")) "Hello World!")
(run-test "hellow" '((name . "World!")) #f)
(run-test "crash" '((name . "World!")) #f)

(delete-file server-in-file)
(delete-file server-out-file)
(test-end "json-rpc tests")