Permalink
Browse files

Merge pull request #16 from jonludlam/more-fixes

Fix an minor issue with Xmlrpc and make Jsonrpc and Xmlrpc more alike
  • Loading branch information...
2 parents 7de5b44 + 2c54a48 commit 3726c78dd0dbb57865caf1a5263bbc27044f43ee @samoht committed Dec 20, 2012
Showing with 32 additions and 15 deletions.
  1. +26 −13 lib/jsonrpc.ml
  2. +5 −1 lib/jsonrpc.mli
  3. +1 −1 lib/xmlrpc.ml
View
@@ -67,6 +67,11 @@ let to_string t =
to_buffer t buf;
Buffer.contents buf
+let to_a ~empty ~append t =
+ let buf = empty () in
+ to_fct t (fun s -> append buf s);
+ buf
+
let new_id =
let count = ref 0L in
(fun () -> count := Int64.add 1L !count; !count)
@@ -79,22 +84,28 @@ let string_of_call call =
] in
to_string json
+let json_of_response response =
+ if response.Rpc.success then
+ Dict [
+ "result", response.Rpc.contents;
+ "error", Null;
+ "id", Int 0L
+ ]
+ else
+ Dict [
+ "result", Null;
+ "error", response.Rpc.contents;
+ "id", Int 0L
+ ]
+
let string_of_response response =
- let json =
- if response.Rpc.success then
- Dict [
- "result", response.Rpc.contents;
- "error", Null;
- "id", Int 0L
- ]
- else
- Dict [
- "result", Null;
- "error", response.Rpc.contents;
- "id", Int 0L
- ] in
+ let json = json_of_response response in
to_string json
+let a_of_response ~empty ~append response =
+ let json = json_of_response response in
+ to_a ~empty ~append json
+
type error =
| Unexpected_char of int * char * (* json type *) string
| Invalid_value of int * (* value *) string * (* json type *) string
@@ -483,6 +494,8 @@ end
let of_fct = Parser.of_stream
let of_string = Parser.of_string
+let of_a ~next_char b =
+ Parser.of_stream (fun () -> next_char b)
exception Malformed_method_request of string
exception Malformed_method_response of string
View
@@ -18,11 +18,15 @@ val of_string : string -> Rpc.t
val to_fct : Rpc.t -> (string -> unit) -> unit
val of_fct : (unit -> char) -> Rpc.t
+val to_a : empty:(unit -> 'a) -> append:('a -> string -> unit) -> Rpc.t -> 'a
+val of_a : next_char:('a -> char) -> 'a -> Rpc.t
+
val string_of_call: Rpc.call -> string
val call_of_string: string -> Rpc.call
val string_of_response: Rpc.response -> string
val response_of_string: string -> Rpc.response
val response_of_in_channel : in_channel -> Rpc.response
-
+val a_of_response : empty:(unit -> 'a) -> append:('a -> string -> unit) -> Rpc.response -> 'a
+
View
@@ -135,7 +135,7 @@ let add_response add response =
else
Dict [ "Status", String "Failure"; "ErrorDescription", response.contents ] in
add "<?xml version=\"1.0\"?><methodResponse><params><param>";
- add (to_string v);
+ to_a ~empty:(fun () -> ()) ~append:(fun _ s -> add s) v;
add "</param></params></methodResponse>"
let string_of_response response =

0 comments on commit 3726c78

Please sign in to comment.