#!/usr/bin/env escript
%% -*- erlang -*-

%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2020. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%%     http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% %CopyrightEnd%
%%

-mode(compile).
-compile(warnings_as_errors).

-import(lists, [foldl/3,sort/1]).

-record(st,
        {functions = [],
         types = [],
         deprecations = #{}}).

main(["update",Top]) ->
    St0 = summarize(Top),
    St = check_deprecations(Top, St0),
    emit(Top, St),
    halt(0);
main(["make_xml",Type,Top,Outfile]) ->
    St = summarize(Top),
    make_xml(Top, Type, Outfile, St#st.functions),
    halt(0).

ebin_directories(Top) ->
    [filename:join(Top, "erts/preloaded/ebin")] ++
        filelib:wildcard(filename:join(Top, "lib/*/ebin")).

summarize(Top) ->
    Directories = ebin_directories(Top),
    foldl(fun summarize_directory/2, #st{}, Directories).

summarize_directory(Dir, Acc) ->
    Files = [filename:join(Dir, F) || F <- filelib:wildcard("*.beam", Dir)],
    foldl(fun summarize_file/2, Acc, Files).

summarize_file(File, Acc) ->
    {ok, {Module, [Chunk]}} = beam_lib:chunks(File, [attributes]),
    {attributes, Attributes} = Chunk,
    summarize_attributes(Attributes, Module, Acc).

summarize_attributes([{deprecated, Ds} | As], Module, Acc0) ->
    Fs = sa_1(Ds, deprecated, Module, Acc0#st.functions),
    Acc = Acc0#st{ functions = Fs },
    summarize_attributes(As, Module, Acc);
summarize_attributes([{removed, Rs} | As], Module, Acc0) ->
    Fs = sa_1(Rs, removed, Module, Acc0#st.functions),
    Acc = Acc0#st{ functions = Fs },
    summarize_attributes(As, Module, Acc);
summarize_attributes([{deprecated_type, Ds} | As], Module, Acc0) ->
    Ts = sa_1(Ds, deprecated, Module, Acc0#st.types),
    Acc = Acc0#st{ types = Ts },
    summarize_attributes(As, Module, Acc);
summarize_attributes([{removed_type, Rs} | As], Module, Acc0) ->
    Ts = sa_1(Rs, removed, Module, Acc0#st.types),
    Acc = Acc0#st{ types = Ts },
    summarize_attributes(As, Module, Acc);
summarize_attributes([_ | As], Module, Acc) ->
    summarize_attributes(As, Module, Acc);
summarize_attributes([], _Module, Acc) ->
    Acc.

sa_1([{F, A, Info} | As], Tag, Module, Acc0) ->
    sa_1(As, Tag, Module, [{Tag, Module, F, A, Info} | Acc0]);
sa_1([{F, A} | As], Tag, Module, Acc0) ->
    sa_1(As, Tag, Module, [{Tag, Module, F, A, undefined} | Acc0]);
sa_1([module | As], Tag, Module, Acc0) ->
    sa_1(As, Tag, Module, [{Tag, Module, '_', '_', undefined} | Acc0]);
sa_1([], _Tag, _Module, Acc) ->
    Acc.

%%

emit(Top, #st{ functions = Fs0, types = Ts, deprecations = Depr }) ->
    Fs = insert_removals(Fs0, Depr),
    Name = filename:join(Top, "lib/stdlib/src/otp_internal.erl"),
    Contents = ["%%\n"
                "%% WARNING: DO NOT EDIT THIS FILE.\n"
                "%%\n"
                "%% This file was auto-generated from attributes in the source\n"
                "%% code.\n"
                "%%\n"
                "%% To add a description to a deprecation or removal attribute,\n"
                "%% write a string after the arity:\n"
                "%%\n"
                "%%    -deprecated([{foo,1,\"use bar/1 instead\"}]).\n"
                "%%    -deprecated_type([{gadget,1,\"use widget/1 instead\"}]).\n"
                "%%    -removed([{hello,2,\"use there/2 instead\"}]).\n"
                "%%    -removed_type([{frobnitz,1,\"use grunka/1 instead\"}]).\n"
                "%%\n"
                "%% Descriptions cannot be given with the `f/1` shorthand, and\n"
                "%% it will fall back to a generic description referring the\n"
                "%% user to the documentation.\n"
                "%%\n"
                "%% Use `./otp_build update_deprecations` to update this file\n"
                "%% after adding an attribute.\n"
                "%%\n"
                "-module(otp_internal).\n"
                "-include(\"otp_internal.hrl\").\n"
                "%%\n",
                emit_function("obsolete", Fs),
                emit_function("obsolete_type", Ts)],
    ok = file:write_file(Name, Contents),
    ok.

emit_function(FuncName, Entries) ->
    [io_lib:format("-dialyzer({no_match, ~ts/3}).\n", [FuncName]),
     [emit_clause(FuncName, E) || E <- sort_clauses(Entries)],
     io_lib:format("~ts(_,_,_) -> no.\n\n", [FuncName])].

sort_clauses(Entries) ->
    Tagged = [{clause_order(E), E} || E <- Entries],
    [E || {_, E} <- sort(Tagged)].

clause_order({_Tag, _Module, F, A, _Info}=Entry) ->
    {clause_order(F, A), Entry};
clause_order({_Tag, _Module, F, A, _Info, _Rel}) ->
    {clause_order(F, A), {_Tag, _Module, F, A, _Info}}.

%% Wildcard matches must be emitted *after* specific matches to avoid
%% losing descriptions.
clause_order(F, A) when F =/= '_', A =/= '_' -> 0;
clause_order(F, '_') when F =/= '_' -> 1;
clause_order('_', A) when A =/= '_' -> 2;
clause_order('_', '_') -> 3.

emit_clause(FuncName, {Tag, M, F, A, Info}) ->
    io_lib:format("~ts(~ts, ~ts, ~ts) ->\n"
                  "    {~p, ~p};\n",
                  [FuncName, match_string(M), match_string(F), match_string(A),
                   Tag, info_string(Info)]);
emit_clause(FuncName, {Tag, M, F, A, Info, Rel}) ->
    io_lib:format("~ts(~ts, ~ts, ~ts) ->\n"
                  "    {~p, ~p, ~p};\n",
                  [FuncName, match_string(M), match_string(F), match_string(A),
                   Tag, info_string(Info), Rel]).

%%

info_string(undefined) ->
    "see the documentation for details";
info_string(next_version) ->
    "will be removed in the next version. "
        "See the documentation for details";
info_string(next_major_release) ->
    "will be removed in the next major release. "
        "See the documentation for details";
info_string(eventually) ->
    "will be removed in a future release. "
        "See the documentation for details";
info_string(String) when is_list(String) ->
    String.

match_string('_') -> "_";
match_string(Term) -> io_lib:format("~p", [Term]).

%%

insert_removals([{deprecated,M,F,A,Info}=Entry|T], Depr) ->
    Key = {M,F,A},
    case Depr of
        #{Key := Ps} ->
            case lists:keyfind(remove, 1, Ps) of
                false ->
                    [Entry|insert_removals(T, Depr)];
                {remove,Rel0} ->
                    Rel = lists:concat(["OTP ",Rel0]),
                    [{deprecated,M,F,A,Info,Rel}|insert_removals(T, Depr)]
            end;
        #{} ->
            [Entry|insert_removals(T, Depr)]
    end;
insert_removals([H|T], Depr) ->
    [H|insert_removals(T, Depr)];
insert_removals([], _Depr) ->
    [].

%%%
%%% Create XML files.
%%%

make_xml(Top, Type, OutFile, InfoText0) ->
    DeprecationFile = deprecation_file(Top),
    OutDir = filename:dirname(DeprecationFile),
    InfoTextMap = maps:from_list(make_xml_info(InfoText0)),
    Depr0 = read_deprecations(DeprecationFile),
    Depr = maps:to_list(Depr0),
    {Key,Prefix} = case Type of
                       "deprecations" ->
                           {since,"deprecations"};
                       "removals" ->
                           {remove,"scheduled_for_removal"}
                   end,
    Collected = make_xml_collect(Depr, Key, InfoTextMap, []),
    All = make_xml_gen(lists:reverse(Collected), Type, Prefix, OutDir),
    file:write_file(OutFile, All),
    ok.

make_xml_info([{deprecated,M,F,A,Text}|T]) ->
    [{{M,F,A},Text}|make_xml_info(T)];
make_xml_info([{removed,_,_,_,_}|T]) ->
    make_xml_info(T);
make_xml_info([]) ->
    [].

make_xml_collect([{MFA,Ps}|T], Key, InfoTextMap, Acc) ->
    case lists:keyfind(Key, 1, Ps) of
        {Key,Rel} ->
            InfoText = case InfoTextMap of
                           #{MFA := Text} -> Text;
                           #{} -> []
                       end,
            make_xml_collect(T, Key, InfoTextMap, [{Rel,{MFA,InfoText}}|Acc]);
        false ->
            make_xml_collect(T, Key, InfoTextMap, Acc)
    end;
make_xml_collect([], _Key, _InfoTextMap, Acc) ->
    rel2fam(Acc).

make_xml_gen(Collected, Type, Prefix, Dir) ->
    Head = get_xml_template(Dir, Prefix, head),
    Contents = make_xml_gen_list(Collected, Type, Prefix, Dir),
    Footer = "</chapter>\n",
    [Head,Contents,Footer].

make_xml_gen_list([{Rel,MFAs}|T], Type, Prefix, Dir) ->
    RelStr = lists:concat(["OTP ",Rel]),
    RelMarker = lists:concat(["otp-",Rel]),
    Head = ["<section>\n",
            "<marker id=\"",RelMarker,"\"/>\n",
            "<title>",RelStr,"</title>\n"],
    Footer = "</section>\n",
    SubTitle = case Type of
                   "deprecations" ->
                       ["Functions Deprecated in ",RelStr];
                   "removals" ->
                       ["Functions Scheduled for Removal in ",RelStr]
               end,
    SubHead = ["<section>\n",
               "<title>",SubTitle,"</title>\n"],
    SubFooter = "</section>\n",
    [Head, get_xml_template(Dir, Prefix, Rel),
     SubHead, make_xml_gen_mfas(MFAs), SubFooter,
     Footer | make_xml_gen_list(T, Type, Prefix, Dir)];
make_xml_gen_list([], _, _, _) ->
    [].

make_xml_gen_mfas(MFAs) ->
    ["<list type=\"bulleted\">\n",
     [make_xml_item(MFA) || MFA <- MFAs],
     "</list>\n"].

make_xml_item({{M,F,A},Text}) ->
    ["<item><c>",lists:concat([M,":",F,"/",A]),"</c>",
     " (",Text,")</item>\n"].

get_xml_template(Dir, Prefix, Key) ->
    Name = lists:concat([Prefix,"_",Key,".inc"]),
    File = filename:join(Dir, Name),
    case file:read_file(File) of
        {ok,Contents} ->
            Contents;
        {error,enoent} ->
            []
    end.

%%%
%%% Cross-checks deprecations against DEPRECATIONS file.
%%%

check_deprecations(Top, #st{functions = Fs} = St) ->
    DeprFile = deprecation_file(Top),
    Depr = read_deprecations(DeprFile),
    Bad0 = [F || F <- Fs, not in_deprecations(F, Depr)],
    case Bad0 of
        [] ->
            St#st{deprecations = Depr};
        [_|_] ->
            Msg = "The following function(s) have -deprecated() attributes, "
                "but are not present in the DEPRECATIONS file:\n\n",
            Bad = [io_lib:format("  ~w:~w/~w\n", [M,F,A]) ||
                      {deprecated,M,F,A,_} <- Bad0],
            Loc = ["\n","Please update ",DeprFile,".\n"],
            io:put_chars(standard_error, [Msg,Bad,Loc]),
            halt(1)
    end.

read_deprecations(File) ->
    {ok,Bin} = file:read_file(File),
    Lines = binary:split(Bin, <<"\n">>, [global,trim_all]),
    maps:from_list(parse_deprecations(Lines)).

deprecation_file(Root) ->
    filename:join(Root, "system/doc/general_info/DEPRECATIONS").

in_deprecations({deprecated,M,F,A,_}, Depr) ->
    is_map_key({M,F,A}, Depr);
in_deprecations({removed,_,_,_,_}, _Depr) ->
    true.

parse_deprecations([<<"#",_/binary>>|Lines]) ->
    parse_deprecations(Lines);
parse_deprecations([Line|Lines]) ->
    [parse_line(Line)|parse_deprecations(Lines)];
parse_deprecations([]) ->
    [].

parse_line(Line) ->
    [MFA0|Parts0] = binary:split(Line, <<" ">>, [global,trim_all]),
    MFA = parse_mfa(MFA0),
    Parts1 = [binary:split(Part, <<"=">>) || Part <- Parts0],
    Parts = lists:sort([parse_part(Part) || Part <- Parts1]),
    {MFA,Parts}.

parse_part([<<"mfa">>,MFA]) ->
    {mfa,parse_mfa(MFA)};
parse_part([<<"since">>,Since]) ->
    {since,parse_release(Since)};
parse_part([<<"remove">>,Remove]) ->
    {remove,parse_release(Remove)}.

parse_release(Rel) ->
    binary_to_integer(Rel).

parse_mfa(MFA) ->
    {match,[M0,F0,A0]} = re:run(MFA, <<"^(\\w+):(\\w+)/([\\d_]+)$">>,
                                [{capture,all_but_first,binary}]),
    A = case A0 of
            <<"_">> -> '_';
            _ -> binary_to_integer(A0)
        end,
    {bin_to_atom(M0),bin_to_atom(F0),A}.

bin_to_atom(Bin) ->
    list_to_atom(binary_to_list(Bin)).

rel2fam(S0) ->
    S1 = sofs:relation(S0),
    S = sofs:rel2fam(S1),
    sofs:to_external(S).
