Browse files

[enhance] Hlnet: send receive with error

  • Loading branch information...
1 parent 47c2cc8 commit 31086be96497411532838db678ec8293ae88ff58 @BourgerieQuentin BourgerieQuentin committed Aug 1, 2011
Showing with 30 additions and 8 deletions.
  1. +6 −0 opabsl/mlbsl/bslHlnet.ml
  2. +17 −1 opabsl/mlbsl/bslUtils.ml
  3. +4 −6 opabsl/mlbsl/opa_transaction.ml
  4. +3 −1 stdlib/core/rpc/hlnet/hlnet.opa
View
6 opabsl/mlbsl/bslHlnet.ml
@@ -94,6 +94,12 @@ let receive chan k =
let sendreceive chan opack k =
Hlnet.sendreceive chan opack @> fun recv -> recv |> k
+##register[cps-bypass] sendreceiverr: channel('o, 'i), 'o, continuation(outcome('i, string)) -> void
+let sendreceiverr chan opack k =
+ Hlnet.sendreceive' chan opack
+ (fun e -> BslUtils.create_outcome (`failure (Printexc.to_string e)) |> k)
+ (fun r -> BslUtils.create_outcome (`success r) |> k)
+
##register async_receive: channel('o, 'i), ('i -> void) -> void
let async_receive chan handler =
Hlnet.receive chan handler
View
18 opabsl/mlbsl/bslUtils.ml
@@ -30,6 +30,9 @@ let fclient = ServerLib.static_field_of_name "client"
let fserver = ServerLib.static_field_of_name "server"
let fnothing = ServerLib.static_field_of_name "nothing"
+let fsuccess =ServerLib.static_field_of_name "success"
+let ffailure =ServerLib.static_field_of_name "failure"
+
let rnone = ServerLib.make_record (ServerLib.add_field ServerLib.empty_record_constructor (fnone) (ServerLib.make_record ServerLib.empty_record_constructor))
let rsome x = ServerLib.make_record (ServerLib.add_field ServerLib.empty_record_constructor (fsome) x)
@@ -41,6 +44,8 @@ let rnothing = ServerLib.make_record (ServerLib.add_field ServerLib.empty_rec
##opa-type ThreadContext.client
+##opa-type outcome('a, 'b)
+
(** Project an ['a -> void] opa function rewrited by cps to an ['a ->
unit] ml function, usefull for [cps-bypass].
@@ -83,6 +88,17 @@ let create_ctx key request =
)
let get_serverkey context =
-
let rkey = ServerLib.unsafe_dot context fkey in
ServerLib.dot rkey fserver
+
+let create_outcome = function
+ | `success success ->
+ wrap_opa_outcome
+ (ServerLib.make_record
+ (ServerLib.add_field ServerLib.empty_record_constructor
+ fsuccess success))
+ | `failure failure ->
+ wrap_opa_outcome
+ (ServerLib.make_record
+ (ServerLib.add_field ServerLib.empty_record_constructor
+ ffailure failure))
View
10 opabsl/mlbsl/opa_transaction.ml
@@ -174,22 +174,20 @@ let continue t f errh k =
in
f @> set k t
-##opa-type outcome('a,'b)
-
##register [opacapi;cps-bypass] commit: t, continuation(opa[outcome(void,void)]) -> void
-let opa_success : (ServerLib.ty_void, ServerLib.ty_void) opa_outcome =
+let opa_success : (ServerLib.ty_void, ServerLib.ty_void) BslUtils.opa_outcome =
let fld = ServerLib.static_field_of_name "success" in
let fields = ServerLib.empty_record_constructor in
let fields = ServerLib.add_field fields fld ServerLib.void in
let record = ServerLib.make_record fields in
- wrap_opa_outcome record
-let opa_failure : (ServerLib.ty_void, ServerLib.ty_void) opa_outcome =
+ BslUtils.wrap_opa_outcome record
+let opa_failure : (ServerLib.ty_void, ServerLib.ty_void) BslUtils.opa_outcome =
let fld = ServerLib.static_field_of_name "failure" in
let fields = ServerLib.empty_record_constructor in
let fields = ServerLib.add_field fields fld ServerLib.void in
let record = ServerLib.make_record fields in
- wrap_opa_outcome record
+ BslUtils.wrap_opa_outcome record
let opa_outcome b = if b then opa_success else opa_failure
View
4 stdlib/core/rpc/hlnet/hlnet.opa
@@ -151,6 +151,8 @@ Hlnet =
sndrcv = %%BslHlnet.sendreceive%%
sndrcv(chan, msg)
+ sendreceiverr = %%BslHlnet.sendreceiverr%% : Hlnet.channel('a, 'b), 'a -> outcome('b, string)
+
/** {6 Receiving on channels and setting up handlers} */
@@ -281,7 +283,7 @@ Hlnet =
@private endpoint_port = %%BslHlnet.EndpointGet.port%% : endpoint -> int
/** {6 Peerpoints} */
-
+
/** Converting a endpoint to a peerpoint */
@private
endpoint_to_peerpoint(ep:Hlnet.endpoint):Hlnet.peerpoint=

0 comments on commit 31086be

Please sign in to comment.