Permalink
Browse files

Moving from my own Return type to Jane St Core.Result

  • Loading branch information...
1 parent 709174d commit 0e8477f1b3c8581e8e2e7ada10a2a66208f2836d orbitz committed Jun 10, 2012
View
@@ -4,26 +4,26 @@ PACKAGE=-package async,ort_prelude,threads
all: ort_async.cmxa ort_async.cma
-async_return.cmi: async_return.mli
- ocamlfind ocamlc $(PACKAGE) -thread -c async_return.mli
+async_result.cmi: async_result.mli
+ ocamlfind ocamlc $(PACKAGE) -thread -c async_result.mli
ort_async.cmxa: ort_async.cmx
ocamlfind ocamlopt -a -thread -I +camlp4 -o ort_async.cmxa ort_async.cmx
-ort_async.cmx: async_return.cmx
- ocamlfind ocamlopt -pack -o ort_async.cmx async_return.cmx
+ort_async.cmx: async_result.cmx
+ ocamlfind ocamlopt -pack -o ort_async.cmx async_result.cmx
-async_return.cmx: async_return.ml async_return.cmi
- ocamlfind ocamlopt -package async,ort_prelude,threads -thread -c -for-pack Ort_async async_return.ml
+async_result.cmx: async_result.ml async_result.cmi
+ ocamlfind ocamlopt -package async,ort_prelude,threads -thread -c -for-pack Ort_async async_result.ml
ort_async.cma: ort_async.cmo
ocamlfind ocamlc -a -custom -I +camlp4 -o ort_async.cma ort_async.cmo
-ort_async.cmo: async_return.cmo
- ocamlfind ocamlc -pack -o ort_async.cmo async_return.cmo
+ort_async.cmo: async_result.cmo
+ ocamlfind ocamlc -pack -o ort_async.cmo async_result.cmo
-async_return.cmo: async_return.ml async_return.cmi
- ocamlfind ocamlc $(PACKAGE) -thread -c async_return.ml
+async_result.cmo: async_result.ml async_result.cmi
+ ocamlfind ocamlc $(PACKAGE) -thread -c async_result.ml
clean:
@@ -0,0 +1,19 @@
+open Async.Std
+open Ort_prelude
+
+type ('a, 'b) t = ('a, 'b) Result.t Deferred.t
+
+let bind m f =
+ Deferred.bind
+ m
+ (function
+ | Result.Ok v ->
+ f v
+ | Result.Error err ->
+ Deferred.return (Result.Error err))
+
+let fail f =
+ Deferred.return (Result.Error f)
+
+let return v =
+ Deferred.return (Result.Ok v)
@@ -0,0 +1,8 @@
+open Async.Std
+open Ort_prelude
+
+type ('a, 'b) t = ('a, 'b) Result.t Deferred.t
+
+val bind : ('a, 'b) t -> ('a -> ('c, 'b) t) -> ('c, 'b) t
+val fail : 'a -> (_, 'a) t
+val return : 'a -> ('a, _) t
@@ -1,19 +0,0 @@
-open Async.Std
-open Ort_prelude
-
-type ('a, 'b) t = ('a, 'b) Return.t Deferred.t
-
-let bind m f =
- Deferred.bind
- m
- (function
- | Return.Success v ->
- f v
- | Return.Failure f ->
- Deferred.return (Return.Failure f))
-
-let fail f =
- Deferred.return (Return.Failure f)
-
-let return v =
- Deferred.return (Return.Success v)
@@ -1,8 +0,0 @@
-open Async.Std
-open Ort_prelude
-
-type ('a, 'b) t = ('a, 'b) Return.t Deferred.t
-
-val bind : ('a, 'b) t -> ('a -> ('c, 'b) t) -> ('c, 'b) t
-val fail : 'a -> ('b, 'a) t
-val return : 'a -> ('a, 'b) t
View
@@ -1,5 +1,6 @@
name="ort_prelude"
version="1.0.0"
description="My own prelude"
+requires="core_extended threads"
archive(byte)="ort_prelude.cma"
archive(native)="ort_prelude.cmxa"
View
@@ -1,23 +1,25 @@
CAMLP4=-pp "camlp4o pa_extend.cmo"
+PACKAGE=-package core_extended,threads
+
.PHONY: all clean test
all: ort_prelude.cmxa ort_prelude.cma
ort_prelude.cmxa: ort_prelude.cmx
- ocamlfind ocamlopt -a -thread -I +camlp4 -o ort_prelude.cmxa ort_prelude.cmx
+ ocamlfind ocamlopt -a $(PACKAGE) -thread -I +camlp4 -o ort_prelude.cmxa ort_prelude.cmx
ort_prelude.cma: ort_prelude.cmo
- ocamlfind ocamlc -a -custom -I +camlp4 -o ort_prelude.cma ort_prelude.cmo
+ ocamlfind ocamlc -a $(PACKAGE) -thread -custom -I +camlp4 -o ort_prelude.cma ort_prelude.cmo
ort_prelude.cmo: ort_prelude.ml
- ocamlfind ocamlc -c -I +camlp4 $(CAMLP4) ort_prelude.ml
+ ocamlfind ocamlc -c $(PACKAGE) -thread -I +camlp4 $(CAMLP4) ort_prelude.ml
ort_prelude.cmx: ort_prelude.ml ort_prelude.cmi
- ocamlfind ocamlopt -c -I +camlp4 $(CAMLP4) ort_prelude.ml
+ ocamlfind ocamlopt $(PACKAGE) -thread -c -I +camlp4 $(CAMLP4) ort_prelude.ml
ort_prelude.cmi: ort_prelude.mli
- ocamlfind ocamlc -c -I +camlp4 ort_prelude.mli
+ ocamlfind ocamlc $(PACKAGE) -thread -c -I +camlp4 ort_prelude.mli
test: all
@@ -1,14 +1,21 @@
-module Return = struct
- type ('a, 'b) t =
- | Success of 'a
- | Failure of 'b
-
+module Result = struct
+ include Core.Result
+
let lift f =
try
- Success (f ())
+ Ok (f ())
with
- | anything ->
- Failure anything
+ | exn ->
+ Error exn
+
+ let bind m f =
+ match m with
+ | Ok v ->
+ f v
+ | Error err ->
+ Error err
+
+ let return v = Ok v
end
let (|>) d f = f d
@@ -1,9 +1,9 @@
-module Return : sig
- type ('a, 'b) t =
- | Success of 'a
- | Failure of 'b
-
+module Result : sig
+ include module type of Core.Result
val lift : (unit -> 'a) -> ('a, exn) t
+
+ val bind : ('a, 'b) t -> ('a -> ('c, 'b) t) -> ('c, 'b) t
+ val return : 'a -> ('a, _) t
end
val (|>) : 'a -> ('a -> 'b) -> 'b
View
@@ -55,15 +55,15 @@ let string_of_ack = function
let cmd_of_string = function
| "CONNECTED" ->
- Return.Success Connected
+ Result.Ok Connected
| "MESSAGE" ->
- Return.Success Message
+ Result.Ok Message
| "RECEIPT" ->
- Return.Success Receipt
+ Result.Ok Receipt
| "ERROR" ->
- Return.Success Error
+ Result.Ok Error
| unknown ->
- Return.Failure (Unknown_cmd unknown)
+ Result.Error (Unknown_cmd unknown)
let make_frame t h b =
let h = content_length b h
@@ -96,12 +96,18 @@ let send ?(h = []) ~dst ~body =
(header_add "destination" dst h)
body
-let subscribe ?(h = []) ?(ack = Client) ?(prefetch = 1) ~dst =
+let subscribe ?(h = []) ?(ack = Client) ?(prefetch = None) ~dst =
let h = h
|> header_add "destination" dst
- |> header_add "prefetch" (string_of_int prefetch)
|> header_add "ack" (string_of_ack ack)
in
+ let h =
+ match prefetch with
+ | None ->
+ h
+ | Some p ->
+ header_add "prefect" (string_of_int p) h
+ in
make_frame Subscribe h ""
let unsubscribe ?(h = []) ~dst =
@@ -125,7 +131,7 @@ let disconnect =
make_frame Disconnect [] ""
let rec parse_frames m =
- Return.lift (fun () -> msg m)
+ Result.lift (fun () -> msg m)
and msg = parser
| [< f = frame; fs = frame_aux >] -> f::fs
and frame = parser
@@ -162,33 +168,33 @@ let parse_state = ""
let rec frames_of_tuples accum = function
| [] ->
- Return.Success (List.rev accum)
+ Result.Ok (List.rev accum)
| (cmd, headers, body)::fs -> begin
match cmd_of_string cmd with
- | Return.Success cmd ->
+ | Result.Ok cmd ->
let frame = make_frame cmd headers body
in
frames_of_tuples (frame::accum) fs
- | Return.Failure f ->
- Return.Failure f
+ | Result.Error f ->
+ Result.Error f
end
let rec frames_of_data ~s ~d =
let s = s ^ d
in
match String.rsplit2 ~on:'\000' s with
| None ->
- Return.Success ([], s)
+ Result.Ok ([], s)
| Some (msgs, rest) -> begin
match parse_frames (Seq.of_string msgs) with
- | Return.Success fs -> begin
+ | Result.Ok fs -> begin
match frames_of_tuples [] fs with
- | Return.Success frames ->
- Return.Success (frames, rest)
- | Return.Failure f ->
- Return.Failure f
+ | Result.Ok frames ->
+ Result.Ok (frames, rest)
+ | Result.Error f ->
+ Result.Error f
end
- | Return.Failure f ->
- Return.Failure (Exn f)
+ | Result.Error f ->
+ Result.Error (Exn f)
end
View
@@ -38,7 +38,7 @@ val get_body : 'a t -> string
val connect : ?h:headers -> (string * string) option -> outgoing t
val send : ?h:headers -> dst:string -> body:string -> outgoing t
-val subscribe : ?h:headers -> ?ack:ack -> ?prefetch:int -> dst:string -> outgoing t
+val subscribe : ?h:headers -> ?ack:ack -> ?prefetch:int option -> dst:string -> outgoing t
val unsubscribe : ?h:headers -> dst:string -> outgoing t
val trans_begin : ?h:headers -> outgoing t
val trans_commit : ?h:headers -> outgoing t
@@ -47,4 +47,4 @@ val ack : ?h:headers -> mid:string -> outgoing t
val disconnect : outgoing t
val parse_state : parse_state
-val frames_of_data : s:parse_state -> d:string -> ((incoming t list * parse_state), error) Return.t
+val frames_of_data : s:parse_state -> d:string -> ((incoming t list * parse_state), error) Result.t

0 comments on commit 0e8477f

Please sign in to comment.