%%	graph_fsm.erl
%%
%% Author:  Vance Shipley, Motivity Telecom Inc. <vances@motivity.ca>
%% Date:    November, 2000
%%
%%
%% This library is free software; you can redistribute it and/or
%% modify it under the terms of the GNU Lesser General Public
%% License as published by the Free Software Foundation; either
%% version 2 of the License, or (at your option) any later
%% version.
%%
%% This library is distributed in the hope that it will be useful,
%% but WITHOUT ANY WARRANTY; without even the implied warranty of
%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
%% GNU Lesser General Public License for more details.
%%
%% You should have received a copy of the GNU Lesser General
%% Public License along with this library; if not, write to the
%% Free Software Foundation, Inc., 59 Temple Place, Suite 330,
%% Boston, MA 02111-1307 USA
%%
%% ------------------------------------------------------------------------
%%
%%	This module creates a graph description file, suitable for use with
%% dot, describing the gen_fsm behaviour source file given.  The output
%% file can be fed to dot and friends to automatically create a 
%% postscript/gif %% picture of the state transitions within your state
%% machine.
%%
%% Get dot at http://www.research.att.com/sw/tools/graphviz.
%%
%% Ouput is to a file named 'file.dot' where 'file.erl' is the source file 
%%
%% Run the resulting graph specification file through dot:
%%            dot -Tgif file.dot > file.gif
%%   or       dot -Tps file.dot > file.ps
%%
%% ------------------------------------------------------------------------
%%
%% set tabstops to 3 (in vi :set tabstop=3)

-module(graph_fsm).
-vsn('1.3').
-author('vances@motivity.ca').
-export([parse/1, parse/2]).

% change these to set the font size in the output
-define(FONT_GRAPH, 18).
-define(FONT_EDGE, 10).

parse(File) when atom(File) ->
	% construct the full filename
	Filename = atom_to_list(File) ++ ".erl",
	Includes = filename:dirname(filename:absname(Filename)),
	parse(Filename, [Includes]);
parse(File) when list(File) ->
	% construct the full filename
	Base = filename:basename(File, ".erl"),
	Filename = Base ++ ".erl",
	Includes = filename:dirname(filename:absname(Filename)),
	parse(Filename, [Includes]).

parse(File, Includes) when atom(File) ->
	% construct the full filename
	Filename = atom_to_list(File) ++ ".erl",
	parse(Filename, Includes);
parse(File, Includes) ->
	% construct the full filename
	Base = filename:basename(File, ".erl"),
	Filename = Base ++ ".erl",
	{ok, Form} = epp:parse_file(Filename, Includes, []),
	% make sure it has gen_fsm behavior
	case get_attribute(Form, behaviour) of
		{behaviour, gen_fsm} -> true;
		{behaviour, _} ->
			exit({error, 'wrong behaviour'});
		not_found ->
			exit({error, 'no behaviour'})
	end,
	% get the module name 
	{module, Module} = get_attribute(Form, module),
	% open a file to write the graph named after the module
	{ok, IoDevice} = file:open(Base ++ ".dot", write),
	% write the header for the graph
	io:fwrite(IoDevice, "digraph ~w {~n", [Module]),
	% set the label for the graph and it's fontsize
	io:fwrite(IoDevice, "	label=\"~w\";~n	fontsize=~w;~n",
			[Module, ?FONT_GRAPH]),
	% get the list of exported functions
	{export, Exports} = get_attribute(Form, export),
	% parse the exported functions
	parse_exports(Form, IoDevice, Exports),
	% close the graph file
	file:close(IoDevice),
	% return the base name of the file written
	{ok, filename:basename(Filename, ".erl")}.
	
	
% find the value of a given attribute
get_attribute(Form, Attribute) ->
	get_attribute(Form, Attribute, []).
get_attribute([], Attribute, Values) -> {Attribute, Values};
get_attribute([H|T], Attribute, Values) ->
	% get the attribute's value
	case H of
		{attribute, Line, Attribute, Value} ->
			get_attribute(T, Attribute, lists:append(Values, Value));
		{eof, Line} ->
			{Attribute, Values};
		_ -> 
			get_attribute(T, Attribute, Values)
	end.


% ignore the callbacks which don't represent states
parse_exports(Form, IoDevice, [{init,_}|T]) ->
	parse_exports(Form, IoDevice, T);
parse_exports(Form, IoDevice, [{handle_event,_}|T]) ->
	parse_exports(Form, IoDevice, T);
parse_exports(Form, IoDevice, [{handle_sync_event,_}|T]) ->
	parse_exports(Form, IoDevice, T);
parse_exports(Form, IoDevice, [{handle_info,_}|T]) ->
	parse_exports(Form, IoDevice, T);
parse_exports(Form, IoDevice, [{terminate,_}|T]) ->
	parse_exports(Form, IoDevice, T);
parse_exports(Form, IoDevice, [{code_change,_}|T]) ->
	parse_exports(Form, IoDevice, T);
% state handlers should have two or three arguments
parse_exports(Form, IoDevice, [{StateName, Arity}|T]) 
			when Arity < 4, Arity > 1 ->
	% get the function's Abstract Form
	case get_function(Form, StateName, Arity) of
		{StateName, Arity, Function} ->
			parse_function(IoDevice, StateName, Function),
			parse_exports(Form, IoDevice, T);
		not_found ->
			% the function doesn't exist, ignore
			parse_exports(Form, IoDevice, T)
	end;
% we'll ignore anything which doesn't fit the above
parse_exports(Form, IoDevice, [H|T]) ->
	parse_exports(Form, IoDevice, T);
% an empty list means we're done, close up shop
parse_exports(Form, IoDevice, []) ->
	% write out the closing stuff to the graph file
	io:fwrite(IoDevice, "}~n", []).


% retrieve a function's AbsForm by name
get_function([], _, _) -> not_found;
get_function([H|T], FunctionName, Arity) ->
	case H of
		{function, Line, FunctionName, Arity, Function} ->
			{FunctionName, Arity, Function};
		{eof, Line} ->
			not_found;
		_ -> 
			get_function(T, FunctionName, Arity)
	end.


%
% parse_function(IoDevice, StateName, [])
%
% this clause matches if the event is bound to a variable
% e.g idle(Event, StateData) ->
%
parse_function(IoDevice, StateName,
			[{clause,Line,[{var,Le,EventVar}|_], Guard, Body} |  Clauses]) ->
	case find_nextstate(Body) of
		{var, NextStateVar} ->
			% state handler returns a variable, we'll have to find
			% out where it was defined (assuming in a case statement)
			case get_case(EventVar, Body) of
				{ok, Case} ->
					parse_case(IoDevice, StateName, NextStateVar, Case);
				not_found ->
					io:fwrite("A state handler [~w] clause returns a variable "
							"[~s] we assumed it was in a case statement but could "
							"not find one.~n", [StateName, NextStateVar]),
					{error, 'no case found'}
			end;
		{atom, NextState} ->
			% state handler returns a hard coded atom
			case parse_guard(Guard) of
				[] ->
					% there was no guard label created so this must be a 
					% catch all for undefined events which we name "*" as 
					% is done in SDL
					write_line(IoDevice, StateName, NextState, {atom,0,'*'}, []);
				GuardLabel ->
					write_line(IoDevice, StateName, NextState, [], GuardLabel)

			end,
			% we'll look for a case as well as there may be more returns
			case get_case(EventVar, Body) of
				{ok, Case} ->
         				parse_case(IoDevice, StateName, NextState, Case);
				not_found ->
					% none found so ignore
					Case = none
			end;
		not_found ->
			% there must be a case statement which has immediate returns
			case get_case(EventVar, Body) of
				{ok, Case} ->
					parse_case(IoDevice, StateName, bogosity, Case);
				% must not be a state handler at all, ignore
				not_found -> ok

         end
	end,
	parse_function(IoDevice, StateName, Clauses);
%
% this clause matches if the event is matched against a variable
%		e.g. idle(Event = {foo, bar}, StateData) ->
%
parse_function(IoDevice, StateName,
		[{clause, Line, [{match,_,{var,_,EventVar},EventForm}|T], Guard, Body}
		|  Clauses]) ->
	parse_function(IoDevice, StateName, [{clause, Line, [EventForm|T], Guard,
	Body} |  Clauses]);
%
% this clause matches if the event is a term
%		e.g. idle(foo, StateData) ->
%		or   idle({foo, bar}, StateData) ->
%
parse_function(IoDevice, StateName,
			[{clause,Line,[EventForm|_], Guard, Body} |  Clauses]) ->
	case find_nextstate(Body) of
		{atom, NextState} ->
			% we now know what we need to know
			write_line(IoDevice, StateName, NextState, EventForm,
					parse_guard(Guard));
		not_found-> none		% must not be a state handler at all, ignore
	end,
	parse_function(IoDevice, StateName, Clauses);
% if the clause list is empty then we're done
parse_function(IoDevice, StateName, []) -> ok;
% any other function is not a state handler
parse_function(_,_,_) -> ok.
		
%
% parse a clause guard
%
% no guard
parse_guard([]) -> [];
parse_guard([Guard]) -> parse_guard([], Guard).
%
% this case handles tests on record fields, probably StateData
%	e.g. idle(Event, StateData) when StateData#statedata.t3 > 0 ->
%
parse_guard([], [{op,_,Operator,{record_field,_,_,_,{_,_,Field}},
			{_,_,Value}}|T]) ->
	NewLabel = io_lib:write(Field) ++ atom_to_list(Operator) 
			++ io_lib:write(Value),
	parse_guard(NewLabel, T);
%
% this case handles further tests on record fields
%
parse_guard(Label, [{op,_,Operator,{record_field,_,_,_,{_,_,Field}},
			{_,_,Value}}|T]) ->
	NewLabel = "," ++ io_lib:write(Field) ++ atom_to_list(Operator)
			++ io_lib:write(Value),
	parse_guard(Label ++ NewLabel, T);
%
% this case handles BIF guard tests on record fields, probably StateData
%
parse_guard([], [{call,_,{atom,_,Test},
			[{record_field,_,_,_,{atom,_,Value}}]}|T]) ->
	NewLabel = io_lib:write(Test) ++ "(" ++ io_lib:write(Value) ++ ")",
	parse_guard(NewLabel, T);
%
% this case handles further BIF guard tests on record fields
%
parse_guard(Label, [{call,_,{atom,_,Test},
			[{record_field,_,_,_,{atom,_,Value}}]}|T]) ->
	NewLabel = "," ++ io_lib:write(Test) ++ "(" ++ io_lib:write(Value) ++ ")",
	parse_guard(Label ++ NewLabel, T);
parse_guard(Label, []) -> Label.

	

% find the case statement which operates on the passed (Event) variable
get_case(EventVar, [H | T]) ->
	case H of
		{'case',_,{var,_,EventVar},Body} ->
			{ok, Body};
		_ ->
			get_case(EventVar, T)
	end;
get_case(EventVar, []) -> not_found.


% find the name of the variable which will be used for next_state
find_nextstate([H|T]) ->
	case H of
		% we're looking for a gen_fsm defined return value
		{tuple,_,[{atom,_,next_state},{var,_,NextState},_|_]} ->	
			{var, NextState};
		{tuple,_,[{atom,_,next_state},{atom,_,NextState},_|_]} ->	
			{atom, NextState};
		{tuple,_,[{atom,_,stop},{atom,_,NextState},_]} ->
			{atom, stop};
		_ ->
			find_nextstate(T)
	end;
find_nextstate([]) -> not_found.


% cycle through all the clauses in the case statement
%
% this clause applies when the event is bound to a variable
% which would be a catchall case which we name as "*" like in SDL
parse_case(IoDevice, StateName, NextStateVar,
			[{clause, _, [{var, _, EventVar}], Guard, Body} | T]) ->
	case get_match(IoDevice, StateName, {atom,0,'*'}, NextStateVar, Body) of
		ok ->
			parse_case(IoDevice, StateName, NextStateVar, T);
		not_found ->
			{error, 'no case found'}
	end;
% in this clause we catch atoms being matched against the event
% which should be the normal case and represent the event name
parse_case(IoDevice, StateName, NextStateVar,
			[{clause, _, [EventForm], Guard, Body} | T]) ->
	case get_match(IoDevice, StateName, EventForm, NextStateVar, Body) of
		ok ->
			parse_case(IoDevice, StateName, NextStateVar, T);
		not_found ->
			{error, 'no case found'}
	end;
parse_case(IoDevice, StateName, NextStateVar, []) -> ok.

% find the place where the specified (NextStateVar) variable is assigned
get_match(IoDevice, StateName, EventForm, NextStateVar, [H|T]) ->
	case H of
		% we previously determined what variable name is used in the
		% return from this state handler so we will look to see where
		% it is bound
		{match, _, {var, _, NextStateVar}, {atom, _, NextState}} -> 
			% ... and finally we do the real work!
			write_line(IoDevice, StateName, NextState, EventForm, []);
		{tuple,_,[{atom,_,next_state},{atom,_,NextState},_|_]} ->
			% hmmm ... they didn't use the variable after all
			write_line(IoDevice, StateName, NextState, EventForm, []);
		_ ->
			get_match(IoDevice, StateName, EventForm, NextStateVar, T)
	end;
get_match(IoDevice, StateName, EventForm, NextStateVar, []) -> not_found.


% write out the spec line to the file
write_line(IoDevice, StateName, NextState, {atom,_,'*'}, []) ->
	io:fwrite(IoDevice, "   ~w -> ~w [label=\"*\", fontsize=~w];~n",
			[StateName, NextState, ?FONT_EDGE]);
write_line(IoDevice, StateName, NextState, {atom,_,'*'}, Guard) ->
	io:fwrite(IoDevice, "   ~w -> ~w [label=\"*\\n[~s]\", fontsize=~w];~n",
			[StateName, NextState, Guard, ?FONT_EDGE]);
write_line(IoDevice, StateName, NextState, EventForm, []) ->
	io:fwrite(IoDevice, "   ~w -> ~w [label=\"~w\", fontsize=~w];~n",
			[StateName, NextState, normalize(EventForm), ?FONT_EDGE]);
write_line(IoDevice, StateName, NextState, EventForm, Guard) ->
	io:fwrite(IoDevice, "   ~w -> ~w [label=\"~w\\n[~s]\", fontsize=~w];~n",
			[StateName, NextState, normalize(EventForm), Guard, ?FONT_EDGE]).

normalize({tuple,_,Tuple}) -> list_to_tuple(normalize(Tuple));
normalize(AbsTerm = {bin,_,_}) -> 
	list_to_atom(lists:flatten(erl_pp:expr(AbsTerm)));
normalize({_,_,Term}) -> Term;
normalize([H|T]) -> [normalize(H)|normalize(T)];
normalize([]) -> [].