#!/usr/bin/env escript
%%% 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]),
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.
-spec contains_tag([string()], string()) -> boolean().
contains_tag(Text, Tag) ->
StrContainsTag = fun(Str) -> string:str(Str,Tag) =/= 0 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;