make_doc

#!/usr/bin/env escript

%%% -*- coding: utf-8 -*-
%%% -*- erlang-indent-level: 2 -*-
%%% -------------------------------------------------------------------
%%% Copyright 2010-2017 Manolis Papadakis <manopapad@gmail.com>,
%%%                     Eirini Arvaniti <eirinibob@gmail.com>
%%%                 and Kostis Sagonas <kostis@cs.ntua.gr>
%%%
%%% This file is part of PropEr.
%%%
%%% PropEr is free software: you can redistribute it and/or modify
%%% it under the terms of the GNU General Public License as published by
%%% the Free Software Foundation, either version 3 of the License, or
%%% (at your option) any later version.
%%%
%%% PropEr 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 General Public License for more details.
%%%
%%% You should have received a copy of the GNU General Public License
%%% along with PropEr.  If not, see <http://www.gnu.org/licenses/>.

%%% Author:      Manolis Papadakis
%%% Description: Documentation processing script: This script will call EDoc on
%%%              the application's source files, after inlining all types
%%%              denoted as aliases, and removing from the exported types lists
%%%              all types denoted as private.
%%% Known Bugs:  * This scipt is very hacky, it will probably break easily.
%%%              * Record declarations with no type information are discarded.
%%%              * Any text inside the same multi-line comment as an @alias or
%%%                @private_type tag will be discarded.
%%%              * Comments inside included files are not processed.
%%%              * Comments will generally be displaced, especially comments
%%%                inside type declarations or functions.
%%%              * File and line information is partially lost.


%% Needed for some defines and some types
-include("include/proper_internal.hrl").

%%------------------------------------------------------------------------------
%% Constants
%%------------------------------------------------------------------------------

-define(SRC_FILES_RE, "^.*\\.erl$").
-define(APP_NAME, proper).
-define(BASE_DIR, ".").
-define(SRC_DIR, (?BASE_DIR ++ "/src")).
-define(INCLUDE_DIR, (?BASE_DIR ++ "/include")).
-define(TEMP_SRC_DIR, (?BASE_DIR ++ "/temp_src")).
-define(EDOC_OPTS, [{report_missing_types,true}, {report_type_mismatch,true},
		    {pretty_printer,erl_pp}, {preprocess,true},
		    {source_path, [?TEMP_SRC_DIR]}]).

-ifdef(USE_ERL_SCAN_LINE).
-define(LINE_MOD, erl_scan).
-else.
-define(LINE_MOD, erl_anno).
-endif.

%%------------------------------------------------------------------------------
%% Types
%%------------------------------------------------------------------------------

-type line()      :: ?LINE_MOD:line().
-type var_name()  :: atom().
-type rec_name()  :: atom().
-type var_form()  :: {'var', line(), var_name()}.
-type type_name() :: atom().
-type type_ref()  :: {'type', type_name(), arity()}.
-type type_def()  :: {abs_type(), [var_form()]}.

-type charlist()  :: [char() | charlist()].
-type charlist_with_lines() :: {[line(),...], charlist()}.


%%------------------------------------------------------------------------------
%% File handling
%%------------------------------------------------------------------------------

-spec main([string()]) -> 'ok'.
main(_CmdlineArgs) ->
    Delete = fun(Filename,ok) -> file:delete(Filename) end,
    case file:make_dir(?TEMP_SRC_DIR) of
	ok ->
	    ok;
	{error,eexist} ->
	    ok = filelib:fold_files(?TEMP_SRC_DIR, ?SRC_FILES_RE, false,
				    Delete, ok),
	    ok = file:del_dir(?TEMP_SRC_DIR),
	    ok
    end,
    Copy =
	fun(SrcFilename, ok) ->
	    Basename = filename:basename(SrcFilename),
	    DstFilename = ?TEMP_SRC_DIR ++ "/" ++ Basename,
	    {ok,_Bytes} = file:copy(SrcFilename, DstFilename),
	    ok
	end,
    ok = filelib:fold_files(?SRC_DIR, ?SRC_FILES_RE, false, Copy, ok),
    Process = fun(Filename,ok) -> process(Filename) end,
    ok = filelib:fold_files(?TEMP_SRC_DIR, ?SRC_FILES_RE, false, Process, ok),
    ok = edoc:application(?APP_NAME, ?BASE_DIR, ?EDOC_OPTS),
    ok = filelib:fold_files(?TEMP_SRC_DIR, ?SRC_FILES_RE, false, Delete, ok),
    ok = file:del_dir(?TEMP_SRC_DIR),
    ok.

-spec process(file:filename()) -> 'ok'.
process(Filename) ->
    {ok,Forms} = epp:parse_file(Filename, [?INCLUDE_DIR], []),
    Comments = erl_comment_scan:file(Filename),
    {NewForms,NewComments} = process_forms(Forms, Comments),
    Code = pretty_print(NewForms, NewComments),
    {ok,IODev} = file:open(Filename, [write, {encoding, utf8}]),
    ok = io:put_chars(IODev, Code),
    ok = file:close(IODev),
    ok.

-spec pretty_print([abs_form()], [erl_comment_scan:comment()]) -> charlist().
pretty_print(Forms, Comments) ->
    FormsWithLines = add_lines_to_forms(Forms),
    CommentsWithLines =
	[{[Line],[["%",Str,"\n"] || Str <- Text] ++ "%@end\n"}
	 || {Line,_Col,_Ind,Text} <- Comments],
    CodeWithLines = lists:keymerge(1, FormsWithLines, CommentsWithLines),
    [S || {_L,S} <- CodeWithLines].

-spec add_lines_to_forms([abs_form()]) -> [charlist_with_lines()].
add_lines_to_forms(Forms) ->
    add_lines_to_forms(Forms, [], {"",0}, []).

-spec add_lines_to_forms([abs_form()], [charlist_with_lines()],
			 {file:filename(),line()},
			 [{file:filename(),line()}]) ->
	  [charlist_with_lines()].
add_lines_to_forms([], Acc, _FilePos, _Stack) ->
    lists:reverse(Acc);
add_lines_to_forms([Form|Rest], Acc, {FileName,_FileLine}, Stack) ->
    case Form of
	{attribute,Line,file,{NewFileName,_NewFileLine} = NewFilePos} ->
	    case NewFileName of
		"" ->
		    %% TODO: What is the meaning of an empty file name?
		    %% TODO: Why is it causing problems?
		    add_lines_to_forms(Rest, Acc, {FileName,Line}, Stack);
		FileName ->
		    %% TODO: Can this happen?
		    add_lines_to_forms(Rest, Acc, NewFilePos, Stack);
		_ ->
		    NewStack =
			case Stack of
			    [{NewFileName,_}|Bottom] ->
				Bottom;
			    _ ->
				[{FileName,Line}|Stack]
			end,
		    add_lines_to_forms(Rest, Acc, NewFilePos, NewStack)
	    end;
	{attribute,Line,record,_Fields} ->
	    add_lines_to_forms(Rest, Acc, {FileName,Line}, Stack);
	_ ->
	    PrintedForm = print_form(Form),
	    Line = get_line_from_form(Form),
	    Lines = tl(lists:reverse([Line | [L || {_F,L} <- Stack]])),
	    add_lines_to_forms(Rest, [{Lines,PrintedForm}|Acc],
			       {FileName,Line}, Stack)
    end.

-spec print_form(abs_form()) -> charlist().
print_form({attribute,_,type,{{record,Name},Fields,[]}}) ->
    print_record_type(Name,Fields);
print_form(OtherForm) ->
    erl_pp:form(OtherForm).

-spec print_record_type(rec_name(), [abs_rec_field()]) -> charlist().
print_record_type(Name, Fields) ->
    ["-record(", atom_to_list(Name), ",{",
     case Fields of
	[] ->
	    [];
	[Head|Rest] ->
	    [print_record_field(Head),
	     [[",",print_record_field(F)] || F <- Rest]]
     end,
     "}).\n"].

-spec print_record_field(abs_rec_field()) -> charlist().
print_record_field({record_field,_,{atom,_,Name}}) ->
    atom_to_list(Name);
print_record_field({record_field,_,{atom,_,Name},Initialization}) ->
    [atom_to_list(Name), $=, erl_pp:expr(Initialization,-1,none)];
print_record_field({typed_record_field,InnerField,FieldType}) ->
    MyTypeDecl = {attribute,0,type,{mytype,FieldType,[]}},
    PrintedMyType = lists:flatten(erl_pp:form(MyTypeDecl)),
    PrintedFieldType =
	lists:reverse(remove_from_head("\n.",
	    lists:reverse(remove_from_head("-typemytype()::", PrintedMyType)))),
    [print_record_field(InnerField), "::", PrintedFieldType].

-spec remove_from_head(string(), string()) -> string().
remove_from_head([], Str) ->
    Str;
remove_from_head(ToRemove, [32|StrRest]) ->
    remove_from_head(ToRemove, StrRest);
remove_from_head([C|ToRemoveRest], [C|StrRest]) ->
    remove_from_head(ToRemoveRest, StrRest).

-spec get_line_from_form(abs_form()) -> line().
get_line_from_form({attribute,Line,_Kind,_Value}) ->
    Line;
get_line_from_form({function,Line,_Name,_Arity,_Clauses}) ->
    Line;
get_line_from_form({eof,Line}) ->
    Line.


%%------------------------------------------------------------------------------
%% Abstract code processing
%%------------------------------------------------------------------------------

-spec process_forms([abs_form(),...], [erl_comment_scan:comment()]) ->
	  {[abs_form(),...],[erl_comment_scan:comment()]}.
process_forms(Forms, Comments) ->
    [FileAttr|Rest] = Forms,
    {attribute,_Line,file,{TopFileName,_FileLine}} = FileAttr,
    process_forms([FileAttr], Rest, [], Comments, [], TopFileName).

-spec process_forms([abs_form(),...], [abs_form()],
		    [erl_comment_scan:comment()], [erl_comment_scan:comment()],
		    [{type_name(),arity()}], file:filename()) ->
	  {[abs_form(),...],[erl_comment_scan:comment()]}.
process_forms(RevForms, Forms, RevComments, [], PrivTypes, _TopFileName) ->
    NewForms = lists:reverse(RevForms) ++ Forms,
    NewComments = lists:reverse(RevComments),
    {remove_private_types(NewForms,PrivTypes), NewComments};
process_forms(RevForms, Forms, RevComments, [Comment|Rest], PrivTypes,
	      TopFileName) ->
    {CommLine,_Column,_Indentation,Text} = Comment,
    IsPrivate = contains_tag(Text, "@private_type"),
    IsAlias = contains_tag(Text, "@alias"),
    case IsPrivate orelse IsAlias of
	true ->
	    {MaybeType,NewRevForms,NewForms} =
		find_next_type(CommLine, RevForms, Forms, TopFileName),
	    case MaybeType of
		error ->
		    process_forms(NewRevForms, NewForms, RevComments, Rest,
				  PrivTypes, TopFileName);
		{TypeRef,TypeDef} ->
		    %% TODO: Also throw away alias type forms?
		    {FinalRevForms,FinalForms} =
			case IsAlias of
			    true ->
				{[replace(F,TypeRef,TypeDef)
				  || F <- NewRevForms],
				 [replace(F,TypeRef,TypeDef) || F <- NewForms]};
			    false ->
				{NewRevForms,NewForms}
			end,
		    NewPrivTypes =
			case IsPrivate of
			    true ->
				{type,Name,Arity} = TypeRef,
				[{Name,Arity} | PrivTypes];
			    false ->
				PrivTypes
			end,
		    process_forms(FinalRevForms, FinalForms, RevComments, Rest,
				  NewPrivTypes, TopFileName)
	    end;
	false ->
	    process_forms(RevForms, Forms, [Comment|RevComments], Rest,
			  PrivTypes, TopFileName)
    end.

-spec find_next_type(line(), [abs_form()], [abs_form()], file:filename()) ->
	  {'error' | {type_ref(),type_def()}, [abs_form()], [abs_form()]}.
find_next_type(_CommLine, RevForms, [], _TopFileName) ->
    {error, RevForms, []};
find_next_type(CommLine, RevForms, [Form|Rest] = Forms, TopFileName) ->
    case Form of
	{attribute,_AttrLine,file,_FilePos} ->
	    continue_after_header(CommLine, RevForms, Forms, TopFileName);
	_ ->
	    case get_line_from_form(Form) =< CommLine of
		true ->
		    find_next_type(CommLine, [Form|RevForms], Rest,
				   TopFileName);
		false ->
		    case Form of
			{attribute,_AttrLine,Kind,Value} when Kind =:= type
						       orelse Kind =:= opaque ->
			    {Name,TypeForm,VarForms} = Value,
			    case is_atom(Name) of
				true ->
				    Arity = length(VarForms),
				    TypeRef = {type,Name,Arity},
				    TypeDef = {TypeForm,VarForms},
				    {{TypeRef,TypeDef}, RevForms, Forms};
				false ->
				    {error, RevForms, Forms}
			    end;
			_ ->
			    {error, RevForms, Forms}
		    end
	    end
    end.

-spec continue_after_header(line(), [abs_form()], [abs_form(),...],
			    file:filename()) ->
	  {'error' | {type_ref(),type_def()}, [abs_form(),...], [abs_form()]}.
continue_after_header(CommLine, RevForms, [Form|Rest], TopFileName) ->
    case Form of
	{attribute,_AttrLine,file,{TopFileName,_TopFileLine}} ->
	    find_next_type(CommLine, [Form|RevForms], Rest, TopFileName);
	_Other ->
	    continue_after_header(CommLine, [Form|RevForms], Rest, TopFileName)
    end.

-ifdef(AT_LEAST_20).
-define(CONTAINS_TEST(Str, Tag), string:find(Str, Tag) =/= nomatch).
-else.
-define(CONTAINS_TEST(Str, Tag), string:str(Str, Tag) =/= 0).
-endif.

-spec contains_tag([string()], string()) -> boolean().
contains_tag(Text, Tag) ->
    StrContainsTag = fun(Str) -> ?CONTAINS_TEST(Str, Tag) end,
    lists:any(StrContainsTag, Text).

-spec replace(abs_form() | abs_type() | abs_rec_field() | abs_clause(),
	      var_form() | type_ref(), abs_type() | type_def()) ->
	  abs_form() | abs_type() | abs_rec_field() | abs_clause().
%% TODO: Should we update the source lines when inlining?
replace({attribute,Line,type,{{record,Name},Fields,[]}}, Alias, Value) ->
    NewFields = [replace(Field,Alias,Value) || Field <- Fields],
    {attribute, Line, type, {{record,Name},NewFields,[]}};
replace({attribute,Line,Kind,{Name,TypeForm,VarForms}}, Alias, Value)
	when Kind =:= type orelse Kind =:= opaque ->
    NewTypeForm = replace(TypeForm, Alias, Value),
    {attribute, Line, Kind, {Name,NewTypeForm,VarForms}};
replace({attribute,Line,spec,{FunRef,Clauses}}, Alias, Value) ->
    NewClauses = [replace(Clause,Alias,Value) || Clause <- Clauses],
    {attribute, Line, spec, {FunRef,NewClauses}};
replace({typed_record_field,RecField,FieldType}, Alias, Value) ->
    {typed_record_field, RecField, replace(FieldType,Alias,Value)};
replace({type,Line,bounded_fun,[MainClause,Constraints]}, Alias, Value) ->
    ReplaceInConstraint =
	fun({type,L,constraint,[ConstrKind,Args]}) ->
	    NewArgs = [replace(Arg,Alias,Value) || Arg <- Args],
	    {type, L, constraint, [ConstrKind,NewArgs]}
	end,
    NewConstraints = [ReplaceInConstraint(C) || C <- Constraints],
    {type, Line, bounded_fun, [MainClause,NewConstraints]};
replace({var,_Line1,SameName}, {var,_Line2,SameName}, Value) ->
    Value;
replace({Kind,Line,Args}, Alias, Value) when Kind =:= ann_type
				      orelse Kind =:= paren_type
				      orelse Kind =:= remote_type ->
    NewArgs = [replace(Arg,Alias,Value) || Arg <- Args],
    {Kind, Line, NewArgs};
replace(Type = {type,_Line,tuple,any}, _Alias, _Value) ->
    Type;
replace({type,_Line,SameName,Args}, Alias = {type,SameName,Arity},
	Value = {TypeForm,VarForms}) when length(Args) =:= Arity ->
    FixedArgs = [replace(Arg,Alias,Value) || Arg <- Args],
    ReplaceVar = fun({Var,Val},T) -> replace(T, Var, Val) end,
    lists:foldl(ReplaceVar, TypeForm, lists:zip(VarForms,FixedArgs));
replace({type,Line,Name,Args}, Alias, Value) ->
    NewArgs = [replace(Arg,Alias,Value) || Arg <- Args],
    {type, Line, Name, NewArgs};
replace(Other, _Alias, _Value) ->
    Other.

-spec remove_private_types([abs_form()], [{type_name(),arity()}]) ->
	  [abs_form()].
remove_private_types(Forms, PrivTypesList) ->
    PrivTypesSet = sets:from_list(PrivTypesList),
    [remove_from_exported(Form,PrivTypesSet) || Form <- Forms].

-type priv_types() :: sets:set({type_name(),arity()}).
-spec remove_from_exported(abs_form(), priv_types()) -> abs_form().
remove_from_exported({attribute,Line,export_type,TypesList}, PrivTypesSet) ->
    IsNotPrivate = fun(T) -> not sets:is_element(T,PrivTypesSet) end,
    {attribute, Line, export_type, lists:filter(IsNotPrivate,TypesList)};
remove_from_exported(OtherAttr, _PrivTypesSet) ->
    OtherAttr.

%% -spec update_line(abs_type(), line()) -> abs_type().
%% update_line(Type, Line) ->
%%     %% TODO: Is this function necessary?
%%     %% TODO: Will this work with type declarations?
%%     UpdateNodeLine = fun(Node) -> set_pos(Node, Line) end,
%%     %% TODO: Is the 'revert' operation necessary?
%%     erl_syntax:revert(erl_syntax_lib:map(UpdateNodeLine, Type)).
%% kate: syntax erlang;