%%% This file is part of RefactorErl.
%%%
%%% RefactorErl is free software: you can redistribute it and/or modify
%%% it under the terms of the GNU Lesser General Public License as published
%%% by the Free Software Foundation, either version 3 of the License, or
%%% (at your option) any later version.
%%%
%%% RefactorErl 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 Lesser General Public License for more details.
%%%
%%% You should have received a copy of the GNU Lesser General Public License
%%% along with RefactorErl.  If not, see <http://plc.inf.elte.hu/erlang/>.
%%%
%%% The Original Code is RefactorErl.
%%%
%%% The Initial Developer of the Original Code is Eötvös Loránd University.
%%% Portions created  by Eötvös Loránd University and ELTE-Soft Ltd.
%%% are Copyright 2007-2025 Eötvös Loránd University, ELTE-Soft Ltd.
%%% and Ericsson Hungary. All Rights Reserved.


%%% ============================================================================
%%% Module information

%%% @doc IO device for testing refactorings. Functions which don't
%%% have documentation are taken verbatim from the example IO device
%%% found in the stdlib users manual. Look there for explanations.

%%% @author Drienyovszky Daniel <monogram@inf.elte.hu>

-module(refqc_dd_iodev).
-vsn("$Rev: 17551 $").

-export([compare/2, compare_prefix/2, stop/0, reset/0]).
-export([start_link/0, init/0, loop/1, until_newline/3, until_enough/3]).

-define(CHARS_PER_REC, 128).
-define(NAME, testio).

-record(state, {
	  table,
	  position, % absolute
          reqs % reverse order
	 }).

%% @doc Starts the IO device.
start_link() ->
    register(?NAME, spawn_link(?MODULE,init,[])).

%% @private
%% @doc Initializes the state and enters the event handling loop
init() ->
    ?MODULE:loop(dict:new()).

%% @doc Resets the state of the IO device. This gets called between
%% tests.
reset() ->
    call(reset).

%% @doc Compares the IO trace of two processes.
%% @spec compare(pid(), pid()) -> bool()
compare(A, B) ->
    call({compare, A, B}).

%% @doc Checks that on trace is a prefix of the other.
%% @spec compare_prefix(pid(), pid()) -> bool()
compare_prefix(A, B) ->
    call({compare_prefix, A, B}).

%% @doc Stops the IO device.
stop() ->
    ?NAME ! {self(), stop},
    ok.

%% @doc Calls the IO device and waits for a response. Similar to
%% gen_server:call.
call(X) ->
    ?NAME ! {self(), X},
    receive
        {?NAME, Result} -> Result
    end.

%% @doc Creates a new state. The IO device keeps one of these for each
%% client pid.
new_state() ->
    Table = ets:new(noname,[ordered_set]),
    #state{table = Table, position = 0, reqs = []}.

%% @private
%% @doc Main loop, handles incoming messages.
loop(Dict) ->
    receive
	{io_request, From, ReplyAs, Request} ->
            case dict:find(From, Dict) of
                {ok, State} -> ok;
                error -> State = new_state()
            end,
            {Reply, NewSt} = request(Request, add_request(Request, State)),
            reply(From, ReplyAs, Reply),
            ?MODULE:loop(dict:store(From, NewSt, Dict));

	%% Private message
        {From, reset} ->
            reply(From, ok),
            ?MODULE:loop(dict:new());
        {From, {compare, A, B}} ->
            reply(From, compare(Dict, A, B)),
            ?MODULE:loop(Dict);
        {From, {compare_prefix, A, B}} ->
            reply(From, compare_prefix(Dict, A, B)),
            ?MODULE:loop(Dict);
        {_From, stop} ->
            ok;
	_Unknown ->
	    ?MODULE:loop(Dict)
    end.

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

reply(From, Reply) ->
    From ! {?NAME, Reply}.

add_request(Request, State) ->
    State#state{reqs = [Request|State#state.reqs]}.

%%-----------------------------------------------------------------------------

request({put_chars, Encoding, Chars}, State) ->
    put_chars(unicode:characters_to_list(Chars,Encoding),State);
request({put_chars, Encoding, Module, Function, Args}, State) ->
    try
	request({put_chars, Encoding, apply(Module, Function, Args)}, State)
    catch
	_:_ ->
	    {{error,Function}, State}
    end;

request({get_until, Encoding, _Prompt, M, F, As}, State) ->
    get_until(Encoding, M, F, As, State);
request({get_chars, Encoding, _Prompt, N}, State) ->
    get_until(Encoding, ?MODULE, until_enough, [N], State);
request({get_line, Encoding, _Prompt}, State) ->
    get_until(Encoding, ?MODULE, until_newline, [$\n], State);

request({get_geometry,_}, State) ->
    {error, {error,enotsup}, State};
request({setopts, _Opts}, State) ->
    {error, {error,enotsup}, State};
request(getopts, State) ->
    {error, {error,enotsup}, State};
request({requests, Reqs}, State) ->
     multi_request(Reqs, {ok, ok, State});

request({put_chars,Chars}, State) ->
    request({put_chars,latin1,Chars}, State);
request({put_chars,M,F,As}, State) ->
    request({put_chars,latin1,M,F,As}, State);
request({get_chars,Prompt,N}, State) ->
    request({get_chars,latin1,Prompt,N}, State);
request({get_line,Prompt}, State) ->
    request({get_line,latin1,Prompt}, State);
request({get_until, Prompt,M,F,As}, State) ->
    request({get_until,latin1,Prompt,M,F,As}, State);

request(_Other, State) ->
    {{error, request}, State}.

multi_request([R|Rs], {ok, _Res, State}) ->
    multi_request(Rs, request(R, State));
multi_request([_|_], Error) ->
    Error;
multi_request([], Result) ->
    Result.

%%-----------------------------------------------------------------------------

put_chars(Chars, #state{table = T, position = P} = State) ->
    R = P div ?CHARS_PER_REC,
    C = P rem ?CHARS_PER_REC,
    [ apply_update(T,U) || U <- split_data(Chars, R, C) ],
    {ok, State#state{position = (P + length(Chars))}}.

get_until(Encoding, Mod, Func, As,
          #state{position = P, table = T} = State) ->
    case get_loop(Mod,Func,As,T,P,[]) of
	{done,Data,NewP} when is_list(Data) ->
            case check(Encoding,
                       unicode:characters_to_list(Data, unicode)) of
                {error, _} = E -> {E, State};
                List -> {List, State#state{position = NewP}}
	    end;
	{done,Data,NewP} ->
	    {Data, State#state{position = NewP}};
	Error ->
	    {Error, State}
    end.

get_loop(M,F,A,T,P,C) ->
    {NewP,L} = get(P,T),
    case catch apply(M,F,[C,L|A]) of
	{done, List, Rest} ->
	    {done, List, NewP - length(Rest)};
	{more, NewC} ->
	    get_loop(M,F,A,T,NewP,NewC);
	_ ->
	    {error,F}
    end.

check(unicode, List) ->
    List;
check(latin1, List) ->
    try 
	[ throw(not_unicode) || X <- List,
				X > 255 ],
	List
    catch
	throw:_ ->
	    {error,{cannot_convert, unicode, latin1}}
    end.

%% @private
until_newline([],eof,_MyStopCharacter) ->
    {done,eof,[]};
until_newline(ThisFar,eof,_MyStopCharacter) ->
    {done,ThisFar,[]};
until_newline(ThisFar,CharList,MyStopCharacter) ->
    case lists:splitwith(fun(X) -> X =/= MyStopCharacter end,  CharList) of
	{L,[]} ->
            {more,ThisFar++L};
	{L2,[MyStopCharacter|Rest]} ->
	    {done,ThisFar++L2++[MyStopCharacter],Rest}
    end.

%% @private
until_enough([],eof,_N) ->
    {done,eof,[]};
until_enough(ThisFar,eof,_N) ->
    {done,ThisFar,[]};
until_enough(ThisFar,CharList,N) 
  when length(ThisFar) + length(CharList) >= N ->
    {Res,Rest} = my_split(N,ThisFar ++ CharList, []),
    {done,Res,Rest};
until_enough(ThisFar,CharList,_N) ->
    {more,ThisFar++CharList}. 

%%-----------------------------------------------------------------------------

get(P,Tab) ->
    R = P div ?CHARS_PER_REC,
    C = P rem ?CHARS_PER_REC,
    case ets:lookup(Tab,R) of
	[] ->
	    {P,eof};
	[{R,List}] ->
	    case my_split(C,List,[]) of
		{_,[]} ->
		    {P+length(List),eof};
		{_,Data} ->
		    {P+length(Data),Data}
	    end
    end.

my_split(0,Left,Acc) ->
    {lists:reverse(Acc),Left};
my_split(_,[],Acc) ->
    {lists:reverse(Acc),[]};
my_split(N,[H|T],Acc) ->
    my_split(N-1,T,[H|Acc]).

split_data([],_,_) ->
    [];
split_data(Chars, Row, Col) ->
    {This,Left} = my_split(?CHARS_PER_REC - Col, Chars, []),
    [ {Row, Col, This} | split_data(Left, Row + 1, 0) ].

apply_update(Table, {Row, Col, List}) ->     
    case ets:lookup(Table,Row) of
	[] ->
	    ets:insert(Table,{Row, lists:duplicate(Col,0) ++ List});
	[{Row, OldData}] ->
	    {Part1,_} = my_split(Col,OldData,[]),
	    {_,Part2} = my_split(Col+length(List),OldData,[]),
	    ets:insert(Table,{Row, Part1 ++ List ++ Part2})
    end.

compare(Dict, A, B) ->
    ARs = get_reqs(Dict, A),
    BRs = get_reqs(Dict, B),
    length(ARs) == length(BRs) andalso
        lists:all(fun({R, O}) -> R =:= O end, lists:zip(ARs, BRs)).

compare_prefix(Dict, A, B) ->
    Rs = get_reqs(Dict, A),
    Os = get_reqs(Dict, B),
    lists:suffix(Rs, Os) orelse lists:suffix(Os, Rs).

get_reqs(Dict, Pid) ->
    case dict:find(Pid, Dict) of
        {ok, S} -> S#state.reqs;
        error   -> []
    end.
