stdext/Either: A module for type ('a, 'b) t = Left of 'a | Right of 'b

and helper functions.

Signed-off-by: Matthias Goergens <matthias.goergens@citrix.com>

diff --git a/stdext/Makefile b/stdext/Makefile
index 728d3ea5b70834c9a5f2350698fc1512727fbbd6..cba57bd53c2a387a54c19147ec4d3b9fe9ac1139 100644 (file)
--- a/stdext/Makefile
+++ b/stdext/Makefile
@@ -22,7 +22,7 @@ OCAML_TEST_LIB = $(shell ocamlfind query oUnit)/oUnit.cmxa
 
 STDEXT_OBJS = fun listext filenameext stringext arrayext hashtblext pervasiveext threadext ring \
        qring fring opt bigbuffer unixext range vIO trie config date encodings fe fecomms \
-       forkhelpers gzip sha1sum zerocheck base64 backtrace tar mapext os
+       forkhelpers gzip sha1sum zerocheck base64 backtrace tar mapext os either
 
 INTF = $(foreach obj, $(STDEXT_OBJS),$(obj).cmi)
 LIBS = stdext.cma stdext.cmxa

diff --git a/stdext/either.ml b/stdext/either.ml
new file mode 100644 (file)
index 0000000..42e6fe1
--- /dev/null
+++ b/stdext/either.ml
@@ -0,0 +1,24 @@
+open Pervasiveext
+
+type ('a,'b) t = Left of 'a | Right of 'b
+
+let left x = Left x
+let right x = Right x
+let is_left = function
+       | Left _ -> true
+       | Right _ -> false
+let is_right x = not ++ is_left $ x
+let to_option = function
+       | Right x -> Some x
+       | Left _ -> None
+
+let cat_right l = Opt.cat_some ++ List.map to_option $ l
+
+let join = function
+       | Right (Right x) -> Right x
+       | Left x -> Left (Left x)
+       | Right (Left x) -> Left (Right x)
+
+let swap = function
+       | Right x -> Left x
+       | Left x -> Right x

diff --git a/stdext/either.mli b/stdext/either.mli
new file mode 100644 (file)
index 0000000..ee1223f
--- /dev/null
+++ b/stdext/either.mli
@@ -0,0 +1,18 @@
+(* Inspired by Haskell's Either, as a way to enhance option with
+   information about what went wrong.
+
+   Right is commonly used for success
+   Left is commonly used for failure.
+ *)
+
+type ('a,'b) t = Left of 'a | Right of 'b
+val left : 'a -> ('a, 'b) t
+val right: 'b -> ('a, 'b) t
+val is_left: ('a, 'b) t -> bool
+val is_right: ('a, 'b) t -> bool
+
+val cat_right: ('a, 'b) t list -> 'b list
+(* Brings Right values closer to the surface. *)
+val join: ('a, ('b, 'c) t) t -> (('a, 'b) t, 'c) t
+
+val swap : ('a, 'b) t -> ('b, 'a) t