From: Siraaj Khandkar <siraaj@khandkar.net>
Date: Sun, 21 Dec 2014 07:40:32 +0000 (-0500)
Subject: Define and implement a generic monad behavior.
X-Git-Tag: 1.4.0
X-Git-Url: https://git.xandkar.net/?p=hope.git;a=commitdiff_plain;h=4af0774b16181c76d0deedf0911d53409c8f1078

Define and implement a generic monad behavior.
---

diff --git a/src/hope.app.src b/src/hope.app.src
index 7167180..6ea0b7c 100644
--- a/src/hope.app.src
+++ b/src/hope.app.src
@@ -1,7 +1,7 @@
 {application, hope,
  [
   {description, "Higher Order Programming in Erlang"},
-  {vsn, "1.3.0"},
+  {vsn, "1.4.0"},
   {registered, []},
   {applications, [
                   kernel,
diff --git a/src/hope_monad.erl b/src/hope_monad.erl
new file mode 100644
index 0000000..f0dcb5c
--- /dev/null
+++ b/src/hope_monad.erl
@@ -0,0 +1,16 @@
+-module(hope_monad).
+
+-type t(_A) ::
+    term().
+
+-callback return(A) ->
+    t(A).
+
+-callback map(t(A), fun((A) -> (B))) ->
+    t(B).
+
+%% @doc "pipe" is equivalent to traditional "bind", in general use-case, but is
+%% arguably more useful for composition in Erlang's syntactic setting.
+%% @end
+-callback pipe([fun((A) -> t(B))], A) ->
+    t(B).
diff --git a/src/hope_option.erl b/src/hope_option.erl
index ab6eab7..180c416 100644
--- a/src/hope_option.erl
+++ b/src/hope_option.erl
@@ -1,5 +1,6 @@
 -module(hope_option).
 
+-behavior(hope_monad).
 
 -export_type(
     [ t/1
@@ -8,8 +9,10 @@
 -export(
     [ put/2
     , get/2
+    , return/1
     , map/2
     , iter/2
+    , pipe/2
     , of_result/1
     ]).
 
@@ -33,6 +36,11 @@ put(X, F) ->
 get({some, X}, _) -> X;
 get(none     , Y) -> Y.
 
+-spec return(A) ->
+    {some, A}.
+return(X) ->
+    {some, X}.
+
 -spec map(t(A), fun((A) -> (B))) ->
     t(B).
 map({some, X}, F) -> {some, F(X)};
@@ -43,6 +51,16 @@ map(none     , _) -> none.
 iter({some, X}, F) -> ok = F(X);
 iter(none     , _) -> ok.
 
+-spec pipe([fun((A) -> t(B))], A) ->
+    t(B).
+pipe([], X) ->
+    return(X);
+pipe([F|Fs], X) ->
+    case F(X)
+    of  none      -> none
+    ;   {some, Y} -> pipe(Fs, Y)
+    end.
+
 -spec of_result(hope_result:t(A, _B)) ->
     t(A).
 of_result({ok, X})    -> {some, X};
diff --git a/src/hope_result.erl b/src/hope_result.erl
index feda537..1114197 100644
--- a/src/hope_result.erl
+++ b/src/hope_result.erl
@@ -1,12 +1,15 @@
 -module(hope_result).
 
+-behavior(hope_monad).
 
 -export_type(
     [ t/2
     ]).
 
 -export(
-    [ pipe/2
+    [ return/1
+    , map/2
+    , pipe/2
     , lift_exn/1
     , lift_exn/2
     ]).
@@ -18,6 +21,18 @@
     .
 
 
+-spec return(A) ->
+    {ok, A}.
+return(X) ->
+    {ok, X}.
+
+-spec map(t(A, Error), fun((A) -> (B))) ->
+    t(B, Error).
+map({ok, X}, F) ->
+    {ok, F(X)};
+map({error, _}=Error, _) ->
+    Error.
+
 -spec pipe([F], X) ->
     t(Ok, Error)
     when X     :: any()
diff --git a/test/hope_option_SUITE.erl b/test/hope_option_SUITE.erl
index 2b3dab0..8789d3d 100644
--- a/test/hope_option_SUITE.erl
+++ b/test/hope_option_SUITE.erl
@@ -13,6 +13,7 @@
     , t_get/1
     , t_map/1
     , t_iter/1
+    , t_pipe/1
     ]).
 
 
@@ -34,6 +35,7 @@ groups() ->
         , t_get
         , t_map
         , t_iter
+        , t_pipe
         ],
     Properties = [parallel],
     [ {?GROUP, Properties, Tests}
@@ -75,3 +77,14 @@ t_of_result(_Cfg) ->
     ResultError = {error, Bar},
     {some, Foo} = hope_option:of_result(ResultOk),
     none        = hope_option:of_result(ResultError).
+
+t_pipe(_Cfg) ->
+    Steps =
+        [ fun (0) -> hope_option:return(1); (_) -> none end
+        , fun (1) -> hope_option:return(2); (_) -> none end
+        , fun (2) -> hope_option:return(3); (_) -> none end
+        ],
+    {some, 3} = hope_option:pipe(Steps, 0),
+    none      = hope_option:pipe(Steps, 1),
+    none      = hope_option:pipe(Steps, 2),
+    none      = hope_option:pipe(Steps, 3).
diff --git a/test/hope_result_SUITE.erl b/test/hope_result_SUITE.erl
index 390f28c..9e60e85 100644
--- a/test/hope_result_SUITE.erl
+++ b/test/hope_result_SUITE.erl
@@ -17,12 +17,15 @@
     , t_pipe_error/1
     , t_hope_result_specs/1
     , t_lift_exn/1
+    , t_return/1
+    , t_map/1
     ]).
 
 
 -define(GROUP_PIPE, result_pipe).
 -define(GROUP_SPEC, result_spec).
 -define(GROUP_LIFT, result_lift_exn).
+-define(GROUP_OTHER, result_other).
 
 
 %% ============================================================================
@@ -33,6 +36,7 @@ all() ->
     [ {group, ?GROUP_PIPE}
     , {group, ?GROUP_SPEC}
     , {group, ?GROUP_LIFT}
+    , {group, ?GROUP_OTHER}
     ].
 
 groups() ->
@@ -46,29 +50,28 @@ groups() ->
     LiftTests =
         [ t_lift_exn
         ],
+    OtherTests =
+        [ t_return
+        , t_map
+        ],
     Properties = [parallel],
     [ {?GROUP_PIPE, Properties, PipeTests}
     , {?GROUP_SPEC, Properties, SpecTests}
     , {?GROUP_LIFT, Properties, LiftTests}
+    , {?GROUP_OTHER, Properties, OtherTests}
     ].
 
-init_per_group(?GROUP_LIFT, Cfg) ->
-    Cfg;
-init_per_group(?GROUP_SPEC, Cfg) ->
-    Cfg;
 init_per_group(?GROUP_PIPE, Cfg) ->
     Steps =
         [ fun (0) -> {ok, 1}; (X) -> {error, X} end
         , fun (1) -> {ok, 2}; (X) -> {error, X} end
         , fun (2) -> {ok, 3}; (X) -> {error, X} end
         ],
-    hope_kv_list:set(Cfg, steps, Steps).
+    hope_kv_list:set(Cfg, steps, Steps);
+init_per_group(_, Cfg) ->
+    Cfg.
 
-end_per_group(?GROUP_LIFT, _Cfg) ->
-    ok;
-end_per_group(?GROUP_SPEC, _Cfg) ->
-    ok;
-end_per_group(?GROUP_PIPE, _Cfg) ->
+end_per_group(_, _Cfg) ->
     ok.
 
 
@@ -96,3 +99,14 @@ t_lift_exn(_Cfg) ->
     H = hope_result:lift_exn(F, Label),
     {error, {Class, Reason}} = G(ok),
     {error, {Label, {Class, Reason}}} = H(ok).
+
+t_return(_Cfg) ->
+    X = foo,
+    {ok, X} = hope_result:return(X).
+
+t_map(_Cfg) ->
+    X = foo,
+    Y = bar,
+    F = fun (foo) -> Y end,
+    {ok, Y}    = hope_result:map({ok, X}, F),
+    {error, X} = hope_result:map({error, X}, F).