Alpha-version of parser, predicates coming soon.

parser.erl

-module(parser).

-compile(export_all).

%%%%%%%%%%%%%%%%
%%%% Config %%%%
%%%%%%%%%%%%%%%%

%% Basic configuration utility.
%%
%% Makes parser assume that input is a plain old list
%% and produce structures made from lists and tuples.
%
basic_config() ->
    [{stream, list_decompose()},
     {list,   list_monoid()},
     {tuple,  tuple_monoid()}].
     
list_decompose() ->
    [{head,   fun hd/1},
     {tail,   fun tl/1}].
     
% List requires a reversion, if stack-constructed.
%
list_monoid() ->
    [{zero,     []},
     {combine,  fun (Elem, Acc) -> [Elem | Acc]  end},
     {finalize, fun (_) -> ok end}].
     
tuple_monoid() ->
    [{zero,     {}},
     {combine,  fun (Elem, Acc) ->  
                    list_to_tuple([Elem | tuple_to_list(Acc)])
                end},
     {finalize, fun (_) -> ok end}].
     
%% Config-access utility.
%
access(Path, Config) ->
    lists:foldl(
        fun (Step, Conf) ->
            case lists:keyfind(Step, 1, Conf)
            of
                {Step, Item} -> Item;
                
                _            -> erlang:error({no, Path, 
                                              in_config, Config, 
                                              could_not_find, Step})
            end 
        end,
        Config,
        Path
    ).
    
get(PathList, C) -> lists:map(fun (Path) -> parser:access(Path, C) end,
                              PathList).
    
ok  (A, S) -> {ok,    {A, S}}.
fail(M, S) -> {error, {M, S}}.

expected(A, S) -> fail({expected, A, but_found}, S).

decorate({error, {M, S}}, Description) -> 
    fail({M, while_parsing, Description}, S).

result ({_, {A, _}}) -> A.
context({_, {_, S}}) -> S.

is_ok  ({Flag, _}) -> Flag == ok.
is_fail({Flag, _}) -> Flag == fail.
    
%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%% Parser generation %%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%

construct(X) -> parser:construct(basic_config(), X).

construct(_, [return, A]) -> fun (S) -> ok(A, S) end;

construct(C, [char, A]) ->
    fun (S) ->
        [Head, Tail] = get([[stream, head], 
                            [stream, tail]], C),
        case Head(S) of
            A -> S1 = Tail(S),
                 ok(A, S1);
                 
            _ -> expected(A, S)
        end              
    end;
    
construct(C, [modify, Fun, P]) ->
    PC = parser:construct(C, P),
    fun (D) ->
        fun (S) ->
            PCS = PC(S),
          
            case is_ok(PCS) of
                true  -> ok(Fun(D, result(PCS)), context(PCS));
                
                false -> PCS
            end
        end
    end;
    
construct(C, [join, P, FP]) ->
    FPC = parser:construct(C, FP),
    PC  = parser:construct(C, P),
    fun (S) ->
        PCS = PC(S),

        case is_ok(PCS) of
            true  -> FPCA = FPC(result(PCS)),
                     FPCA(context(PCS));
                     
            false -> PCS
        end
    end;
    
construct(C, [bind, Fun | PS]) ->
    PSR = lists:reverse(PS),

    parser:construct(C,     
        lists:foldl(
            fun (P, Acc) ->
                [join, P, [modify, Fun, Acc]]
            end,
            hd(PSR),
            tl(PSR)));

construct(C, [list | PS]) ->
    [Zero, Combine, Send] = get([[list, zero],
                                 [list, combine],
                                 [list, finalize]], C),
    
    Bundle = parser:construct(C, [bind, Combine | PS ++ [[return, Zero]]]),
    
    fun (S) ->
       BS = Bundle(S),
       Send(BS),
       BS
    end;

construct(C, [tuple | PS]) ->
    [Zero, Combine, Send] = get([[tuple, zero],
                                 [tuple, combine],
                                 [tuple, finalize]], C),
    
    Bundle = parser:construct(C, [bind, Combine | PS ++ [[return, Zero]]]),
    
    fun (S) ->
       BS = Bundle(S),
       Send(BS),
       BS
    end;
    
construct(C, [any, P]) ->
    parser:construct(C, P);
    
construct(C, [any | PS]) ->
    H = parser:construct(C, hd(PS)),
    T = parser:construct(C, [any | tl(PS)]),
    
    fun (S) ->
        HS = H(S),
        
        case is_ok(HS) of
            true  -> HS;
            false -> T(S)
        end
    end;
    
construct(C, [many | P]) ->
    [Zero, Combine] = get([[list, zero], [list, combine]], C),
    
    PC = parser:construct(C, P),
    
    Many = 
        fun (Px, Cont) ->
            fun (S) ->
                PS = Px(S),
                
                case is_ok(PS) of
                    true  -> Rest  = Cont(Px, Cont),
                             RestS = Rest(context(PS)),
                             ok(Combine(result(PS), 
                                        result(RestS)),
                                context(RestS));
                                
                    false -> ok(Zero, S)
                end
            end
        end,
        
    Many(PC, Many);    
    
construct(C, [chunk, Chunk]) ->
    P = parser:construct(C,
        [list] 
        ++ 
        lists:map(fun (X) -> [char, X] end, Chunk)),
        
    fun (S) ->
        PS = P(S),
        
        case is_ok(PS) of
            true  -> PS;
            false -> decorate(PS, [chunk, Chunk])
        end
    end;
    
construct(_, That) -> erlang:error({cannot_construct, That}).

construct_with(Config) -> fun (X) -> parser:construct(Config, X) end.

parse(P, S) -> PC = parser:construct(P),
               PC(S).

selftest() ->
    Tests =
        [
            { "Return",
                [return, $f],
              
                "asd", ok($f, "asd") },
              
            { "One char",
                [char, $A],
                
                "ASD", ok($A, "SD") },
              
            { "One char - falture",
                [char, $B],
                
                "ASD", expected($B, "ASD") },
                
            { "Join",
                [join, [char, $A], 
                       [modify, fun (A, B) -> [A, B] end, [char, $B]]],
                       
                "ABC", ok("AB", "C") },
                
            { "Join - fail",
                [join, [char, $X], 
                       [modify, fun (A, B) -> [A, B] end, [char, $B]]],
                       
                "ABC", expected($X, "ABC") },
                
            { "Bind",
                [bind, fun (Item, Acc) -> [Item | Acc] end,
                    [char, $A],
                    [char, $B],
                    [char, $C],
                    [return, []]],
                    
                "ABCD", ok("ABC", "D") },
                
            { "List",
                [list, [char, $A],
                       [char, $B],
                       [char, $C]],
                    
                "ABCD", ok("ABC", "D") },
                
            { "Tuple",
                [tuple, [char, $A],
                        [char, $B],
                        [char, $C]],
                    
                "ABCD", ok(list_to_tuple("ABC"), "D") },
                
            { "Any chunk",
                [any, [chunk, "alpha"],
                      [chunk, "betta"],
                      [chunk, "gamma"]],
                            
                "betta", ok("betta", "") },
                
            { "Any chunk - falture",
                [any, [chunk, "alpha"],
                      [chunk, "betta"],
                      [chunk, "gamma"]],
                            
                "delta", decorate(expected($g, "delta"), 
                                  [chunk, "gamma"]) },
                                  
            { "Many chunks",
                [many, chunk, "ok "],
                
                "ok ok ok fail", ok(["ok ", "ok ", "ok "], "fail") }
        ],
        
    case 
        lists:filter(
            fun (ok) -> false;
                (_)  -> true
            end,
            lists:map(
                fun ({N, P, S, D}) -> 
                    
                    io:format("Test ~p...", [N]),
                    
                    PS = parser:parse(P, S),
                    if PS == D -> io:format("success~n", []),
                                  ok;
                                  
                       true    -> io:format("fail~n", []),
                                  {error_in, N, 
                                  expected, D, 
                                  got,      PS, 
                                  on,       S, 
                                  doing,    P}
                    end
                end, 
                Tests))
    of
        []   -> ok;
        
        List -> List
    end.