[enhance] Hlnet: Change string error to typed opa record

alokmenghrajani · Aug 1, 2011 · 1206b6a · 1206b6a
1 parent 31086be
commit 1206b6a
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 3 deletions.
diff --git a/opabsl/mlbsl/bslHlnet.ml b/opabsl/mlbsl/bslHlnet.ml
@@ -29,6 +29,25 @@ let scheduler = BslScheduler.opa
 ##extern-type [normalize] channel('o, 'i) = ('o, 'i) Hlnet.channel
 ##extern-type [normalize] channel_spec('o, 'i) = ('o, 'i) Hlnet.channel_spec
 
+##opa-type Hlnet.error
+
+
+(** Projection of ocaml exn raised by hlnet to an opa record
+    (Hlnet.error). *)
+let hlnetexn_ml_to_opa =
+  let disconnected =
+    let fdisconnected = ServerLib.static_field_of_name "disconnected" in
+    function (e:Hlnet.endpoint) ->
+      wrap_opa_hlnet_error (
+        ServerLib.make_record
+          (ServerLib.add_field ServerLib.empty_record_constructor
+             fdisconnected e
+          )
+      )
+  in function
+    | Hlnet.Disconnected ep -> disconnected ep
+    | e -> failwith (Printf.sprintf "Unknow hlnet exn: %s" (Printexc.to_string e))
+
 ##register new_endpoint : string, int -> endpoint
 let new_endpoint addr port =
     (Hlnet.Tcp (Unix.inet_addr_of_string addr, port))
@@ -94,10 +113,10 @@ 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
+##register[cps-bypass] sendreceiverr: channel('o, 'i), 'o, continuation(outcome('i, Hlnet.error)) -> void
 let sendreceiverr chan opack k =
   Hlnet.sendreceive' chan opack
-    (fun e -> BslUtils.create_outcome (`failure (Printexc.to_string e)) |> k)
+    (fun e -> BslUtils.create_outcome (`failure (hlnetexn_ml_to_opa e)) |> k)
     (fun r -> BslUtils.create_outcome (`success r) |> k)
 
 ##register async_receive: channel('o, 'i), ('i -> void) -> void

diff --git a/stdlib/core/rpc/hlnet/hlnet.opa b/stdlib/core/rpc/hlnet/hlnet.opa
@@ -74,6 +74,10 @@ type Hlnet.protocol('query,'response) = {
   server_spec: Hlnet.channel_spec('response,'query);
 }
 
+/** Type that describes hlnet error. */
+type Hlnet.error =
+  {disconnected : Hlnet.endpoint}
+
 /**
  * {1 Interface}
  */
@@ -151,7 +155,7 @@ Hlnet =
     sndrcv = %%BslHlnet.sendreceive%%
     sndrcv(chan, msg)
 
-  sendreceiverr = %%BslHlnet.sendreceiverr%% : Hlnet.channel('a, 'b), 'a -> outcome('b, string)
+  sendreceiverr = %%BslHlnet.sendreceiverr%% : Hlnet.channel('a, 'b), 'a -> outcome('b, Hlnet.error)
 
 
   /** {6 Receiving on channels and setting up handlers} */