%%
%% %CopyrightBegin%
%%
%% SPDX-License-Identifier: Apache-2.0
%%
%% Copyright Ericsson AB 2019-2025. 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%
%%

-module(erl_compile_server).
-moduledoc false.
-behaviour(gen_server).
-export([start_link/0, compile/1]).

%% Internal exports
-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).

-define(COMPILE_SERVER, erl_compile_server).
-define(IDLE_TIMEOUT, (10*1000)).
-define(WRONG_TIMEOUT, 1).

-type client() :: {pid(), term()}.
-type job_map() :: #{{pid(),reference()} := client()}.

-record(st, {
          cwd=[] :: file:filename(),
          config :: term(),
          timeout=?IDLE_TIMEOUT :: non_neg_integer(),
          jobs=#{} :: job_map()
         }).

-type state() :: #st{}.

-spec start_link() -> {'ok', pid()} | {'error', term()}.

start_link() ->
    gen_server:start_link({local, ?COMPILE_SERVER}, ?MODULE, [], []).

-spec init(Arg :: []) -> {'ok', any(), timeout()}.

init([]) ->
    %% We don't want the current directory in the code path.
    %% Remove it.
    _ = code:del_path("."),
    Config = init_config(),
    {ok, #st{config=Config}, ?IDLE_TIMEOUT}.

-spec compile(term()) -> term().

compile(Parameters) ->
    gen_server:call(?COMPILE_SERVER, {compile, Parameters}, infinity).

-spec handle_call(any(), _, state()) -> {'noreply', state()}.

handle_call({compile, Parameters}, From, #st{jobs=Jobs}=St0) ->
    {ErlcArgs, PathArgs} = parse_command_line(Parameters),
    case verify_context(PathArgs, Parameters, St0) of
        {ok, St1} ->
            #{cwd := Cwd, encoding := Enc} = Parameters,
            PidRef = spawn_monitor(fun() -> exit(do_compile(ErlcArgs, unicode:characters_to_list(Cwd, Enc), Enc)) end),
            St = St1#st{jobs=Jobs#{PidRef => From}},
            {noreply, St#st{timeout=?IDLE_TIMEOUT}};
        wrong_config ->
            case map_size(Jobs) of
                0 ->
                    %% Wrong configuration and no outstanding jobs.
                    %% Terminate immediately.
                    halt();
                _ ->
                    {reply, wrong_config, St0#st{timeout=?WRONG_TIMEOUT}, ?WRONG_TIMEOUT}
            end
    end.

-spec handle_cast(term(), state()) -> {'noreply', state()}.

handle_cast(_, St) ->
    {noreply, St}.

-spec handle_info(term(), state()) -> {'noreply', state(), timeout()}.

handle_info({'DOWN',Ref,process,Pid,Reason}, #st{jobs=Jobs0}=St0) ->
    Key = {Pid, Ref},
    Client = map_get(Key, Jobs0),
    Jobs = maps:remove(Key, Jobs0),
    St = St0#st{jobs=Jobs},
    gen_server:reply(Client, Reason),
    case map_size(Jobs) =:= 0 of
        true ->
            {noreply, St, St#st.timeout};
        false ->
            {noreply, St}
    end;
handle_info(timeout, #st{jobs=Jobs}) when map_size(Jobs) =:= 0 ->
    halt();
handle_info(_, #st{timeout=Timeout}=St) ->
    %% There are still outstanding jobs.
    {noreply, St, Timeout}.

%%%
%%% Local functions.
%%%

verify_context(PathArgs, #{env := Env}=Parameters, St0) ->
    case ensure_cwd(Parameters, St0) of
        {ok, #st{config=Config}=St} ->
            case make_config(PathArgs, Env) of
                Config ->
                    {ok, St};
                _ ->
                    wrong_config
            end;
        wrong_config ->
            wrong_config
    end.

ensure_cwd(#{cwd := Cwd}, #st{cwd=Cwd}=St) ->
    {ok, St};
ensure_cwd(#{cwd := NewCwd}, #st{jobs=Jobs}=St) when map_size(Jobs) =:= 0 ->
    ok = file:set_cwd(NewCwd),
    {ok, St#st{cwd=NewCwd}};
ensure_cwd(#{}, #st{}) ->
    wrong_config.

do_compile(ErlcArgs, Cwd, Enc) ->
    GL = create_gl(),
    group_leader(GL, self()),
    Result = erl_compile:compile(ErlcArgs, Cwd),
    {OutputChannel,Output0} = gl_get_output(GL),
    Output = ensure_enc(Output0, Enc),
    case {Result,OutputChannel} of
        {ok, standard_error} ->
            {ok, ~"", Output};
        {ok, standard_io} ->
            {ok, Output, ~""};
        {{error,StdErrorOutput0}, standard_error} ->
            StdErrorOutput1 = ensure_enc(StdErrorOutput0, Enc),
            StdErrorOutput = <<StdErrorOutput1/binary,Output>>,
            {error, ~"", StdErrorOutput};
        {{error,StdErrorOutput0}, standard_io} ->
            StdErrorOutput = ensure_enc(StdErrorOutput0, Enc),
            {error, Output, StdErrorOutput}
    end.

parse_command_line(#{command_line := CmdLine0, cwd := Cwd, encoding := Enc}) ->
    CmdLine = lists:map(fun(A) -> unicode:characters_to_list(A, Enc) end, CmdLine0),
    parse_command_line_1(CmdLine, unicode:characters_to_list(Cwd, Enc), [], []).

parse_command_line_1(["-pa", Pa|T], Cwd, PaAcc, PzAcc) ->
    parse_command_line_1(T, Cwd, [Pa|PaAcc], PzAcc);
parse_command_line_1(["-pz", Pz|T], Cwd, PaAcc, PzAcc) ->
    parse_command_line_1(T, Cwd, PaAcc, [Pz|PzAcc]);
parse_command_line_1(["-extra"|ErlcArgs], Cwd, PaAcc, PzAcc) ->
    PaArgs = clean_path_args(lists:reverse(PaAcc), Cwd),
    PzArgs = clean_path_args(lists:reverse(PzAcc), Cwd),
    {ErlcArgs, [{pa, PaArgs}, {pz, PzArgs}]};
parse_command_line_1([_|T], Cwd, PaAcc, PzAcc) ->
    parse_command_line_1(T, Cwd, PaAcc, PzAcc).

ensure_enc(Chars, latin1) ->
    L = unicode:characters_to_list(Chars, unicode),
    unicode:characters_to_binary(
      [ case X of
            High when High > 255 ->
                ["\\x{", erlang:integer_to_list(X, 16), $}];
            Low ->
                Low
        end || X <- L ], unicode, latin1);
ensure_enc(Chars, _Enc) -> Chars.

init_config() ->
    EnvVars = ["ERL_AFLAGS", "ERL_FLAGS", "ERL_ZFLAGS",
               "ERL_COMPILER_OPTIONS",
               "ERL_LIBS",
               "ERLC_CONFIGURATION"],
    Env0 = [{Name, os:getenv(Name)} || Name <- EnvVars],
    Env = [P || {_, Val}=P <- Env0, Val =/= false],
    {ok, Cwd} = file:get_cwd(),
    make_config([get_path_arg(pa, Cwd), get_path_arg(pz, Cwd)], Env).

get_path_arg(PathArg, Cwd) ->
    case init:get_argument(PathArg) of
        error ->
            {PathArg, []};
        {ok, Paths0} ->
            Paths1 = lists:append(Paths0),
            Paths = clean_path_args(Paths1, Cwd),
            {PathArg, Paths}
    end.

clean_path_args(PathArgs, Cwd) ->
    [filename:absname(P, Cwd) || P <- PathArgs].

make_config(PathArgs, Env0) ->
    {ok,Files} = file:list_dir(code:lib_dir()),
    LibDirSize = length(Files),
    Env = lists:sort(Env0),
    PathArgs ++ [LibDirSize] ++
        [iolist_to_binary([[Name,$=,Val,$\n] || {Name,Val} <- Env])].


%%%
%%% A group leader that will capture all output to the group leader.
%%%

create_gl() ->
    spawn_link(fun() -> gl_loop([], standard_error) end).

gl_get_output(GL) ->
    GL ! {self(), get_output},
    receive
        {GL, Output} -> Output
    end.

gl_loop(State0, OutputChannel) ->
    receive
	{io_request, From, ReplyAs, Request} ->
            {_Tag, Reply, State} = gl_request(Request, State0),
            gl_reply(From, ReplyAs, Reply),
            gl_loop(State, OutputChannel);
	{From, get_output} ->
            Output = iolist_to_binary(State0),
	    From ! {self(), {OutputChannel, Output}},
	    gl_loop(State0, OutputChannel);
        {erl_compile_server, standard_io} ->
            gl_loop(State0, standard_io);
	_Unknown ->
	    gl_loop(State0, OutputChannel)
    end.

gl_reply(From, ReplyAs, Reply) ->
    From ! {io_reply, ReplyAs, Reply},
    ok.

gl_request({put_chars, Encoding, Chars}, State) ->
    gl_put_chars(unicode:characters_to_binary(Chars, Encoding), State);
gl_request({put_chars, Encoding, Module, Function, Args}, State) ->
    try
	gl_request({put_chars, Encoding, apply(Module, Function, Args)}, State)
    catch
	_:_ ->
	    {{error,Function}, State}
    end;
gl_request({requests, Reqs}, State) ->
    gl_multi_request(Reqs, {ok, State});
gl_request(_Other, State) ->
    {error, {error, request}, State}.

gl_multi_request([R|Rs], {ok, State}) ->
    gl_multi_request(Rs, gl_request(R, State));
gl_multi_request([_|_], Error) ->
    Error;
gl_multi_request([], Result) ->
    Result.

gl_put_chars(Chars, Output) ->
    {ok, ok, [Output,Chars]}.
