% Erlang being a pure functional language (my) code is often busy
% carrying a little ball of state around from function to function.
% It soon becomes natural to use this as the last argument(s) to
% functions and to write "sequencers" that take curried functions that
% are applied, in sequence, to the state.

% (Currying is defined in a utility library.  For example,
% curry_2(Fun) -> fun(A) -> fun(B) -> Fun(A, B) end end.)

% This convention requires that each function return the state, of
% course.

% In addition it is often conventient for a function to be able to
% either abort a sequence or skip an action.  Such functions could
% return fail (the state is discarded) or skip (the previous state is
% re-used).

% Here's an example from some code where the ball of state is a graph:

% seq([],         Acc, Graph) -> {Acc, Graph};
% seq([Fun|Funs], Acc, Graph) ->
%     case Fun(Graph) of
%         fail -> fail;
%         skip -> seq(Funs, Acc, Graph);
%         {Results, Graph2} -> seq(Funs, Results ++ Acc, Graph2)
%     end.
% seq(Funs, Graph) -> seq(Funs, [], Graph).

% In this code actions (functions) return {List, Graph} and the lists
% are appended.

% Now it seems to me that this is rather like a monad (may even, in
% some cases, *be* a monad) and that we can generalise the sequencing
% functions that are used.

% There's a subtlety here - as far as I can see, the "monad" is the
% tuple {Acc, Graph}, not the Graph alone.

% What is Acc and how does it fit into our idea of a Monad?  Within
% the sequencing there are two parallel processes at work.  Some of
% the state is accumulated using append, the rest is simply chained.
% This "composite Monad" pattern is fairly common - it seems to occur
% when we are constructing some "result" in the presence of a more
% persistent "kernel" of state.

% But either of the two "halves" of this "composite monad" can be
% unused, depending on the particular case.  So a practical library
% will have a variety of sequencing functions (I guess there will be
% other, more complex cases, but these seem sufficiently general to
% cover a wide range of problems).

% If the graph example above seems contrived, consider this code from
% a parser combinator library.  Again we have state in two pieces - a
% Stream which we consume and which is chained through various
% Parsers, and a result which is typically the recognised string or a
% list of tokens and which is accumulated separately.

% foldl(_,   Acc, [],               Stream) -> {match, Acc, Stream};
% foldl(Fun, Acc, [Parser|Parsers], Stream) ->
%     case Parser(Stream) of
%         {match, Result, Stream2} ->
%             foldl(Fun, Fun(Result, Acc), Parsers, Stream2);
%         {empty, Stream2} ->
%             foldl(Fun, Acc, Parsers, Stream2);
%         _ -> fail
%     end.

% (for some obscure reason the Acc is not in the penultimate parameter
% position and the function is not really faithful to its name - it's
% a real example, from dirty code, before I had unified everything
% with this library).

% In this parser example the tagged tuple "empty" extends "skip"
% described above by returning a new Stream.  This approach is
% slightly more general and we adopt it below.  In other words,
% "empty" applies only to the accumulation component in the monad (the
% skip behaviour can be achieved by returning empty with the chained
% component unaltered).

% The parser example above will not be able to use this library
% directly because it does not follow the conventions used here - the
% "match" token is separate from the result.  To convert to use this
% library it should either be grouped with result in a tuple, or
% simply dropped.

% The fail and empty results are an ad-hoc extension to whatever type
% is returned by the actions we are executing within the monad.  This
% is trivial to do in an untyped language, but I imagine a little goes
% a long way.  It's probably worth commenting that they seem similar
% to exception and the ordering (>>) operators (the bind operator
% (>>=) is implemented by the sequencing functions here).

% I hope that makes sense.  Here goes...


-module(monad).

% Functions named with trailing underscores take curried functions

-export([seq/2, seq/3, seq_/3, seq/4]).
-export([seq_cons/2, rseq_cons/2, seq_app/2, rseq_app/2]).
-export([repeat/3, repeat_/3, repeat/4]).
-export([map/3, map_acc/4, map_/3, map_acc_/4, map/2, map_acc/3]).
-export([foldl/4, foldl_/4, foldl/3, foldr/4, foldr_/4, foldr/3]).
-export([lift/3, lift/1, drop/3, drop/1]).

% Simple sequencing of functions that take and return a monad.

seq([], Monad) -> Monad;
seq([Fun|Funs], Monad) ->
    case Fun(Monad) of
        fail -> fail;
        {empty, Monad2} -> seq(Funs, Monad2);
        Monad2 -> seq(Funs, Monad2)
    end.


% Sequencing with two arguments - a simple composite monad where both
% components are chained (if the functions take the two in a tuple
% then you can just use seq)

seq([], Result, Kernel) -> {Result, Kernel};
seq([Fun|Funs], Result, Kernel) ->
    case Fun(Result, Kernel) of
        fail -> fail;
        {empty, Kernel2} -> seq(Funs, Result, Kernel2);
        {Result2, Kernel2} -> seq(Funs, Result2, Kernel2)
    end.

% and for curried functions

seq_([], Result, Kernel) -> {Result, Kernel};
seq_([Fun|Funs], Result, Kernel) ->
    case (Fun(Result))(Kernel) of
        fail -> fail;
        {empty, Kernel2} -> seq_(Funs, Result, Kernel2);
        {Result2, Kernel2} -> seq_(Funs, Result2, Kernel2)
    end.


% Alternatively, we may specify a separate function for processing the
% result component

seq(_Join, [], Result, Kernel) -> {Result, Kernel};
seq(Join, [Fun|Funs], Result, Kernel) ->
    case Fun(Kernel) of
        fail -> fail;
        {empty, Kernel2} -> seq(Join, Funs, Result, Kernel2);
        {Result2, Kernel2} ->
            case Join(Result2, Result) of
                fail -> fail;
                skip -> seq(Join, Funs, Result, Kernel);
                Result3 -> seq(Join, Funs, Result3, Kernel2)
            end
    end.


% Common uses of the seq functions cons or append lists

seq_cons(Funs, Kernel) -> seq(fun util:cons/2, Funs, [], Kernel).
rseq_cons(Funs, Kernel) ->
    (lift(fun lists:reverse/1))(seq_cons(Funs, Kernel)).

seq_app(Funs, Kernel) -> seq(fun lists:append/2, Funs, [], Kernel).
rseq_app(Funs, Kernel) ->
    (lift(fun lists:reverse/1))(seq_app(Funs, Kernel)).


% Similar to sequencing, we can repeatedly evaluate the same action
% until fail/empty.

repeat(Fun, Result, Kernel) ->
    case Fun(Result, Kernel) of
        fail -> {Result, Kernel};
        {empty, Kernel2} -> repeat(Fun, Result, Kernel2);
        {Result2, Kernel2} -> repeat(Fun, Result2, Kernel2)
    end.

repeat_(Fun, Result, Kernel) ->
    case ((Fun(Result))(Kernel)) of
        fail -> {Result, Kernel};
        {empty, Kernel2} -> repeat(Fun, Result, Kernel2);
        {Result2, Kernel2} -> repeat(Fun, Result2, Kernel2)
    end.

% And with a separate function for processing the result component.
% We need to be careful to fully promote join (on both arguments)
% since Result could be empty when called, I guess.

repeat(Join, Fun, Result, Kernel) ->
    case {Result, Fun(Kernel)} of
        {_,     fail} -> {Result, Kernel};
        {_,     {empty, Kernel2}} -> repeat(Join, Fun, Result, Kernel2);
        {empty, {Result2, Kernel2}} -> repeat(Join, Fun, Result2, Kernel2);
        {_,     {Result2, Kernel2}} ->
            case Join(Result2, Result) of
                fail -> {Result, Kernel};
                skip -> repeat(Join, Fun, Result, Kernel);
                Result3 -> repeat(Join, Fun, Result3, Kernel2)
            end
    end.


% Mapping in the presence of the monad.

% Here you can think of the accumulator as either "just an
% accumulating list" or as a separate part of a larger monad that also
% includes a "kernel", as above (a list is a monad, so what we have
% here is a composite monad - it's all consistent in a hand-waving
% way).

map_acc(_Fun, [], Result, Kernel) -> {Result, Kernel};
map_acc(Fun, [Head|Tail], Result, Kernel) ->
    case Fun(Head, Kernel) of
        fail -> fail;
        {empty, Kernel2} -> map_acc(Fun, Tail, Result, Kernel2);
        {Result2, Kernel2} -> map_acc(Fun, Tail, [Result2|Result], Kernel2)
    end.

map(Fun, List, Kernel) ->
    case map_acc(Fun, List, [], Kernel) of
        fail -> fail;
        {empty, Kernel2} -> {empty, Kernel2};
        {List2, Kernel2} -> {lists:reverse(List2), Kernel2}
    end.

% and for curried functions

map_acc_(_Fun, [], Result, Kernel) -> {Result, Kernel};
map_acc_(Fun, [Head|Tail], Result, Kernel) ->
    case (Fun(Head))(Kernel) of
        fail -> fail;
        {empty, Kernel2} -> map_acc_(Fun, Tail, Result, Kernel2);
        {Result2, Kernel2} -> map_acc_(Fun, Tail, [Result2|Result], Kernel2)
    end.

map_(Fun, List, Kernel) ->
    case map_acc_(Fun, List, [], Kernel) of
        fail -> fail;
        {empty, Kernel2} -> {empty, Kernel2};
        {List2, Kernel2} -> {lists:reverse(List2), Kernel2}
    end.


% Folding can be defined too.

foldl(_Fun, [], Result, Kernel) -> {Result, Kernel};
foldl(Fun, [Head|Tail], Result, Kernel) ->
    case Fun(Head, Result, Kernel) of
        fail -> fail;
        {empty, Kernel2} -> foldl(Fun, Tail, Result, Kernel2);
        {Result2, Kernel2} -> foldl(Fun, Tail, Result2, Kernel2)
    end.

foldl_(_Fun, [], Result, Kernel) -> {Result, Kernel};
foldl_(Fun, [Head|Tail], Result, Kernel) ->
    case ((Fun(Head))(Result))(Kernel) of
        fail -> fail;
        {empty, Kernel2} -> foldl_(Fun, Tail, Result, Kernel2);
        {Result2, Kernel2} -> foldl_(Fun, Tail, Result2, Kernel2)
    end.

% I can't find a sensible meaning for empty/skip here

foldr(_Fun, [], Result, Kernel) -> {Result, Kernel};
foldr(Fun, [Head|Tail], Result, Kernel) ->
    case foldr(Fun, Tail, Result, Kernel) of
        fail -> fail;
        {Result2, Kernel2} -> Fun(Head, Result2, Kernel2)
    end.

foldr_(_Fun, [], Result, Kernel) -> {Result, Kernel};
foldr_(Fun, [Head|Tail], Result, Kernel) ->
    case foldr(Fun, Tail, Result, Kernel) of
        fail -> fail;
        {Result2, Kernel2} -> ((Fun(Head))(Result2))(Kernel2)
    end.


% As mentioned in the introduction, we can also drop the chained part
% of the state completely.  In that case we have the list monad, with
% the fail and empty extensions.

% Without a chained component we revert back to skip rather than empty.

map_acc(_Fun, [], Result) -> Result;
map_acc(Fun, [Head|Tail], Result) ->
    case Fun(Head) of
        fail -> fail;
        skip -> map_acc(Fun, Tail, Result);
        Other -> map_acc(Fun, Tail, [Other|Result])
    end.

map(Fun, List) ->
    case map_acc(Fun, List, []) of
        fail -> fail;
        skip -> skip;
        List2 -> lists:reverse(List2)
    end.

foldl(_Fun, [], Result) -> Result;
foldl(Fun, [Head|Tail], Result) ->
    case Fun(Head, Result) of
        fail -> fail;
        skip -> foldl(Fun, Tail, Result);
        Other -> foldl(Fun, Tail, [Other|Result])
    end.

% Again, I can't find a sensible meaning for empty/skip here

foldr(_Fun, [], Result) -> Result;
foldr(Fun, [Head|Tail], Result) ->
    case foldr(Fun, Tail, Result) of
        fail -> fail;
        Other -> Fun(Head, Other)
    end.


% Sometimes you may want to lift functions to work inside the monad even
% though they don't use the kernel.

lift(Fun, Empty, Fail) ->
    fun(Tuple) ->
            case Tuple of
                fail -> Fail;
                {empty, Kernel} -> {Empty, Kernel};
                {Result, Kernel} -> {Fun(Result), Kernel}
            end
    end.
lift(Fun) -> lift(Fun, empty, fail).

drop(_Empty, Fail, fail) -> Fail;
drop(Empty, _Fail, {empty, _Kernel}) -> Empty;
drop(_Empty, _Fail, {Result, _Kernel}) -> Result.
drop(Value) -> drop(empty, fail, Value).