Commits

Tim van der Linden committed a5479a1

Added method-as-a-symbol hack to support for notification requests.

  • Participants
  • Parent commits a8aa5cd
  • Tags 0.1.6

Comments (0)

Files changed (1)

File json-rpc-client.scm

 ; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 ; POSSIBILITY OF SUCH DAMAGE.
 
+;;; --> Symbol hack -> Make method a symbol for notification, string for no notification
+;;; --> Create worker thread with read-json loop for catching input (dispatcher)
+;;; --> Dispatch notifications from server and responses to different mailboxes
+
 (module json-rpc-client
   (json-rpc-server)
 
   (signal
    (make-property-condition
     'exn 'message
-     (sprintf "Cannot setup connection, the ~S is invalid. Expected ~A type but got ~A."
-	      type expected given))))
+    (sprintf "Cannot setup connection, the ~S is invalid. Expected ~A type but got ~A."
+	     type expected given))))
 
 (define (server-setup-data-error type message)
   (signal
    (make-property-condition
     'exn 'message
-     (sprintf "Cannot setup connection, the given ~S data is invalid. The ~S ~A"
-	      type type message))))
+    (sprintf "Cannot build JSON-RPC request, the given ~S data is invalid. The ~S ~A"
+	     type type message))))
 
 (define (json-rpc-server-error code message)
   (signal
    (make-property-condition
     'exn 'message
-     (sprintf "The JSON-RPC server returned an error. Errorcode: ~A, Native message: ~A"
-	      code message))))
+    (sprintf "The JSON-RPC server returned an error. Errorcode: ~A, Native message: ~A"
+	     code message))))
 
 ; Helper for checking which type we have, did not want to use another dependency for that :)
 (define (get-type x)
-    (cond ((input-port? x) "an input port")
-	  ((output-port? x) "an output port")
-	  ((number? x) "a mumber")
-          ((pair? x) "a pair")
-          ((string? x) "a string")
-          ((list? x) "a list")
-	  ((vector? x) "a vector")
-	  ((boolean? x) "a boolean")
-	  ("something unknown")))
+  (cond ((input-port? x) "an input port")
+	((output-port? x) "an output port")
+	((number? x) "a mumber")
+	((pair? x) "a pair")
+	((string? x) "a string")
+	((list? x) "a list")
+	((vector? x) "a vector")
+	((boolean? x) "a boolean")
+	("something unknown")))
 
 ; Setup the server and return a procedure to setup the method and optional params
 ; Do some basic checking if the input, output and version are as expected
 ;; - ouptput: ouput port of the JSON-RPC server
 ;; - version: the JSON-RPC version in which we want to communicate
 (define (json-rpc-server input output #!optional (version "2.0"))
-    (cond ((not (input-port? input)) (server-setup-arguments-error "input port" "input-port" (get-type input)))
-	  ((not (output-port? output)) (server-setup-arguments-error "output port" "ouput-port" (get-type output)))
-	  ((not (is-valid-version? version)) (server-setup-arguments-error "version" "2.0" version))
-	  (else
-	   (lambda (method notification . params) ;If "notification" is true, no repsonse or error will be returned as defined by the spec
-	     (cond ((not (is-valid-method? method)) (server-setup-data-error "method" "can only be a string."))
-		   ((not (are-valid-params? params)) (server-setup-data-error "params" "can only be a vector or an alist."))
-		   (else
-		    (send-request (remove null? (list (cons 'jsonrpc version)
-						      (cons 'method method)
-						      (if (null? params)
-							  '()
-							  (cons 'params (build-params params)))
-						      (if notification
-							  '()
-							  (cons 'id "1")))) ;ID is hardcoded - can't handle more then one request at a time...or can we?
-				  output)
-		    (read-input input)))))))
+  (cond ((not (input-port? input)) (server-setup-arguments-error "input port" "input-port" (get-type input)))
+	((not (output-port? output)) (server-setup-arguments-error "output port" "ouput-port" (get-type output)))
+	((not (is-valid-version? version)) (server-setup-arguments-error "version" "2.0" version))
+	(else
+	 (lambda (method . params)
+	   (cond ((not (is-valid-method? method)) (server-setup-data-error "method" "can only be a string or a symbol."))
+		 ((not (are-valid-params? params)) (server-setup-data-error "params" "can only be a vector or an alist."))
+		 (else
+		  (send-request (remove null? (list (cons 'jsonrpc version)
+						    (cons 'method (if (symbol? method)
+								      (symbol->string method)
+								      method))
+						    (if (null? params)
+							'()
+							(cons 'params (build-params params)))
+						    (if (symbol? method) ;Hack to make this request a notification or not
+							'()
+							(cons 'id "1")))) ;ID is hardcoded - can't handle more then one request at a time...or can we?
+				output)))))))
 
 ; Helper for building a vector or alist from the parameters if present
-(define (build-params params)    
-    (if (keyword? (car params)) 
-	(build-alist params)
-	(list->vector (build-vector params))))
+(define (build-params params)
+  (if (keyword? (car params)) 
+      (build-alist params)
+      (list->vector (build-vector params))))
 
 ; Helper for building an alist
 (define (build-alist params)
-    (if (null? params) 
-	'()
-	(cons (cons (car params) (car (cdr params))) (build-alist (cdr (cdr params))))))
+  (if (null? params) 
+      '()
+      (cons (cons (car params) (car (cdr params))) (build-alist (cdr (cdr params))))))
 
 ; Helper for building a vector
 (define (build-vector params)
-    (if (null? params)
-	'()
-	(cons (symbol->string(car params)) (build-vector (cdr params)))))
+  (if (null? params)
+      '()
+      (cons (symbol->string(car params)) (build-vector (cdr params)))))
 
-; Check if the method is a string as defined in the spec
+; Check if the method is a string as defined in the spec...or a symbol, which is a small hack to set the request as a notification
 (define (is-valid-method? method)
-    (string? method))
+  (or (string? method)
+      (symbol? method)))
 
 ; Check if the params are a list as defined in the spec
 (define (are-valid-params? params)
-    (list? params)) ;Assumptions? Don't know if this check is enough (check for null (is also a list) or list)
+  (list? params)) ;Assumptions? Don't know if this check is enough (check for null (is also a list) or list)
 
 ; Check if the version is correctly formatted as defined in the spec
 (define (is-valid-version? version)
-    (string=? version "2.0"))
+  (string=? version "2.0"))
 
 ; Send the actual request using Medea
 (define (send-request request output)
-    (write-json request output))
-
-; Read and parse the input sent back from the JSON-RPC server
-;; Error: The JSON-RPC server returnes an error object, so throw an error
-;; Response: The serer returns a response object, just pass it trough
-(define (read-input input)
-  (let ((input (read-json input)))
-    (if (alist-ref 'error input)
-	(json-rpc-server-error (alist-ref 'code (alist-ref 'error input)) 
-			       (alist-ref 'message (alist-ref 'error input)))
-	(display input))))
+  (write-json request output))
 
 )