%% @doc %% category pattern: pattern match -module(datum_cat_reader). %% (/=) -export(['/='/1]). %% (.) operation -export(['.'/3, chain/1, curry/1]). %% category utility -export([unit/1, fail/1, sequence/2, optionT/3, flatten/2]). '/='({call, Ln, Ff0, Fa0}) -> Fa1 = Fa0 ++ [{var, Ln, '_PatternGlobalEnvironment'}], {call, Ln, Ff0, Fa1}; '/='(Arrow) -> exit( lists:flatten(io_lib:format("Pattern category composition do not support the arrow of type: ~p", [Arrow])) ). %% %% compose function(s) using AST notation %% %% case f(_) of {error, _} = Err -> Err ; {ok, X} -> g(X) end %% '.'(_, {either, VarX, G}, {call, Ln, Ff0, Fa0}) -> {Fa1, VarN} = datum_cat:cc_derive(Fa0, []), Expr = dot_expr(Ln, VarX, {call, Ln, Ff0, Fa1}, G), {either, VarN, Expr}; '.'(_, {either, _VarX, G}, {generate, Ln, {var, _, VarN}, F}) -> {Fa1, VarZ} = datum_cat:cc_derive(F, []), Expr = dot_expr(Ln, [VarN], Fa1, G), {either, VarZ, Expr}; '.'(Cat, {call, Ln, Ff0, Fa0}, G) -> {Fa1, VarN} = datum_cat:cc_derive(Fa0, []), '.'(Cat, {either, VarN, {call, Ln, Ff0, Fa1}}, G); '.'(Cat, {generate, _Ln, _Var, F}, G) -> %% ignore tail arrow '.'(Cat, F, G). %% %% dot_expr(Ln, [], F, G) -> Err = datum_cat:uuid(), {'case', Ln, F, [ {clause, Ln, [{match, Ln, {tuple, Ln, [{atom, Ln, error}, {var, Ln, '_'}]}, {var, Ln, Err}}], [], [{var, Ln, Err}] }, {clause, Ln, [{var, Ln, '_'}], [], [G] } ]}; dot_expr(Ln, VarX, F, G) -> Err = datum_cat:uuid(), Pat = [{var, Ln, X} || X <- VarX], {'case', Ln, F, [ {clause, Ln, [{tuple, Ln, [{atom, Ln, ok}|Pat]}], [], [G] }, {clause, Ln, [{match, Ln, {tuple, Ln, [{atom, Ln, error}, {var, Ln, '_'}]}, {var, Ln, Err}}], [], [{var, Ln, Err}] } ]}. %% %% map compose to expression %% chain({either, _, {'case', Ln, _, _} = Expr}) -> {'fun', Ln, {clauses, [ {clause, Ln, [{var, Ln, '_PatternGlobalEnvironment'}], [], [Expr] } ]} }. %% %% map compose to partial expression %% curry({either, VarX, {'case', Ln, _, _}} = Either) -> {'fun', Ln, {clauses, [ {clause, Ln, [{var, Ln, X} || X <- VarX], [], [chain(Either)] } ]} }. %% %% unit(X) -> {ok, X}. %% %% fail(X) -> {error, X}. %% %% -spec sequence( [datum:either(_)], _ ) -> datum:either([_]). sequence([{ok, Head} | Seq], Env) -> case sequence(Seq, Env) of {ok, Tail} -> {ok, [Head|Tail]}; {error, _} = Error -> Error end; sequence([{error, _} = Error | _], _Env) -> Error; sequence([], _Env) -> {ok, []}. %% %% -spec optionT(_, datum:option(_), _) -> datum:either(_). optionT(Reason, undefined, _Env) -> {error, Reason}; optionT(_, X, _Env) -> {ok, X}. %% %% -spec flatten(_, _) -> datum:either(_). flatten({ok, {ok, _} = X}, Env) -> flatten(X, Env); flatten({ok, {error, _} = X}, Env) -> flatten(X, Env); flatten({error, {ok, _} = X}, Env) -> flatten(X, Env); flatten({error, {error, _} = X}, Env) -> flatten(X, Env); flatten({ok, _} = X, _Env) -> X; flatten({error, _} = X, _Env) -> X.