% static analysis of application
%
% Thomas Arts
% November 2000

-module(app).

-define(WARNING(F,A),io:format("Warning: "++F,A)).
%-define(DEBUG(F,A),io:format("Debug: "++F,A)).
-define(DEBUG(F,A),ok).
-define(ERROR(Reasons),begin io:format("~p~n",[Reasons]), {error,Reasons} end).

-export([start/1,
         start/2,
         nonapp/3,
         parse/2]).

-import(lists,[map/2]).

% app:start(App) should be called instead
%    of application:start(App)
% be sure the .app file is readable and the sources are either in
%    ../src/ from the directory in which .app is situated or
%    in the same directory as .app file.

% app:supervision(Mod,StartArgs) should be called instead
%    of supervision:start_link(Mod,StartArgs)
% be sure the Mod file and all calling sources are in present dir

start(Application) ->
  start([],Application).

start(IncludePath,Application) ->
  Directory =
    find_app(Application),
  AppSpec =
    parse(Directory,Application),
  analyse_app(IncludePath,Directory,AppSpec).

nonapp(Module,Func,Args) ->
  analyse_to_sup([],".",{application,unknown,[]},top,Module,Func,Args).

analyse_app(IncludePath,Dir,AppSpec) ->
  {application,Name,Spec} = AppSpec,
  case lists:keysearch(mod,1,Spec) of
       {value,{mod,{Mod,Arg}}} ->
         {application,Name,
            [analyse_to_sup(IncludePath,Dir,AppSpec,app_master,
                            Mod,start,[normal,Arg])]};
       _ ->
         ?ERROR(["cannot determine start module"])
  end.

analyse_to_sup(IncludePath,Dir,AppSpec,SupName,Mod,Func,Args) ->
  % the Mod:Func(Args) function should now evaluate
  % to a process that is the top of the supervisor tree
  ?DEBUG("~p:~p/~p should lead to supervisor:start_link~n",
                                                  [Mod,Func,length(Args)]),
  case readprog(IncludePath,Dir,Mod) of
       {ok,AbsForms} ->
         case evaluate(IncludePath,Dir,AppSpec,AbsForms,Func,Args) of
              {value,{supervisor,start_link,[M,A]},_} ->
                {supervisor,SupName,analyse_sup(IncludePath,Dir,AppSpec,M,A)};
              {value,{supervisor,start_link,[SN,M,A]},_} ->
                {supervisor,SN,analyse_sup(IncludePath,Dir,AppSpec,M,A)};
              {value,ignore,_} ->
                {supervisor,ignored,[]};
              Other ->
                ?ERROR(["no supervisor started",Other])
         end;
       {error,Reason} ->
         ?ERROR(["parse_error module "++atom_to_list(Mod)++".erl", Reason])
  end.

analyse_sup(IncludePath,Dir,AppSpec,Mod,Arg) ->
  ?DEBUG("computing supervisor structure ~p:init(~p)~n",[Mod,Arg]),
  case readprog(IncludePath,Dir,Mod) of
       {ok,AbsForms} ->
         % the Mod:init(Arg) function should evaluate to a
         % data structure describing the supervisor specification
         case catch evaluate(IncludePath,Dir,AppSpec,AbsForms,init,[Arg]) of
              {value,{ok,{{SupType,_,_},ChildSups}},_} -> 
                 map(fun(X)->   
                        analyse_worker(IncludePath,Dir,AppSpec,SupType,X)
                     end,ChildSups);
              Other ->
                ?ERROR(["supervisor wrong return value for init/1", Other])
         end;
       {error,Reason} ->
         ?ERROR(["parse_error module "++atom_to_list(Mod)++".erl", Reason])
  end.

analyse_worker(IncludePath,Dir,AppSpec,SupType,
               {Name,{Mod,Start,Args},Restart,_,supervisor,_}) ->
  % a supervisor again, that should be analysed differently
  analyse_to_sup(IncludePath,Dir,AppSpec,Name,Mod,Start,Args);
analyse_worker(IncludePath,Dir,AppSpec,SupType,
               {Name,{Mod,Start,Args},Restart,_,worker,_}) ->
  ?DEBUG("computing worker ~p:~p/~p~n",[Mod,Start,length(Args)]),
  case readprog(IncludePath,Dir,Mod) of
       {ok,AbsForms} ->
        % case grepbehaviour(AbsForms) of
        %      none ->
        %        {SupType,Name,{{Mod,Start,Args},Restart,worker}};
        %      Behaviour ->
        % end 
        % THIS IS DANGEROUS, the function could loop infinitely
        case catch evaluate(IncludePath,Dir,AppSpec,AbsForms,Start,Args) of
             {value,{gen_server,start,[M,As,_]},_} ->
               {SupType,Name,nolink(Mod,Start,length(Args),Name)};
             {value,{gen_server,start,[SName,M,As,_]},_} ->
               {SupType,checkname(Mod,Start,length(Args),Name,SName),
                nolink(Mod,Start,length(Args),Name)};
             {value,{gen_server,start_link,[M,As,_]},_} ->
               {SupType,Name,{{M,init,[As]},Restart,gen_server,
                 [{started,[{Start,length(Args)}]}
                 ]}};
             {value,{gen_server,start_link,[SName,M,As,_]},_} ->
               CheckedName = 
                 checkname(Mod,Start,length(Args),Name,SName),
               {SupType,CheckedName,
                {{M,init,[As]},Restart,gen_server,
                 [{registered,CheckedName},
                  {started,[{Start,length(Args)}]}
                 ]}};
             {value,{gen_fsm,start,[M,As,_]},_} ->
               {SupType,Name,nolink(Mod,Start,length(Args),Name)};
             {value,{gen_fsm,start,[SName,M,As,_]},_} ->
               {SupType,checkname(Mod,Start,length(Args),Name,SName),
                nolink(Mod,Start,length(Args),Name)};
             {value,{gen_fsm,start_link,[M,As,_]},_} ->
               {SupType,Name,{{M,init,[As]},Restart,gen_fsm,
                 [{started,[{Start,length(Args)}]}
                 ]}};
             {value,{gen_fsm,start_link,[SName,M,As,_]},_} ->
               CheckedName = 
                 checkname(Mod,Start,length(Args),Name,SName),
               {SupType,CheckedName,
                {{M,init,[As]},Restart,gen_fsm,
                  [{registered,CheckedName},
                   {started,[{Start,length(Args)}]}
                  ]}};
             {value,{gen_event,start,[]},_} ->
               {SupType,Name,nolink(Mod,Start,length(Args),Name)};
             {value,{gen_event,start,[SName]},_} ->
               {SupType,checkname(Mod,Start,length(Args),Name,SName),
                nolink(Mod,Start,length(Args),Name)};
             {value,{gen_event,start_link,[]},_} ->
               {SupType,Name,{{gen_event,start_link,[]},Restart,gen_event}};
             {value,{gen_event,start_link,[SName]},_} ->
               CheckedName = 
                 checkname(Mod,Start,length(Args),Name,SName),
               {SupType,CheckedName,
                {{gen_event,start_link,[SName]},Restart,gen_event,
                 [{registered,CheckedName}]}};
             {value,{spawn,As},_} ->
               {SupType,Name,returntype_error(Mod,Start,length(Args),Name)};
             {value,{spawn_link,As},_} ->
               {SupType,Name,returntype_error(Mod,Start,length(Args),Name)};
             {value,{ok,{spawn,[M,F,As]}},_} ->
               {SupType,Name,nolink(Mod,Start,length(Args),Name)};
             {value,{ok,{spawn,[Node,M,F,As]}},_} ->
               {SupType,Name,nolink(Mod,Start,length(Args),Name)};
             {value,{ok,{spawn_link,[M,F,As]}},_} ->
               {SupType,Name,{{M,F,As},Restart,worker,
                 [{started,[{Start,length(Args)}]}
                 ]}};
             {value,{ok,{spawn_link,[Node,M,F,As]}},_} ->
               {SupType,Name,{{M,F,As},Restart,worker,
                 [{started,[{Start,length(Args)}]}
                 ]}};
             Other ->
               io:format("Unrecognized spawning: ~p~n",[Other]),
               {SupType,Name,{{Mod,Start,Args},Restart,worker}}
         end;
       {error,enoent} ->   % worker defined in other application
         {SupType,Name,{{Mod,Start,Args},Restart,{worker,Mod}}};
       {error,Reason} ->
         ?ERROR(["parse_error module "++atom_to_list(Mod)++".erl", Reason])
  end.

readprog(IncludePath,Dir,Module) ->
  % assume Module to be in Dir++"../src", otherwise Dir
  File = atom_to_list(Module)++".erl",
  case file:read_file_info(filename:join([Dir,"../src",File])) of
       {ok,_} ->
         ?DEBUG("reading file ~~p~n",[filename:join([Dir,"../src",File])]),
         NewDir=filename:join([Dir,"../src"]),
         epp:parse_file(filename:join([NewDir,File]),
                        [Dir,NewDir|IncludePath],[]);
       _ ->
         case file:read_file_info(filename:join([Dir,File])) of
              {ok,_} ->
                ?DEBUG("reading file ~p~n",[filename:join([Dir,File])]),
                epp:parse_file(filename:join([Dir,File]),[Dir|IncludePath],[]);
              Error ->
                ?DEBUG("eval mod "++File++" (~p)~n",[Error]),
                Error
         end
  end.

checkname(Mod,Start,Arity,Name,SName) ->
  case SName of
       Name ->
         Name;
       {local,Name} ->
         Name;
       {global,Name} ->
         Name;
       _ ->
         io:format("Warning: named worker ~p registered as ~p in "++
                   atom_to_list(Mod)++":"++
                   atom_to_list(Start)++"/"++
                   integer_to_list(Arity)++"~n",
                   [Name,SName]),
         SName % SName alternative for registered name
 end.

grepbehaviour([]) ->
  none;
grepbehaviour([{attribute,_,behaviour,Behaviour}|AbsForms]) ->
  Behaviour;
grepbehaviour([_|AbsForms]) ->
  grepbehaviour(AbsForms).

nolink(Mod,Start,Arity,Name) ->
  Reason = 
     io_lib:format("Error: ~p not linked to parent in "++ 
                   atom_to_list(Mod)++":"++
                   atom_to_list(Start)++"/"++
                   integer_to_list(Arity), [Name]),
  io:format("~s~n",[Reason]),
  {error,lists:flatten(Reason)}.

returntype_error(Mod,Start,Arity,Name) ->
  Reason = 
    io_lib:format(
       "Error: ~p started wrongly, returntype should be {ok,Pid} in "++
       atom_to_list(Mod)++":"++ atom_to_list(Start)++"/"++
       integer_to_list(Arity), [Name]),
  io:format("~s~n",[Reason]),
  {error,lists:flatten(Reason)}.

evaluate(IncludePath,Dir,AppSpec,AbsForms,Name,Arguments) ->
  LocalFunctionHandler =
    fun({io,format},Args,Bindings) ->
         {value,ok,Bindings};
       ({M,F},Args,Bindings) ->
         case readprog(IncludePath,Dir,M) of
              {ok,NewAbsForms} ->
                 {value,V,Bs} = evaluate(IncludePath,Dir,AppSpec,
                                         NewAbsForms,F,Args),
                 {value,V,Bindings};
              _ ->
                 case {M,F,Args} of
                      {application,get_env,[Key]} ->
                        {value,extract(AppSpec,Key),Bindings};
                      {application,get_env,[App,Key]} ->
                        case AppSpec of
                             {application,App,Spec} ->
                                {value,extract(AppSpec,Key),Bindings};
                             _ ->  % different application
                                {value,apply(M,F,Args),Bindings}
                        end;
                      _ ->
                        {value,apply(M,F,Args),Bindings}
                 end
         end;
       (F,Args,Bindings) when atom(F) ->
         {value,V,Bs} = evaluate(IncludePath,Dir,AppSpec,AbsForms,F,Args),
         {value,V,Bindings}
    end,
  case [ Body || {function,_,Fun,Arity,Body}<-AbsForms, 
                 Name==Fun, length(Arguments)==Arity ]          of
       [ Clauses ] ->
         eval:case_clauses(list_to_tuple(Arguments),
                           map(fun({clause,L,Ps,Gs,B}) ->
                                  {clause,L,[{tuple,L,Ps}],Gs,B}
                               end,Clauses),
                           [],{value,LocalFunctionHandler});
       Other ->
         exit({AbsForms,Other,"undefined function "++ atom_to_list(Name)++
              "/"++integer_to_list(length(Arguments))})
  end.



%%%-----------------------------------------------------------

find_app(AppName) ->
  find_app(atom_to_list(AppName)++".app",code:get_path()).

find_app(File,[]) ->
  exit("cannot find "++File);
find_app(File,[Dir|Dirs]) ->
  case file:read_file_info(filename:join(Dir,File)) of
       {ok,Info} ->
          Dir;
       _ ->
         find_app(File,Dirs)
  end.

parse(Dir,Application) ->
  File = filename:join(Dir,atom_to_list(Application)++".app"),
  ?DEBUG("reading file ~p~n",[File]),
  case file:read_file(File) of
       {ok,Bin} ->
          case erl_scan:string(binary_to_list(Bin)) of
               {ok,Tokens,Line} ->
                 case erl_parse:parse_term(Tokens) of
                      {ok,Term} ->
                         check_app(Term,Application,File);
                      {error,ParseError} ->
                         exit({"error parsing file "++File,ParseError})
                 end;
               Error ->
                 exit({"error reading file "++File,Error})
          end;
       {error,Reason} ->
          exit({"error opening file "++File,Reason})
  end.

check_app({application,AppName,Spec},Application,File) ->
  {application,
     case AppName of
          Application ->
            AppName;
          _ ->
            ?WARNING("name conflict ~p called ~p in ~p~n",
                     [Application,AppName,File]),
            Application
     end,
     Spec};
check_app(Other,Application,File) ->
  exit({"error in format "++File,Other}).


extract({application,_,Spec},Key) ->
  case lists:keysearch(env,1,Spec) of
       {value,{env,Vars}} ->
         case lists:keysearch(Key,1,Vars) of
              {value,{_,Value}} ->
                {ok,Value};
              _ ->
                ?WARNING("application variable ~p undefined in .app file~n",
                         [Key]),
                undefined
         end;
       _ ->
         ?WARNING("application variable ~p undefined in .app file~n",[Key]),
         undefined
  end.