Permalink
Browse files

in Orpc_js_server, trap exns and pass to monad

  • Loading branch information...
1 parent a6ddca0 commit ffec233488bcb2d9867f5bbe57935f2786c4ba31 Jake Donham committed Jul 23, 2010
Showing with 13 additions and 8 deletions.
  1. +12 −8 src/orpc-js-server/orpc_js_server.ml
  2. +1 −0 src/orpc-js-server/orpc_js_server.mli
@@ -203,24 +203,28 @@ sig
type 'a t
val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
+ val fail : exn -> 'a t
end
module Sync =
struct
type 'a t = 'a
let return x = x
let bind x f = f x
+ let fail e = raise e
end
module Handler (M : Monad) =
struct
let handler procs body =
- let (proc_name, arg) =
- match unserialize body with
- | Oblock (0, [| Ostring proc_name; arg |]) -> proc_name, arg
- | _ -> raise (Invalid_argument "bad request") in
- let proc =
- try List.assoc proc_name procs
- with Not_found -> raise (Invalid_argument ("bad request " ^ proc_name)) in
- M.bind (proc arg) (fun s -> M.return (serialize s))
+ try
+ let (proc_name, arg) =
+ match unserialize body with
+ | Oblock (0, [| Ostring proc_name; arg |]) -> proc_name, arg
+ | _ -> raise (Invalid_argument "bad request") in
+ let proc =
+ try List.assoc proc_name procs
+ with Not_found -> raise (Invalid_argument ("bad request " ^ proc_name)) in
+ M.bind (proc arg) (fun s -> M.return (serialize s))
+ with e -> M.fail e
end
@@ -60,6 +60,7 @@ sig
type 'a t
val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
+ val fail : exn -> 'a t
end
module Sync : Monad with type 'a t = 'a

0 comments on commit ffec233

Please sign in to comment.