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

%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2020-2022. 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) ->
    AppDirs0 = filelib:wildcard(filename:join(Top, "lib/*/ebin")),

    %% Filter out erl_interface and jinterface since they lack Erlang code, and
    %% ODBC because we can't build it on all platforms we develop on. This must
    %% be fixed before we deprecate or remove functionality in ODBC.
    AppDirs = [Dir || Dir <- AppDirs0,
                      not lists:suffix("erl_interface/ebin", Dir),
                      not lists:suffix("jinterface/ebin", Dir),
                      not lists:suffix("odbc/ebin", Dir)],

    [filename:join(Top, "erts/preloaded/ebin")] ++ AppDirs.

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)],
    case Files of
        [_|_] ->
            foldl(fun summarize_file/2, Acc, Files);
        [] ->
            Msg = io_lib:format("~p doesn't appear to be built. Make sure to "
                                "build all OTP applications before updating "
                                "deprecations.\n", [Dir]),
            io:put_chars(standard_error, [Msg]),
            halt(1)
    end.

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),
    Depr0 = read_deprecations(DeprecationFile),
    Depr = maps:to_list(Depr0),

    {RelKey, AttrTag} =
        case Type of
            "deprecations" ->
                %% Group by 'since' in DEPRECATIONS, grab text from
                %% 'deprecated' attributes.
                {since, deprecated};
            "scheduled_for_removal" ->
                {remove, deprecated};
            "removed" ->
                {remove, removed}
        end,

    InfoTextMap = maps:from_list(make_xml_info(InfoText0, AttrTag)),
    Collected = make_xml_collect(Depr, RelKey, InfoTextMap, []),

    case Type of
        "removed" ->
            {ok, Vsn} = file:read_file(filename:join(Top,"OTP_VERSION")),
            [Release|_] = string:split(Vsn,"."),
            lists:foreach(
              fun({Rel, Functions}) ->
                      case Rel > binary_to_integer(Release) of
                          true ->
                              io:format(standard_error,
                                        "Some functions have been marked "
                                        "as removed in the future: ~n~p~n",
                                        [Functions]),
                              halt(1);
                          false ->
                              ok
                      end
              end, Collected);
        _ ->
            ok
    end,

    All = make_xml_gen(lists:reverse(Collected), Type, OutDir),
    ok = file:write_file(OutFile, All).

make_xml_info([{Tag,M,F,A,Text} | Attributes], Tag) ->
    [{{M,F,A}, info_string(Text)} | make_xml_info(Attributes, Tag)];
make_xml_info([_ | Attributes], Tag) ->
    make_xml_info(Attributes, Tag);
make_xml_info([], _Tag) ->
    [].

%% Joins `DEPRECATIONS` with module attributes, grabbing the text from said
%% attributes and grouping them by the release version pointed out by `RelKey`
%% ('since' or 'remove').
make_xml_collect([{MFA, Ps} | T], RelKey, InfoTextMap, Acc0) ->
    Acc = case lists:keyfind(RelKey, 1, Ps) of
              {RelKey, Rel} ->
                  case InfoTextMap of
                      #{ MFA := Text } ->
                          [{Rel, {MFA,Text}} | Acc0];
                      #{} ->
                          Acc0
                  end;
              false ->
                  Acc0
          end,
    make_xml_collect(T, RelKey, InfoTextMap, Acc);
make_xml_collect([], _RelKey, _InfoTextMap, Acc) ->
    rel2fam(Acc).

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

make_xml_gen_list([{Rel,MFAs}|T], Type, 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];
                   "scheduled_for_removal" ->
                       ["Functions Scheduled for Removal in ",RelStr];
                   "removed" ->
                       ["Functions Removed in ",RelStr]
               end,
    SubHead = ["<section>\n",
               "<title>",SubTitle,"</title>\n"],
    SubFooter = "</section>\n",
    [Head, get_xml_template(Dir, Type, Rel),
     SubHead, make_xml_gen_mfas(MFAs), SubFooter,
     Footer | make_xml_gen_list(T, Type, 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() or "
                "-removed() attributes, but are not present in the "
                "DEPRECATIONS file:\n\n",
            Bad = [io_lib:format("  ~w:~w/~w\n", [M,F,A]) ||
                      {_,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({Tag,M,F,A,_}, Depr) when Tag =:= deprecated; Tag =:= removed ->
    is_map_key({M,F,A}, Depr).

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).