erlesy

-module(graph_builder).

-behaviour(gen_server).

%% API
-export([start_link/0, parse_file/2]).

-export([parse_statement/1]).

%% gen_server callbacks
-export([init/1,
  handle_call/3,
  handle_cast/2,
  handle_info/2,
  terminate/2,
  code_change/3]).

-include("types.hrl").

-define(SERVER, ?MODULE).
-define(EXPAND_FLAG, true).
-record(state,{}).

%%%===================================================================
%%% API
%%%===================================================================
parse_file(File, IncludePaths) ->
    gen_server:call(?MODULE, {parse_file, File, IncludePaths}).

%%--------------------------------------------------------------------
%% @doc
%% Starts the server
%%
%% @spec start_link() -> {ok, Pid} | ignore | {error, Error}
%% @end
%%--------------------------------------------------------------------
start_link() ->
  gen_server:start_link({local, ?SERVER}, ?MODULE, [], []).

%%%===================================================================
%%% gen_server callbacks
%%%===================================================================

%%--------------------------------------------------------------------
%% @private
%% @doc
%% Initializes the server
%%
%% @spec init(Args) -> {ok, State} |
%%                     {ok, State, Timeout} |
%%                     ignore |
%%                     {stop, Reason}
%% @end
%%--------------------------------------------------------------------
init([]) ->
  {ok, #state{}}.

%%--------------------------------------------------------------------
%% @private
%% @doc
%% Handling call messages
%%
%% @spec handle_call(Request, From, State) ->
%%                                   {reply, Reply, State} |
%%                                   {reply, Reply, State, Timeout} |
%%                                   {noreply, State} |
%%                                   {noreply, State, Timeout} |
%%                                   {stop, Reason, Reply, State} |
%%                                   {stop, Reason, State}
%% @end
%%--------------------------------------------------------------------
handle_call({parse_file, File, IncludePaths}, _From, State) ->
  {ok, ParsedFile} = epp:parse_file(File, IncludePaths, []),
  Behaviour = lists:keyfind(behaviour, 3, ParsedFile),
  Behavior = lists:keyfind(behavior, 3, ParsedFile),
  Reply = case Behaviour of
            {attribute, _, _, gen_server} ->
              parse_gen_server(ParsedFile);
            {attribute, _, _, gen_fsm} ->
              parse_gen_fsm(ParsedFile);
            {attribute, _, _, gen_statem} ->
              parse_gen_statem(ParsedFile);
            {attribute, _, _, gen_event} ->
              parse_gen_event(ParsedFile);
            false ->
              case Behavior of
                {attribute, _, _, gen_server} ->
                  parse_gen_server(ParsedFile);
                {attribute, _, _, gen_fsm} ->
                  parse_gen_fsm(ParsedFile);
                {attribute, _, _, gen_statem} ->
                  parse_gen_statem(ParsedFile);
                {attribute, _, _, gen_event} ->
                  parse_gen_event(ParsedFile);
                false ->
                  {error, not_otp}
              end
          end,
  {reply, Reply, State};
handle_call(_Request, _From, State) ->
  Reply = ok,
  {reply, Reply, State}.


%%--------------------------------------------------------------------
%% @private
%% @doc
%% Handling cast messages
%%
%% @spec handle_cast(Msg, State) -> {noreply, State} |
%%                                  {noreply, State, Timeout} |
%%                                  {stop, Reason, State}
%% @end
%%--------------------------------------------------------------------

handle_cast(_Msg, State) ->
  {noreply, State}.

%%--------------------------------------------------------------------
%% @private
%% @doc
%% Handling all non call/cast messages
%%
%% @spec handle_info(Info, State) -> {noreply, State} |
%%                                   {noreply, State, Timeout} |
%%                                   {stop, Reason, State}
%% @end
%%--------------------------------------------------------------------
handle_info(_Info, State) ->
  {noreply, State}.

%%--------------------------------------------------------------------
%% @private
%% @doc
%% This function is called by a gen_server when it is about to
%% terminate. It should be the opposite of Module:init/1 and do any
%% necessary cleaning up. When it returns, the gen_server terminates
%% with Reason. The return value is ignored.
%%
%% @spec terminate(Reason, State) -> void()
%% @end
%%--------------------------------------------------------------------
terminate(_Reason, _State) ->
  ok.

%%--------------------------------------------------------------------
%% @private
%% @doc
%% Convert process state when code is changed
%%
%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState}
%% @end
%%--------------------------------------------------------------------
code_change(_OldVsn, State, _Extra) ->
  {ok, State}.

%%%===================================================================
%%% Internal functions
%%%===================================================================


parse_gen_server(_TokenList) ->
  {error, not_supported}.

parse_gen_statem(TokenList) ->
  Type = gen_statem,
  Fun =
    fun({function, _, init, 1, Clauses}, Acc) ->
          parse_function_add_edges(Clauses, init, [async], Type, Acc);
       ({function, _, handle_event = FnName, 4, Clauses}, Acc) ->
          parse_function_add_node_and_edges(Clauses, FnName, [], Type, Acc);
       ({function, _, FnName, 3, Clauses}, Acc) ->
          parse_function_add_node_and_edges(Clauses, FnName, [], Type, Acc);
       (_Other, {OldNodes, OldEdges, OldAllStates}) ->
          {OldNodes, OldEdges, OldAllStates}
    end,
    Graph = generic_parse(TokenList, Fun),
    {parsed, Type, Graph}.

parse_gen_fsm(TokenList) ->
  Type = gen_fsm,
  Fun =
    fun({function, _, init, 1, Clauses}, Acc) ->
          parse_function_add_edges(Clauses, init, [async], Type, Acc);
       ({function, _, handle_event, 3, Clauses}, Acc) ->
          parse_function_add_states(Clauses, handle_event, [async, allstate], Type, Acc);
       ({function, _, handle_sync_event, 4, Clauses}, Acc) ->
          parse_function_add_states(Clauses, handle_sync_event, [sync, allstate], Type, Acc);
       ({function, _, handle_info, 3, Clauses}, Acc) ->
          parse_function_add_states(Clauses, handle_info, [async, allstate, info], Type, Acc);
       ({function, _, FnName, 2, Clauses}, Acc) ->
          %io:format("CLAUSES ~w for ASYNC FUNCTION ~w~n", [Clauses, FnName]),
          parse_function_add_node_and_edges(Clauses, FnName, [async], Type, Acc);
       ({function, _, FnName, 3, Clauses}, Acc) ->
          %io:format("CLAUSES ~w for SYNC FUNCTION ~w~n", [Clauses, FnName]),
          parse_function_add_node_and_edges(Clauses, FnName, [sync], Type, Acc);
       (_Other, {OldNodes, OldEdges, OldAllStates}) ->
            {OldNodes, OldEdges, OldAllStates}
    end,
    Graph = generic_parse(TokenList, Fun),
    {parsed, Type, Graph}.

generic_parse(TokenList, Fun) ->
  Graph = digraph:new(),
  {States, Edges, AllStateEdges} = lists:foldl(Fun, {[init, terminate],[],[]}, TokenList),
  {ExpAllStates, Expansion} = case ?EXPAND_FLAG of
				true ->
					{States, States};
				false ->
					{["*" | States], ["*"]}
			      end,
  NewAllStateEdges = expand_allstates(AllStateEdges, Expansion),%States),
  %io:format("~p~n", [NewAllStateEdges]),
  lists:foreach(fun(Vertex) ->
                  V = digraph:add_vertex(Graph),
                  digraph:add_vertex(Graph, V, Vertex)
                end, lists:usort(ExpAllStates)),
  lists:foreach(fun(#edge{vertex1 = From, vertex2 = To, edge_data = Data}) ->
                  digraph:add_edge(Graph, get_vertex(Graph, From),
                                   get_vertex(Graph,To), Data);
                   (_) -> ok
                end, remove_dups(Edges ++ NewAllStateEdges)),
  Graph.

parse_gen_event(_TokenList) ->
  {error, not_supported}.

parse_function_add_states(Clauses, FnName, Options, Type,
                          {OldNodes, OldEdges, OldAllStates}) ->
  case parse_function(Clauses, FnName, Options, Type) of
    {error, _Reason} ->
      {OldNodes, OldEdges, OldAllStates};
    NewEdges ->
      {OldNodes, OldEdges, OldAllStates ++ NewEdges}
  end.

parse_function_add_edges(Clauses, FnName, Options, Type,
                          {OldNodes, OldEdges, OldAllStates}) ->
  case parse_function(Clauses, FnName, Options, Type) of
    {error, _Reason} ->
      {OldNodes, OldEdges, OldAllStates};
    NewEdges ->
      {OldNodes, OldEdges ++ NewEdges, OldAllStates}
  end.
parse_function_add_node_and_edges(Clauses, FnName, Options, Type,
                                  {OldNodes, OldEdges, OldAllStates}) ->
  case parse_function(Clauses, FnName, Options, Type) of
    {error, _Reason} ->
      {OldNodes, OldEdges, OldAllStates};
    NewEdges ->
      {[FnName|OldNodes], OldEdges ++ NewEdges, OldAllStates}
  end.

parse_function(Clauses, FnName, Options, Type) ->
  Edges = lists:foldl(fun(Clause, AccIn) ->
               [parse_function_clause(Clause, FnName, Options, Type) | AccIn]
              end, [], Clauses),
  FlatEdges = lists:flatten(Edges),
  %io:format("For function ~p~n", [FnName]),
  % lists:foreach(fun(E) ->
  %       io:format(">>> ~p~n", [E])
  %   end, FlatEdges),

  case lists:all(fun (El) -> {error, bad_transition} == El end, Edges) of
    false ->
      FlatEdges;
    true ->
      {error, not_a_state}
  end.

parse_function_clause({clause, _Line, Args, Guards, Body},
                      init, _Options, Type) ->
  Fun = fun({ok, NextState, init}) ->
          PrettyGuards = lists:map(fun(G) -> erl_pp:guard(G) end, Guards),
          PrettyBody = erl_pp:exprs(Body),
          PrettyArgs = erl_pp:exprs(Args),
          #edge{
            vertex1 = init,
            vertex2 = NextState,
            edge_data =
            #edge_data{
              event = "",
              args = PrettyArgs,
              pattern = Args,
              guard = PrettyGuards,
              code = PrettyBody,
              attributes = [async]}
          }
        end,
  map_parse_func(Fun, init, Body, Type);
parse_function_clause({clause, _Line, [Event | Args], Guards, Body},
                      handle_info, Options, gen_fsm) ->
  Fun = fun({ok, NextState, RetType}) ->
          PrettyGuards = lists:map(fun(G) -> erl_pp:guard(G) end, Guards),
          PrettyBody = erl_pp:exprs(Body),
          PrettyEvent = erl_pp:expr(Event),
          PrettyArgs = erl_pp:exprs(Args),
          #edge{
            vertex1 = handle_info,
            vertex2 = NextState,
            edge_data =
            #edge_data{
              event = PrettyEvent,
              args = PrettyArgs,
              pattern = Args,
              guard = PrettyGuards,
              code = PrettyBody,
              attributes = [RetType|Options]}
          }
        end,
  map_parse_func(Fun, handle_info, Body, gen_fsm);
parse_function_clause({clause, _Line, [_EventType, State, Event | Args], Guards, Body},
                      handle_event, Options, gen_statem) ->
  Fun = fun({ok, NextState, RetType}) ->
          PrettyGuards = lists:map(fun(G) -> erl_pp:guard(G) end, Guards),
          PrettyBody = erl_pp:exprs(Body),
          PrettyEvent = erl_pp:expr(Event),
          PrettyArgs = erl_pp:exprs(Args),
          #edge{
            vertex1 = State,
            vertex2 = NextState,
            edge_data =
            #edge_data{
              event = PrettyEvent,
              args = PrettyArgs,
              pattern = Args,
              guard = PrettyGuards,
              code = PrettyBody,
              attributes = [RetType|Options]}
          }
        end,
  map_parse_func(Fun, handle_info, Body, gen_fsm);
parse_function_clause({clause, _Line, [Event | Args], Guards, Body},
                      FnName, Options, gen_fsm) ->
  Fun = fun({ok, NextState, _}) ->
          PrettyGuards = lists:map(fun(G) -> erl_pp:guard(G) end, Guards),
          PrettyBody = erl_pp:exprs(Body),
          PrettyEvent = erl_pp:expr(Event),
          PrettyArgs = erl_pp:exprs(Args),
          #edge{
            vertex1 = FnName,
            vertex2 = NextState,
            edge_data =
            #edge_data{
              event = PrettyEvent,
              args = PrettyArgs,
              pattern = Args,
              guard = PrettyGuards,
              code = PrettyBody,
              attributes = Options}
          }
        end,
  map_parse_func(Fun, FnName, Body, gen_fsm);
parse_function_clause({clause, _Line, [_Call, Event | Args], Guards, Body},
                      FnName, Options, gen_statem) ->
  Fun = fun({ok, NextState, _}) ->
          PrettyGuards = lists:map(fun(G) -> erl_pp:guard(G) end, Guards),
          PrettyBody = erl_pp:exprs(Body),
          PrettyEvent = erl_pp:expr(Event),
          PrettyArgs = erl_pp:exprs(Args),
          #edge{
            vertex1 = FnName,
            vertex2 = NextState,
            edge_data =
            #edge_data{
              event = PrettyEvent,
              args = PrettyArgs,
              pattern = Args,
              guard = PrettyGuards,
              code = PrettyBody,
              attributes = Options}
          }
        end,
  map_parse_func(Fun, FnName, Body, gen_statem).

%process_body({ok. PrevState, NextState, }) ->

map_parse_func(Fun, State, Body, Type) ->
  case eval_return(State, parse_body(Body), Type, []) of
    {error, _Reason} ->
      {error, bad_transition};
    List ->
      lists:map(Fun, List)
  end.

parse_body(Body) ->
  parse_body(Body, []).

parse_body([Statement|Rest], Acc) ->
  parse_body(Rest, Acc ++ [parse_statement(Statement)]);
parse_body([], Acc) ->
%%   io:format("~p~n", [Acc]),
  lists:flatten([Acc]).

parse_statement({tuple, Line, Elems}) ->
  {tuple, Line, Elems};
parse_statement(Statement) when is_tuple(Statement) ->
  lists:map(fun(Index) ->
    parse_statement(element(Index, Statement))
  end, lists:seq(1, size(Statement)));
parse_statement(Statement) when is_list(Statement) ->
  lists:map(fun(Index) ->
    parse_statement(lists:nth(Index, Statement))
  end, lists:seq(1, length(Statement)));
parse_statement(_Statement) ->
  [].


eval_return(State, [ReturnVal|Rest], gen_fsm, Acc) ->
  case eval_tuple(ReturnVal) of
    {ok, {ok, NextState, _Data}} ->
      eval_return(State, Rest, gen_fsm, [{ok, NextState, init}|Acc]);
    {ok, {ok, NextState, _Data, _Timeout}} ->
      eval_return(State, Rest, gen_fsm, [{ok, NextState, init}|Acc]);
    {ok, {stop, _Reason}} ->
      eval_return(State, Rest, gen_fsm, [{ok, terminate, init}|Acc]);
    {ok, {reply, _Reply, NextState, _Data}} ->
      eval_return(State, Rest, gen_fsm, [{ok, NextState, sync}|Acc]);
    {ok, {reply, _Reply, NextState, _Data, _Timeout}} ->
      eval_return(State, Rest, gen_fsm, [{ok, NextState, sync}|Acc]);
    {ok, {stop, _Reason, _Reply, _Data}} ->
      eval_return(State, Rest, gen_fsm, [{ok, terminate, sync}|Acc]);
    {ok, {next_state, NextState, _Data}} ->
      eval_return(State, Rest, gen_fsm, [{ok, NextState, async}|Acc]);
    {ok, {next_state, NextState, _Data, _Timeout}} ->
      eval_return(State, Rest, gen_fsm, [{ok, NextState, async}|Acc]);
    {ok, {stop, _Reason, _Data}} ->
      eval_return(State, Rest, gen_fsm, [{ok, terminate, async}|Acc]);
    _Other ->
      eval_return(State, Rest, gen_fsm, Acc)
  end;
eval_return(State, [ReturnVal|Rest], gen_statem, Acc) ->
  case eval_tuple(ReturnVal) of
    {ok, {ok, NextState, _Data}} ->
      eval_return(State, Rest, gen_statem, [{ok, NextState, init}|Acc]);
    {ok, {ok, NextState, _Data, _Actions}} ->
      eval_return(State, Rest, gen_statem, [{ok, NextState, init}|Acc]);
    {ok, ignore} ->
      eval_return(State, Rest, gen_statem, [{ok, terminate, init}|Acc]);

    {ok, stop} ->
      eval_return(State, Rest, gen_statem, [{ok, terminate, async}|Acc]);
    {ok, {stop, _Reason}} ->
      eval_return(State, Rest, gen_statem, [{ok, terminate, async}|Acc]);
    {ok, {stop, _Reason, _NewData}} ->
      eval_return(State, Rest, gen_statem, [{ok, terminate, async}|Acc]);
    {ok, {stop_and_reply, _Reason, _Replies}} ->
      eval_return(State, Rest, gen_statem, [{ok, terminate, async}|Acc]);
    {ok, {stop_and_reply, _Reason, _Replies, _NewData}} ->
      eval_return(State, Rest, gen_statem, [{ok, terminate, async}|Acc]);

    {ok, {next_state, NextState, _Data}} ->
      eval_return(State, Rest, gen_statem, [{ok, NextState, async}|Acc]);
    {ok, {next_state, NextState, _Data, _Actions}} ->
      eval_return(State, Rest, gen_statem, [{ok, NextState, async}|Acc]);
    {ok, {keep_state, _NewData}} ->
      eval_return(State, Rest, gen_statem, [{ok, State, async}|Acc]);
    {ok, {keep_state, _NewData, _Actions}} ->
      eval_return(State, Rest, gen_statem, [{ok, State, async}|Acc]);
    {ok, keep_state_and_data} ->
      eval_return(State, Rest, gen_statem, [{ok, State, async}|Acc]);
    {ok, {keep_state_and_data, _Actions}} ->
      eval_return(State, Rest, gen_statem, [{ok, State, async}|Acc]);
    _Other ->
      eval_return(State, Rest, gen_statem, Acc)
  end;
eval_return(_, [], _, []) ->
  {error, badreturn};
eval_return(_, [], _, Acc) ->
  Acc.


eval_tuple({tuple, Line, Elements})->
  ClearElements = lists:map(fun(Element) ->
%%     io:format("NOW PROCESSING: ~p~n", [Element]),
    case Element of
      {atom, RLine, Atom} ->
        {atom, RLine, Atom};
      _Other ->
        {atom, 0, '@var'}
    end
  end, Elements),
  ClearTuple = {tuple, Line, ClearElements},
  {value, Val, _} = erl_eval:expr(ClearTuple, []), %Bindings),
  {ok, Val};
eval_tuple(_Other)->
  {error, not_a_tuple}.

expand_allstates(Edges, States) ->
  ClearStates = lists:delete(init, lists:delete(terminate, States)),
  lists:foldl(fun(Edge, Acc) ->
    #edge{vertex1 = FnName, vertex2 = To, edge_data = Data} = Edge,
    StateIndex = case FnName of
                   handle_event ->  1;
                   handle_sync_event -> 2;
                   handle_info -> 1
                 end,
    case To of
      '@var' ->
        case lists:nth(StateIndex, Data#edge_data.pattern) of
          {atom, _line, StateFrom} ->
            Acc ++ lists:map(fun(State) ->
              #edge{vertex1 = StateFrom, vertex2 = State, edge_data = Data}
            end, ClearStates);
          _ ->
            Acc ++ lists:map(fun(State) ->
              #edge{vertex1 = State, vertex2 = State, edge_data = Data}
            end, ClearStates)
        end;
      Other ->
        case lists:nth(StateIndex, Data#edge_data.pattern) of
          {atom, _line, StateFrom} ->
            Acc ++
              [#edge{vertex1 = StateFrom, vertex2 = Other, edge_data = Data}];
          _ ->
            Acc ++ lists:map(fun(State) ->
              #edge{vertex1 = State, vertex2 = Other, edge_data = Data}
            end, ClearStates)
        end
    end
  end, [], Edges).

get_vertex(Graph, Label) ->
  Vertices = digraph:vertices(Graph),
  find_label(Label, Vertices, Graph).

find_label(Label, [V|Rest], Graph) ->
  case digraph:vertex(Graph, V) of
    {V, Label} ->
      V;
    _ ->
      find_label(Label, Rest, Graph)
  end;
find_label(_, [], _) ->
  {error, no_label}.

remove_dups([])    -> [];
remove_dups([H|T]) -> [H | [X || X <- remove_dups(T), X /= H]].


abstract_print(Form) ->
  erl_prettypr:format(erl_syntax:form_list([Form])).