%%%----------------------------------------------------------------------
%%% File    : fdoc.erl
  Author   :   <  >
%%% Purpose : Heuristic sourcecode documentation extractor
%%%           (A poor man's 'edoc')
  Created : 26 Feb 2003 by   <  >
%%%----------------------------------------------------------------------
%%%@hidden
%%%@private
-module(fdoc).
-author('').

-import(lists,
	[reverse/1, splitwith/2, takewhile/2, flatten/1, map/2,
	 foreach/2, member/2, sort/1, any/2]).

%% Server-based interface
-export([apropos/1, get_apropos/1,
	 describe/1, describe/2, describe/3,
	 description/1, description/2, description/3,
	 stop/0]).

%% Function-based interface
-export([describe_file/1, file/1, string/1]).
-export([describe2/1, describe2/2, describe2/3]).

  Internal server exports
-export([init/0,loop/0]).

%% ----------------------------------------------------------------------
%% Server half. Calling these functions causes a server to be created,
%% which scans the sources for all loaded modules. You can use stop()
%% to shut it down, so that the next request will rebuild the database.
%% ----------------------------------------------------------------------

  Interface

%% Print apropos information by regexp.
apropos(Regexp) ->
    case get_apropos(Regexp) of
	{ok, Matches} ->
	    print_matches(Matches);
	Err ->
	    Err
    end.

get_apropos(Regexp) ->
    ensure_started(),
    case re:compile(Regexp) of
	{ok, MP} ->
	    fdoc ! {apropos, self(), MP},
	    receive
		{apropos, Matches} ->
		    {ok, Matches}
	    end;
	Err ->
	    Err
    end.

%% Print a description of all functions matching Module, Function, and
%% Arity. Function and module arguments are optional.

describe(M) ->
    describe(M, '_', '_').
describe(M, F) ->
    describe(M, F, '_').
describe(M, F, A) ->
  {ok, Matches} = description(M, F, A),
  print_matches(Matches).

description(M) ->
    description(M, '_', '_').

description(M, F) ->
    description(M, F, '_').

description(M, F, A) ->
    ensure_started(),
    fdoc ! {describe, self(), M, F, A},
    receive
	{describe, Matches} -> {ok, Matches}
    end.

%% This function does not use the cache
describe2(M) ->
    describe2(M, '_', '_').
describe2(M, F) ->
    describe2(M, F, '_').
describe2(M, F, A) ->
    case distel:find_source(M) of
	{ok, Sourcefile} ->
	    case file(Sourcefile) of
		{ok, Docs} ->
		    {ok, lists:zf(fun({Fn, Arity, DocStr}) when F=='_'; Fn==F ->
					  if A == '_'; A == Arity ->
						  {true, {M,Fn, Arity, DocStr}};
					     true ->
						  false
					  end;
				     (_) ->
					  false
				  end, Docs)};
		Error ->
		    Error
	    end;
	Error ->
	    Error
    end.


%% Stop the fdoc server. You can use this to flush the database.
stop() ->
    catch (fdoc ! {stop, self()}),
    receive {stop, ok} -> ok end.

%% Internals

print_matches(Ms) ->
    foreach(fun({Mod, Fn, Arity, Doc}) ->
		    io:format("~p:~p/~p:~n~s~n",
			      [Mod, Fn, Arity, indent(Doc, "  ")])
	    end,
	    sort(Ms)).

%% Ensure that the 'fdoc' server has started.
ensure_started() ->
    case whereis(?MODULE) of
	undefined ->
	    Pid = proc_lib:spawn(?MODULE, init, []),
	    register(?MODULE, Pid),
	    {ok, Pid};
	Pid ->
	    {ok, Pid}
    end.

init() ->
    init_db(),
    loop().

init_db() ->
    ets:new(?MODULE, [public, bag, named_table]),
    foreach(fun import_module/1, [M || {M, _Objfile} <- code:all_loaded()]).

loop() ->
    receive
	{stop, From} ->
	    From ! {stop, ok},
	    ok;
	{apropos, From, MP} ->
	    Matches = [{M,F,A,D} || {M,F,A,D} <- ets:tab2list(?MODULE),
				    any(fun(S) ->
						re:run(S, MP) /= nomatch
					end,
					[D,
					 atom_to_list(M),
					 atom_to_list(F)])],
	    From ! {apropos, Matches},
	    ?MODULE:loop();
	{describe, From, M, F, A} ->
	    case code:is_loaded(M) of
		false ->
  Have to reload the database first ..
		    code:ensure_loaded(M),
		    ets:delete(?MODULE),
		    init_db();
		_ ->
		    ok
	    end,
	    From ! {describe, ets:match_object(?MODULE, {M, F, A, '_'})},
	    ?MODULE:loop()
    end.

import_module(Mod) ->
    case distel:find_source(Mod) of
	{ok, Sourcefile} ->
	    case file(Sourcefile) of
		{ok, Docs} ->
		    foreach(fun({Fn, Arity, DocStr}) ->
				    ets:insert(?MODULE,{Mod,Fn,Arity,DocStr})
			    end,
			    just_exports(Mod, Docs));
		{error, _Reason} ->
		    skipped
	    end;
	{error, _Reason} ->
	    skipped
    end.

just_exports(Mod, Docs) ->
    [{F,A,D} || {F,A,D} <- Docs,
		member({F, A}, Mod:module_info(exports))].

%% ----------------------------------------------------------------------
%% Function half, for extracting documentation from files and strings.
%% ----------------------------------------------------------------------

  Interface

%% Print a description of all the documented exported functions in a
%% file.
describe_file(Name) ->
    case file(Name) of
	{ok, Docs} ->
	    foreach(fun({Fn, Arity, Doc}) ->
			    io:format("~p/~p:~n~s~n",
				      [Fn, Arity, indent(Doc, "  ")])
		    end,
		    Docs);
	{error, Rsn} ->
	    {error, Rsn}
    end.

%% Return a description of all documented exported functions in
%% a file.
%% Returns: {Function, Arity, Documentation}
file(Name) ->
    case file:read_file(Name) of
	{ok, Bin} ->
	    {ok, string(binary_to_list(Bin))};
	{error, Reason} ->
	    {error, Reason}
    end.

%% Return a description of all documented exported functions in
%% a string.
%% Returns: {Function, Arity, Documentation}
string(S) ->
    remove_dups(scan_lines(S, [])).

%% Internals

%% If we have multiple definitions of the same function/arity, just
  keep the first one .
remove_dups([{F,A,Doc}, {F,A,_} | T]) ->
    remove_dups([{F,A,Doc}|T]);
remove_dups([H|T]) ->
    [H|remove_dups(T)];
remove_dups([]) ->
    [].

scan_lines([], _) ->
    [];
scan_lines(S0, Acc) when hd(S0) == $% ->
    {CommentLine, S1} = take_line(S0),
    scan_lines(S1, [CommentLine|Acc]);
scan_lines("\n"++S, _Acc) when hd(S) == $% ->
  Blank followed by a new comment : flush old comment
    scan_lines(S, []);
scan_lines("\n"++S, Acc) ->
  Blank not followed by a comment : keep the current comment
    scan_lines(S, Acc);
scan_lines(S0, Acc) ->
    case function_start_char(hd(S0)) of
	true ->
	    scan_function(S0, comments_to_doc(reverse(Acc)));
	false ->
	    scan_lines(drop_line(S0), [])
    end.

scan_function(S0, Comments) ->
    case take_function_head(S0) of
	{ok, Head, S1} ->
	    S2 = drop_line(S1),		% skip to next fresh line
	    case parse_function_head(Head) of
		{ok, Function, Arity} ->
		    if Comments == [] ->
			    scan_lines(S2, []);
		       true ->
			    [{Function, Arity, Comments} | scan_lines(S2, [])]
		    end;
		error ->
		    scan_lines(S2, [])
	    end;
	eos ->
	    []
    end.

function_start_char(Ch) when Ch >= $a, Ch =< $z -> true;
function_start_char(Ch) when Ch >= $A, Ch =< $Z -> true;
function_start_char($')                         -> true;
function_start_char(_)                          -> false.

  Parse a function head into name and arity .
%% Returns: {ok, Name, Arity} | error
parse_function_head(S0) ->
    %% Poor man's approach: rewind back to the closing ')', tack on a
    %% '.', and see if we can parse it as a function call.
    S1 = takewhile(fun(Ch) -> Ch /= $) end, S0) ++ ").",
    case erl_scan:string(S1) of
	{ok, Scan, _} ->
	    case erl_parse:parse_exprs(Scan) of
		{ok, [{call,_,{atom,_,Fname},Args}]} ->
		    {ok, Fname, length(Args)};
		_ ->
		    error
	    end;
	_ ->
	    error
    end.

  Keep going until we see a " - > " . FIXME , should be clever about " - > "
%% appearing inside comments, atoms, or strings.
take_function_head(S) -> take_function_head(S, []).

take_function_head("->"++S, Acc) ->
    {ok, reverse(Acc), S};
take_function_head("%"++S0, Acc) ->
    {_, S1} = take_line(S0),
    take_function_head(S1, Acc);
take_function_head([H|T], Acc) ->
    take_function_head(T, [H|Acc]);
take_function_head([], _Acc) ->
    eos.

%% Returns: {Line, Rest}
take_line(S) -> take_line(S, []).

take_line([],      Acc) -> {reverse(Acc), []};
take_line([$\n|S], Acc) -> {reverse("\n"++Acc), S};
take_line([H|T],   Acc) -> take_line(T, [H|Acc]).

drop_line(S0) ->
    {_, S1} = take_line(S0),
    S1.

comments_to_doc([]) ->
    [];
  FIXME : we should really generate nothing here , since zillions
    %% of these "undocumented" strings will match e.g. an apropos
    %% search for "documented" :-) -luke
%    "(undocumented)\n";
comments_to_doc(Comments) ->
    flatten([Line || Line <- map(fun clean_comment/1, Comments),
		     not boring_comment(Line)]).

boring_comment("\n") -> true;
boring_comment(S) ->
    %% Matches "%% ----------" lines
    lists:all(fun(Ch) -> Ch == $- end, S -- "\n").

clean_comment("% "++S) -> S;
clean_comment("%"++S)  -> clean_comment(S);
clean_comment(S)       -> S.

indent(S, Pad) -> flatten([Pad | indent1(S, Pad)]).

indent1("\n"++S, Pad) -> ["\n", Pad, indent1(S, Pad)];
indent1([H|T], Pad)   -> [H|indent1(T, Pad)];
indent1([], _)        -> [].


----------------------------------------------------------------------
 File    : fdoc.erl
 Purpose : Heuristic sourcecode documentation extractor
           (A poor man's 'edoc')
----------------------------------------------------------------------
@hidden
@private
 Server-based interface
 Function-based interface
 ----------------------------------------------------------------------
 Server half. Calling these functions causes a server to be created,
 which scans the sources for all loaded modules. You can use stop()
 to shut it down, so that the next request will rebuild the database.
 ----------------------------------------------------------------------
 Print apropos information by regexp.
 Print a description of all functions matching Module, Function, and
 Arity. Function and module arguments are optional.
 This function does not use the cache
 Stop the fdoc server. You can use this to flush the database.
 Internals
 Ensure that the 'fdoc' server has started.
 ----------------------------------------------------------------------
 Function half, for extracting documentation from files and strings.
 ----------------------------------------------------------------------
 Print a description of all the documented exported functions in a
 file.
 Return a description of all documented exported functions in
 a file.
 Returns: {Function, Arity, Documentation}
 Return a description of all documented exported functions in
 a string.
 Returns: {Function, Arity, Documentation}
 Internals
 If we have multiple definitions of the same function/arity, just
 ->
 ->
 skip to next fresh line
 Returns: {ok, Name, Arity} | error
 Poor man's approach: rewind back to the closing ')', tack on a
 '.', and see if we can parse it as a function call.
 appearing inside comments, atoms, or strings.
 Returns: {Line, Rest}
 of these "undocumented" strings will match e.g. an apropos
 search for "documented" :-) -luke
    "(undocumented)\n";
 Matches "%% ----------" lines
  Author   :   <  >
  Created : 26 Feb 2003 by   <  >
-module(fdoc).
-author('').

-import(lists,
	[reverse/1, splitwith/2, takewhile/2, flatten/1, map/2,
	 foreach/2, member/2, sort/1, any/2]).

-export([apropos/1, get_apropos/1,
	 describe/1, describe/2, describe/3,
	 description/1, description/2, description/3,
	 stop/0]).

-export([describe_file/1, file/1, string/1]).
-export([describe2/1, describe2/2, describe2/3]).

  Internal server exports
-export([init/0,loop/0]).


  Interface

apropos(Regexp) ->
    case get_apropos(Regexp) of
	{ok, Matches} ->
	    print_matches(Matches);
	Err ->
	    Err
    end.

get_apropos(Regexp) ->
    ensure_started(),
    case re:compile(Regexp) of
	{ok, MP} ->
	    fdoc ! {apropos, self(), MP},
	    receive
		{apropos, Matches} ->
		    {ok, Matches}
	    end;
	Err ->
	    Err
    end.


describe(M) ->
    describe(M, '_', '_').
describe(M, F) ->
    describe(M, F, '_').
describe(M, F, A) ->
  {ok, Matches} = description(M, F, A),
  print_matches(Matches).

description(M) ->
    description(M, '_', '_').

description(M, F) ->
    description(M, F, '_').

description(M, F, A) ->
    ensure_started(),
    fdoc ! {describe, self(), M, F, A},
    receive
	{describe, Matches} -> {ok, Matches}
    end.

describe2(M) ->
    describe2(M, '_', '_').
describe2(M, F) ->
    describe2(M, F, '_').
describe2(M, F, A) ->
    case distel:find_source(M) of
	{ok, Sourcefile} ->
	    case file(Sourcefile) of
		{ok, Docs} ->
		    {ok, lists:zf(fun({Fn, Arity, DocStr}) when F=='_'; Fn==F ->
					  if A == '_'; A == Arity ->
						  {true, {M,Fn, Arity, DocStr}};
					     true ->
						  false
					  end;
				     (_) ->
					  false
				  end, Docs)};
		Error ->
		    Error
	    end;
	Error ->
	    Error
    end.


stop() ->
    catch (fdoc ! {stop, self()}),
    receive {stop, ok} -> ok end.


print_matches(Ms) ->
    foreach(fun({Mod, Fn, Arity, Doc}) ->
		    io:format("~p:~p/~p:~n~s~n",
			      [Mod, Fn, Arity, indent(Doc, "  ")])
	    end,
	    sort(Ms)).

ensure_started() ->
    case whereis(?MODULE) of
	undefined ->
	    Pid = proc_lib:spawn(?MODULE, init, []),
	    register(?MODULE, Pid),
	    {ok, Pid};
	Pid ->
	    {ok, Pid}
    end.

init() ->
    init_db(),
    loop().

init_db() ->
    ets:new(?MODULE, [public, bag, named_table]),
    foreach(fun import_module/1, [M || {M, _Objfile} <- code:all_loaded()]).

loop() ->
    receive
	{stop, From} ->
	    From ! {stop, ok},
	    ok;
	{apropos, From, MP} ->
	    Matches = [{M,F,A,D} || {M,F,A,D} <- ets:tab2list(?MODULE),
				    any(fun(S) ->
						re:run(S, MP) /= nomatch
					end,
					[D,
					 atom_to_list(M),
					 atom_to_list(F)])],
	    From ! {apropos, Matches},
	    ?MODULE:loop();
	{describe, From, M, F, A} ->
	    case code:is_loaded(M) of
		false ->
  Have to reload the database first ..
		    code:ensure_loaded(M),
		    ets:delete(?MODULE),
		    init_db();
		_ ->
		    ok
	    end,
	    From ! {describe, ets:match_object(?MODULE, {M, F, A, '_'})},
	    ?MODULE:loop()
    end.

import_module(Mod) ->
    case distel:find_source(Mod) of
	{ok, Sourcefile} ->
	    case file(Sourcefile) of
		{ok, Docs} ->
		    foreach(fun({Fn, Arity, DocStr}) ->
				    ets:insert(?MODULE,{Mod,Fn,Arity,DocStr})
			    end,
			    just_exports(Mod, Docs));
		{error, _Reason} ->
		    skipped
	    end;
	{error, _Reason} ->
	    skipped
    end.

just_exports(Mod, Docs) ->
    [{F,A,D} || {F,A,D} <- Docs,
		member({F, A}, Mod:module_info(exports))].


  Interface

describe_file(Name) ->
    case file(Name) of
	{ok, Docs} ->
	    foreach(fun({Fn, Arity, Doc}) ->
			    io:format("~p/~p:~n~s~n",
				      [Fn, Arity, indent(Doc, "  ")])
		    end,
		    Docs);
	{error, Rsn} ->
	    {error, Rsn}
    end.

file(Name) ->
    case file:read_file(Name) of
	{ok, Bin} ->
	    {ok, string(binary_to_list(Bin))};
	{error, Reason} ->
	    {error, Reason}
    end.

string(S) ->
    remove_dups(scan_lines(S, [])).


  keep the first one .
remove_dups([{F,A,Doc}, {F,A,_} | T]) ->
    remove_dups([{F,A,Doc}|T]);
remove_dups([H|T]) ->
    [H|remove_dups(T)];
remove_dups([]) ->
    [].

scan_lines([], _) ->
    [];
    {CommentLine, S1} = take_line(S0),
    scan_lines(S1, [CommentLine|Acc]);
  Blank followed by a new comment : flush old comment
    scan_lines(S, []);
scan_lines("\n"++S, Acc) ->
  Blank not followed by a comment : keep the current comment
    scan_lines(S, Acc);
scan_lines(S0, Acc) ->
    case function_start_char(hd(S0)) of
	true ->
	    scan_function(S0, comments_to_doc(reverse(Acc)));
	false ->
	    scan_lines(drop_line(S0), [])
    end.

scan_function(S0, Comments) ->
    case take_function_head(S0) of
	{ok, Head, S1} ->
	    case parse_function_head(Head) of
		{ok, Function, Arity} ->
		    if Comments == [] ->
			    scan_lines(S2, []);
		       true ->
			    [{Function, Arity, Comments} | scan_lines(S2, [])]
		    end;
		error ->
		    scan_lines(S2, [])
	    end;
	eos ->
	    []
    end.

function_start_char(Ch) when Ch >= $a, Ch =< $z -> true;
function_start_char(Ch) when Ch >= $A, Ch =< $Z -> true;
function_start_char($')                         -> true;
function_start_char(_)                          -> false.

  Parse a function head into name and arity .
parse_function_head(S0) ->
    S1 = takewhile(fun(Ch) -> Ch /= $) end, S0) ++ ").",
    case erl_scan:string(S1) of
	{ok, Scan, _} ->
	    case erl_parse:parse_exprs(Scan) of
		{ok, [{call,_,{atom,_,Fname},Args}]} ->
		    {ok, Fname, length(Args)};
		_ ->
		    error
	    end;
	_ ->
	    error
    end.

  Keep going until we see a " - > " . FIXME , should be clever about " - > "
take_function_head(S) -> take_function_head(S, []).

take_function_head("->"++S, Acc) ->
    {ok, reverse(Acc), S};
take_function_head("%"++S0, Acc) ->
    {_, S1} = take_line(S0),
    take_function_head(S1, Acc);
take_function_head([H|T], Acc) ->
    take_function_head(T, [H|Acc]);
take_function_head([], _Acc) ->
    eos.

take_line(S) -> take_line(S, []).

take_line([],      Acc) -> {reverse(Acc), []};
take_line([$\n|S], Acc) -> {reverse("\n"++Acc), S};
take_line([H|T],   Acc) -> take_line(T, [H|Acc]).

drop_line(S0) ->
    {_, S1} = take_line(S0),
    S1.

comments_to_doc([]) ->
    [];
  FIXME : we should really generate nothing here , since zillions
comments_to_doc(Comments) ->
    flatten([Line || Line <- map(fun clean_comment/1, Comments),
		     not boring_comment(Line)]).

boring_comment("\n") -> true;
boring_comment(S) ->
    lists:all(fun(Ch) -> Ch == $- end, S -- "\n").

clean_comment("% "++S) -> S;
clean_comment("%"++S)  -> clean_comment(S);
clean_comment(S)       -> S.

indent(S, Pad) -> flatten([Pad | indent1(S, Pad)]).

indent1("\n"++S, Pad) -> ["\n", Pad, indent1(S, Pad)];
indent1([H|T], Pad)   -> [H|indent1(T, Pad)];
indent1([], _)        -> [].

