locus

%% @private
-module(locus_gen_statem_compat).
-include("locus_pre_otp19_compat.hrl").
-ifdef(NO_GEN_STATEM).
%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2016-2017. 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%
%%

-ignore_xref(
   [behaviour_info/1,
    call/2,
    cast/2,
    enter_loop/4,
    enter_loop/5,
    enter_loop/6,
    format_status/2,
    init_it/6,
    reply/1,
    reply/2,
    start/3,
    start/4,
    start_link/3,
    system_code_change/4,
    system_continue/3,
    system_get_state/1,
    system_replace_state/2,
    system_terminate/4,
    wakeup_from_hibernate/3]).

-ifdef(POST_OTP_17).
-ignore_xref(
   [stop/1,
    stop/3
   ]).
-endif.

%% API
-export(
   [start/3,start/4,start_link/3,start_link/4,
    cast/2,call/2,call/3,
    enter_loop/4,enter_loop/5,enter_loop/6,
    reply/1,reply/2]).

-ifdef(POST_OTP_17).
-export(
   [stop/1,stop/3
   ]).
-endif.

%% gen callbacks
-export(
   [init_it/6]).

%% sys callbacks
-export(
   [system_continue/3,
    system_terminate/4,
    system_code_change/4,
    system_get_state/1,
    system_replace_state/2,
    format_status/2]).

%% Internal callbacks
-export(
   [wakeup_from_hibernate/3]).

%% Type exports for templates and callback modules
-export_type(
   [event_type/0,
    callback_mode_result/0,
    init_result/1,
    state_enter_result/1,
    event_handler_result/1,
    reply_action/0,
    enter_action/0,
    action/0]).
%% Old types, not advertised
-export_type(
   [state_function_result/0,
    handle_event_result/0]).

%% Type that is exported just to be documented
-export_type([transition_option/0]).

%%%==========================================================================
%%% Interface functions.
%%%==========================================================================

-type from() ::
    {To :: pid(), Tag :: term()}. % Reply-to specifier for call

-type state() ::
    state_name() | % For StateName/3 callback functions
    term(). % For handle_event/4 callback function

-type state_name() :: atom().

-type data() :: term().

-type event_type() ::
    {'call',From :: from()} | 'cast' |
    'info' | 'timeout' | 'state_timeout' | 'internal'.

-type callback_mode_result() ::
    callback_mode() | [callback_mode() | state_enter()].
-type callback_mode() :: 'state_functions' | 'handle_event_function'.
-type state_enter() :: 'state_enter'.

-type transition_option() ::
    postpone() | hibernate() |
    event_timeout() | state_timeout().
-type postpone() ::
    %% If 'true' postpone the current event
    %% and retry it when the state changes (=/=)
    boolean().
-type hibernate() ::
    %% If 'true' hibernate the server instead of going into receive
    boolean().
-type event_timeout() ::
    %% Generate a ('timeout', EventContent, ...) event after Time
    %% unless some other event is delivered
    Time :: timeout().
-type state_timeout() ::
    %% Generate a ('state_timeout', EventContent, ...) event after Time
    %% unless the state is changed
    Time :: timeout().

-type action() ::
    %% During a state change:
    %% * NextState and NewData are set.
    %% * All action()s are executed in order of apperance.
    %% * Postponing the current event is performed
    %%   iff 'postpone' is 'true'.
    %% * A state timeout is started iff 'timeout' is set.
    %% * Pending events are handled or if there are
    %%   no pending events the server goes into receive
    %%   or hibernate (iff 'hibernate' is 'true')
    %%
    %% These action()s are executed in order of appearence
    %% in the containing list. The ones that set options
    %% will override any previous so the last of each kind wins.
    %%
    'postpone' |  % Set the postpone option
    {'postpone', Postpone :: postpone()} |
    %%
    %% All 'next_event' events are kept in a list and then
    %% inserted at state changes so the first in the
    %% action() list is the first to be delivered.
    {'next_event', % Insert event as the next to handle
     EventType :: event_type(),
     EventContent :: term()} |
    enter_action().
-type enter_action() ::
    'hibernate' | % Set the hibernate option
    {'hibernate', Hibernate :: hibernate()} |
    %%
    (Timeout :: event_timeout()) | % {timeout,Timeout}
    {'timeout', % Set the event_timeout option
     Time :: event_timeout(), EventContent :: term()} |
    {'state_timeout', % Set the state_timeout option
     Time :: state_timeout(), EventContent :: term()} |
    %%
    reply_action().
-type reply_action() ::
    {'reply', % Reply to a caller
     From :: from(), Reply :: term()}.

-type init_result(StateType) ::
    {ok, State :: StateType, Data :: data()} |
    {ok, State :: StateType, Data :: data(),
     Actions :: [action()] | action()} |
    'ignore' |
    {'stop', Reason :: term()}.

%% Old, not advertised
-type state_function_result() ::
    event_handler_result(state_name()).
-type handle_event_result() ::
    event_handler_result(state()).
%%
-type state_enter_result(State) ::
    {'next_state', % {next_state,NextState,NewData,[]}
     State,
     NewData :: data()} |
    {'next_state', % State transition, maybe to the same state
     State,
     NewData :: data(),
     Actions :: [enter_action()] | enter_action()} |
    state_callback_result(enter_action()).
-type event_handler_result(StateType) ::
    {'next_state', % {next_state,NextState,NewData,[]}
     NextState :: StateType,
     NewData :: data()} |
    {'next_state', % State transition, maybe to the same state
     NextState :: StateType,
     NewData :: data(),
     Actions :: [action()] | action()} |
    state_callback_result(action()).
-type state_callback_result(ActionType) ::
    {'keep_state', % {keep_state,NewData,[]}
     NewData :: data()} |
    {'keep_state', % Keep state, change data
     NewData :: data(),
     Actions :: [ActionType] | ActionType} |
    'keep_state_and_data' | % {keep_state_and_data,[]}
    {'keep_state_and_data', % Keep state and data -> only actions
     Actions :: [ActionType] | ActionType} |
    %%
    {'repeat_state', % {repeat_state,NewData,[]}
     NewData :: data()} |
    {'repeat_state', % Repeat state, change data
     NewData :: data(),
     Actions :: [ActionType] | ActionType} |
    'repeat_state_and_data' | % {repeat_state_and_data,[]}
    {'repeat_state_and_data', % Repeat state and data -> only actions
     Actions :: [ActionType] | ActionType} |
    %%
    'stop' | % {stop,normal}
    {'stop', % Stop the server
     Reason :: term()} |
    {'stop', % Stop the server
     Reason :: term(),
     NewData :: data()} |
    %%
    {'stop_and_reply', % Reply then stop the server
     Reason :: term(),
     Replies :: [reply_action()] | reply_action()} |
    {'stop_and_reply', % Reply then stop the server
     Reason :: term(),
     Replies :: [reply_action()] | reply_action(),
     NewData :: data()}.


%% The state machine init function.  It is called only once and
%% the server is not running until this function has returned
%% an {ok, ...} tuple.  Thereafter the state callbacks are called
%% for all events to this server.
-callback init(Args :: term()) -> init_result(state()).

%% This callback shall return the callback mode of the callback module.
%%
%% It is called once after init/0 and code_change/4 but before
%% the first state callback StateName/3 or handle_event/4.
-callback callback_mode() -> callback_mode_result().

%% Example state callback for StateName = 'state_name'
%% when callback_mode() =:= state_functions.
%%
%% In this mode all states has to be of type state_name() i.e atom().
%%
%% Note that the only callbacks that have arity 3 are these
%% StateName/3 callbacks and terminate/3, so the state name
%% 'terminate' is unusable in this mode.
%-callback state_name(
%        'enter',
%        OldStateName :: state_name(),
%        Data :: data()) ->
%    state_enter_result('state_name');
%           (event_type(),
%        EventContent :: term(),
%        Data :: data()) ->
%    event_handler_result(state_name()).
%%
%% State callback for all states
%% when callback_mode() =:= handle_event_function.
%-callback handle_event(
%        'enter',
%        OldState :: state(),
%        State, % Current state
%        Data :: data()) ->
%    state_enter_result(State);
%           (event_type(),
%        EventContent :: term(),
%        State :: state(), % Current state
%        Data :: data()) ->
%    event_handler_result(state()).
%
%% Clean up before the server terminates.
%-callback terminate(
%        Reason :: 'normal' | 'shutdown' | {'shutdown', term()}
%            | term(),
%        State :: state(),
%        Data :: data()) ->
%    any().

% Note that the new code can expect to get an OldState from
% the old code version not only in code_change/4 but in the first
% state callback function called thereafter
-callback code_change(
        OldVsn :: term() | {'down', term()},
        OldState :: state(),
        OldData :: data(),
        Extra :: term()) ->
    {ok, NewState :: state(), NewData :: data()} |
    (Reason :: term()).

%% Format the callback module state in some sensible that is
%% often condensed way.  For StatusOption =:= 'normal' the perferred
%% return term is [{data,[{"State",FormattedState}]}], and for
%% StatusOption =:= 'terminate' it is just FormattedState.
%-callback format_status(
%        StatusOption,
%        [ [{Key :: term(), Value :: term()}] |
%          state() |
%          data()]) ->
%    Status :: term() when
%      StatusOption :: 'normal' | 'terminate'.
%
%-optional_callbacks(
%   [init/1, % One may use enter_loop/5,6,7 instead
%    format_status/2, % Has got a default implementation
%    terminate/3, % Has got a default implementation
%    code_change/4, % Only needed by advanced soft upgrade
%    %%
%    state_name/3, % Example for callback_mode() =:= state_functions:
%    %% there has to be a StateName/3 callback function
%    %% for every StateName in your state machine but the state name
%    %% 'state_name' does of course not have to be used.
%    %%
%    handle_event/4 % For callback_mode() =:= handle_event_function
%   ]).

%% Type validation functions
callback_mode(CallbackMode) ->
    case CallbackMode of
    state_functions ->
        true;
    handle_event_function ->
        true;
    _ ->
        false
    end.
%%
from({Pid,_}) when is_pid(Pid) ->
    true;
from(_) ->
    false.
%%
event_type({call,From}) ->
    from(From);
event_type(Type) ->
    case Type of
    {call,From} ->
        from(From);
    cast ->
        true;
    info ->
        true;
    timeout ->
        true;
    state_timeout ->
        true;
    internal ->
        true;
    _ ->
        false
    end.



-define(
   STACKTRACE(),
   try throw(ok) catch _ -> erlang:get_stacktrace() end).

%%%==========================================================================
%%% API

-type server_name() ::
      {'global', GlobalName :: term()}
      | {'via', RegMod :: module(), Name :: term()}
      | {'local', atom()}.
-type server_ref() ::
      pid()
      | (LocalName :: atom())
      | {Name :: atom(), Node :: atom()}
      | {'global', GlobalName :: term()}
      | {'via', RegMod :: module(), ViaName :: term()}.
-type debug_opt() ::
    {'debug',
     Dbgs ::
       ['trace' | 'log' | 'statistics' | 'debug'
        | {'logfile', string()}]}.
-type start_opt() ::
    debug_opt()
      | {'timeout', Time :: timeout()}
      | {'spawn_opt', [proc_lib:spawn_option()]}.
-type start_ret() ::  {'ok', pid()} | 'ignore' | {'error', term()}.



%% Start a state machine
-spec start(
    Module :: module(), Args :: term(), Opts :: [start_opt()]) ->
           start_ret().
start(Module, Args, Opts) ->
    gen:start(?MODULE, nolink, Module, Args, Opts).
%%
-spec start(
    ServerName :: server_name(),
    Module :: module(), Args :: term(), Opts :: [start_opt()]) ->
           start_ret().
start(ServerName, Module, Args, Opts) ->
    gen:start(?MODULE, nolink, ServerName, Module, Args, Opts).

%% Start and link to a state machine
-spec start_link(
    Module :: module(), Args :: term(), Opts :: [start_opt()]) ->
           start_ret().
start_link(Module, Args, Opts) ->
    gen:start(?MODULE, link, Module, Args, Opts).
%%
-spec start_link(
    ServerName :: server_name(),
    Module :: module(), Args :: term(), Opts :: [start_opt()]) ->
           start_ret().
start_link(ServerName, Module, Args, Opts) ->
    gen:start(?MODULE, link, ServerName, Module, Args, Opts).

-ifdef(POST_OTP_17).
%% Stop a state machine
-spec stop(ServerRef :: server_ref()) -> ok.
stop(ServerRef) ->
    gen:stop(ServerRef).
%%
-spec stop(
    ServerRef :: server_ref(),
    Reason :: term(),
    Timeout :: timeout()) -> ok.
stop(ServerRef, Reason, Timeout) ->
    gen:stop(ServerRef, Reason, Timeout).
-endif.

%% Send an event to a state machine that arrives with type 'event'
-spec cast(ServerRef :: server_ref(), Msg :: term()) -> ok.
cast({global,Name}, Msg) ->
    try    global:send(Name, wrap_cast(Msg)) of
    _ -> ok
    catch
    _:_ -> ok
    end;
cast({via,RegMod,Name}, Msg) ->
    try    RegMod:send(Name, wrap_cast(Msg)) of
    _ -> ok
    catch
    _:_ -> ok
    end;
cast({Name,Node} = ServerRef, Msg) when is_atom(Name), is_atom(Node) ->
    send(ServerRef, wrap_cast(Msg));
cast(ServerRef, Msg) when is_atom(ServerRef) ->
    send(ServerRef, wrap_cast(Msg));
cast(ServerRef, Msg) when is_pid(ServerRef) ->
    send(ServerRef, wrap_cast(Msg)).

%% Call a state machine (synchronous; a reply is expected) that
%% arrives with type {call,From}
-spec call(ServerRef :: server_ref(), Request :: term()) -> Reply :: term().
call(ServerRef, Request) ->
    call(ServerRef, Request, infinity).
%%
-spec call(
    ServerRef :: server_ref(),
    Request :: term(),
    Timeout ::
      timeout() |
      {'clean_timeout',T :: timeout()} |
      {'dirty_timeout',T :: timeout()}) ->
          Reply :: term().
call(ServerRef, Request, Timeout) ->
    case parse_timeout(Timeout) of
    {dirty_timeout,T} ->
        try gen:call(ServerRef, '$gen_call', Request, T) of
        {ok,Reply} ->
            Reply
        catch
        Class:Reason ->
            erlang:raise(
              Class,
              {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}},
              erlang:get_stacktrace())
        end;
    {clean_timeout,T} ->
        %% Call server through proxy process to dodge any late reply
        Ref = make_ref(),
        Self = self(),
        Pid = spawn(
            fun () ->
                Self !
                try gen:call(
                      ServerRef, '$gen_call', Request, T) of
                    Result ->
                    {Ref,Result}
                catch Class:Reason ->
                    {Ref,Class,Reason,
                     erlang:get_stacktrace()}
                end
            end),
        Mref = monitor(process, Pid),
        receive
        {Ref,Result} ->
            demonitor(Mref, [flush]),
            case Result of
            {ok,Reply} ->
                Reply
            end;
        {Ref,Class,Reason,Stacktrace} ->
            demonitor(Mref, [flush]),
            erlang:raise(
              Class,
              {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}},
              Stacktrace);
        {'DOWN',Mref,_,_,Reason} ->
            %% There is a theoretical possibility that the
            %% proxy process gets killed between try--of and !
            %% so this clause is in case of that
            exit(Reason)
        end;
    Error when is_atom(Error) ->
        erlang:error(Error, [ServerRef,Request,Timeout])
    end.

parse_timeout(Timeout) ->
    case Timeout of
    {clean_timeout,infinity} ->
        {dirty_timeout,infinity};
    {clean_timeout,_} ->
        Timeout;
    {dirty_timeout,_} ->
        Timeout;
    {_,_} ->
        %% Be nice and throw a badarg for speling errors
        badarg;
    infinity ->
        {dirty_timeout,infinity};
    T ->
        {clean_timeout,T}
    end.

%% Reply from a state machine callback to whom awaits in call/2
-spec reply([reply_action()] | reply_action()) -> ok.
reply({reply,From,Reply}) ->
    reply(From, Reply);
reply(Replies) when is_list(Replies) ->
    replies(Replies).
%%
-spec reply(From :: from(), Reply :: term()) -> ok.
reply({To,Tag}, Reply) when is_pid(To) ->
    Msg = {Tag,Reply},
    try To ! Msg of
    _ ->
        ok
    catch
    _:_ -> ok
    end.

%% Instead of starting the state machine through start/3,4
%% or start_link/3,4 turn the current process presumably
%% started by proc_lib into a state machine using
%% the same arguments as you would have returned from init/1
-spec enter_loop(
    Module :: module(), Opts :: [debug_opt()],
    State :: state(), Data :: data()) ->
            no_return().
enter_loop(Module, Opts, State, Data) ->
    enter_loop(Module, Opts, State, Data, self()).
%%
-spec enter_loop(
    Module :: module(), Opts :: [debug_opt()],
    State :: state(), Data :: data(),
    Server_or_Actions ::
      server_name() | pid() | [action()]) ->
            no_return().
enter_loop(Module, Opts, State, Data, Server_or_Actions) ->
    if
    is_list(Server_or_Actions) ->
        enter_loop(Module, Opts, State, Data, self(), Server_or_Actions);
    true ->
        enter_loop(Module, Opts, State, Data, Server_or_Actions, [])
    end.
%%
-spec enter_loop(
    Module :: module(), Opts :: [debug_opt()],
    State :: state(), Data :: data(),
    Server :: server_name() | pid(),
    Actions :: [action()] | action()) ->
            no_return().
enter_loop(Module, Opts, State, Data, Server, Actions) ->
    is_atom(Module) orelse error({atom,Module}),
    Parent = locus_gen_compat:get_parent(),
    enter(Module, Opts, State, Data, Server, Actions, Parent).

%%---------------------------------------------------------------------------
%% API helpers

wrap_cast(Event) ->
    {'$gen_cast',Event}.

replies([{reply,From,Reply}|Replies]) ->
    reply(From, Reply),
    replies(Replies);
replies([]) ->
    ok.

%% Might actually not send the message in case of caught exception
send(Proc, Msg) ->
    try erlang:send(Proc, Msg, [noconnect]) of
    noconnect ->
        _ = spawn(erlang, send, [Proc,Msg]),
        ok;
    ok ->
        ok
    catch
    _:_ ->
        ok
    end.

%% Here the init_it/6 and enter_loop/5,6,7 functions converge
enter(Module, Opts, State, Data, Server, Actions, Parent) ->
    %% The values should already have been type checked
    Name = locus_gen_compat:get_proc_name(Server),
    Debug = locus_gen_compat:debug_options(Name, Opts),
    Events = [],
    P = [],
    Event = {internal,init_state},
    %% We enforce {postpone,false} to ensure that
    %% our fake Event gets discarded, thought it might get logged
    NewActions =
    if
        is_list(Actions) ->
        Actions ++ [{postpone,false}];
        true ->
        [Actions,{postpone,false}]
    end,
    TimerRefs = #{},
    %% Key: timer ref
    %% Value: the timer type i.e the timer's event type
    %%
    TimerTypes = #{},
    %% Key: timer type i.e the timer's event type
    %% Value: timer ref
    %%
    %% We add a timer to both timer_refs and timer_types
    %% when we start it.  When we request an asynchronous
    %% timer cancel we remove it from timer_types.  When
    %% the timer cancel message arrives we remove it from
    %% timer_refs.
    %%
    Hibernate = false,
    CancelTimers = 0,
    S =    #{
      callback_mode => undefined,
      state_enter => false,
      module => Module,
      name => Name,
      state => State,
      data => Data,
      postponed => P,
      %%
      %% The following fields are finally set from to the arguments to
      %% loop_event_actions/9 when it finally loops back to loop/3
      %% in loop_event_result/11
      timer_refs => TimerRefs,
      timer_types => TimerTypes,
      hibernate => Hibernate,
      cancel_timers => CancelTimers
     },
    NewDebug = sys_debug(Debug, S, State, {enter,Event,State}),
    case call_callback_mode(S) of
    {ok,NewS} ->
        loop_event_actions(
          Parent, NewDebug, NewS,
          Events, Event, State, Data, NewActions, true);
    {Class,Reason,Stacktrace} ->
        terminate(
          Class, Reason, Stacktrace, NewDebug,
          S, [Event|Events])
    end.

%%%==========================================================================
%%%  gen callbacks

-ifdef(POST_OTP_18).
-dialyzer({nowarn_function, init_it/6}).
-endif.
-spec init_it(pid(),_,pid() | {'global',atom()} | {'local',atom()} | {'via',atom() | tuple(),_},_,_,_) -> any().
init_it(Starter, self, ServerRef, Module, Args, Opts) ->
    init_it(Starter, self(), ServerRef, Module, Args, Opts);
init_it(Starter, Parent, ServerRef, Module, Args, Opts) ->
    try Module:init(Args) of
    Result ->
        init_result(Starter, Parent, ServerRef, Module, Result, Opts)
    catch
    Result ->
        init_result(Starter, Parent, ServerRef, Module, Result, Opts);
    Class:Reason ->
        Stacktrace = erlang:get_stacktrace(),
        Name = locus_gen_compat:get_proc_name(ServerRef),
        locus_gen_compat:unregister_name(ServerRef),
        proc_lib:init_ack(Starter, {error,Reason}),
        error_info(
          Class, Reason, Stacktrace,
          #{name => Name,
        callback_mode => undefined,
        state_enter => false},
          [], [], undefined),
        erlang:raise(Class, Reason, Stacktrace)
    end.

%%---------------------------------------------------------------------------
%% gen callbacks helpers

init_result(Starter, Parent, ServerRef, Module, Result, Opts) ->
    case Result of
    {ok,State,Data} ->
        proc_lib:init_ack(Starter, {ok,self()}),
        enter(Module, Opts, State, Data, ServerRef, [], Parent);
    {ok,State,Data,Actions} ->
        proc_lib:init_ack(Starter, {ok,self()}),
        enter(Module, Opts, State, Data, ServerRef, Actions, Parent);
    {stop,Reason} ->
        locus_gen_compat:unregister_name(ServerRef),
        proc_lib:init_ack(Starter, {error,Reason}),
        exit(Reason);
    ignore ->
        locus_gen_compat:unregister_name(ServerRef),
        proc_lib:init_ack(Starter, ignore),
        exit(normal);
    _ ->
        Name = locus_gen_compat:get_proc_name(ServerRef),
        locus_gen_compat:unregister_name(ServerRef),
        Error = {bad_return_from_init,Result},
        proc_lib:init_ack(Starter, {error,Error}),
        error_info(
          error, Error, ?STACKTRACE(),
          #{name => Name,
        callback_mode => undefined,
        state_enter => false},
          [], [], undefined),
        exit(Error)
    end.

%%%==========================================================================
%%% sys callbacks

-ifdef(POST_OTP_18).
-dialyzer({nowarn_function, system_continue/3}).
-endif.
-spec system_continue(_,_,#{}) -> any().
system_continue(Parent, Debug, S) ->
    loop(Parent, Debug, S).

-ifdef(POST_OTP_18).
-dialyzer({nowarn_function, system_terminate/4}).
-endif.
-spec system_terminate(_,_,[sys:dbg_opt()],#{}) -> any().
system_terminate(Reason, _Parent, Debug, S) ->
    terminate(exit, Reason, ?STACKTRACE(), Debug, S, []).

-ifdef(POST_OTP_18).
-dialyzer({nowarn_function, system_code_change/4}).
-endif.
-spec system_code_change(#{},_,_,_) -> any().
system_code_change(
  #{module := Module,
    state := State,
    data := Data} = S,
  _Mod, OldVsn, Extra) ->
    case
    try Module:code_change(OldVsn, State, Data, Extra)
    catch
        Result -> Result
    end
    of
    {ok,NewState,NewData} ->
        {ok,
         S#{callback_mode := undefined,
        state := NewState,
        data := NewData}};
    {ok,_} = Error ->
        error({case_clause,Error});
    Error ->
        Error
    end.

-ifdef(POST_OTP_18).
-dialyzer({nowarn_function, system_get_state/1}).
-endif.
-spec system_get_state(#{}) -> {'ok',{_,_}}.
system_get_state(#{state := State, data := Data}) ->
    {ok,{State,Data}}.

-ifdef(POST_OTP_18).
-dialyzer({nowarn_function, system_replace_state/2}).
-endif.
-spec system_replace_state(fun((_) -> any()),#{}) -> {'ok',{_,_},#{}}.
system_replace_state(
  StateFun,
  #{state := State,
    data := Data} = S) ->
    {NewState,NewData} = Result = StateFun({State,Data}),
    {ok,Result,S#{state := NewState, data := NewData}}.

-ifdef(POST_OTP_18).
-dialyzer({nowarn_function, format_status/2}).
-endif.
-spec format_status(_,[any(),...]) -> nonempty_maybe_improper_list().
format_status(
  Opt,
  [PDict,SysState,Parent,Debug,
   #{name := Name, postponed := P} = S]) ->
    Header = gen:format_status_header("Status for state machine", Name),
    Log = sys:get_debug(log, Debug, []),
    [{header,Header},
     {data,
      [{"Status",SysState},
       {"Parent",Parent},
       {"Logged Events",Log},
       {"Postponed",P}]} |
     case format_status(Opt, PDict, S) of
     L when is_list(L) -> L;
     T -> [T]
     end].

%%---------------------------------------------------------------------------
%% Format debug messages.  Print them as the call-back module sees
%% them, not as the real erlang messages.  Use trace for that.
%%---------------------------------------------------------------------------

print_event(Dev, {in,Event}, {Name,State}) ->
    io:format(
      Dev, "*DBG* ~p receive ~s in state ~p~n",
      [Name,event_string(Event),State]);
print_event(Dev, {out,Reply,{To,_Tag}}, {Name,State}) ->
    io:format(
      Dev, "*DBG* ~p send ~p to ~p from state ~p~n",
      [Name,Reply,To,State]);
print_event(Dev, {terminate,Reason}, {Name,State}) ->
    io:format(
      Dev, "*DBG* ~p terminate ~p in state ~p~n",
      [Name,Reason,State]);
print_event(Dev, {Tag,Event,NextState}, {Name,State}) ->
    StateString =
    case NextState of
        State ->
        io_lib:format("~p", [State]);
        _ ->
        io_lib:format("~p => ~p", [State,NextState])
    end,
    io:format(
      Dev, "*DBG* ~p ~w ~s in state ~s~n",
      [Name,Tag,event_string(Event),StateString]).

event_string(Event) ->
    case Event of
    {{call,{Pid,_Tag}},Request} ->
        io_lib:format("call ~p from ~w", [Request,Pid]);
    {EventType,EventContent} ->
        io_lib:format("~w ~p", [EventType,EventContent])
    end.

sys_debug(Debug, #{name := Name}, State, Entry) ->
    case Debug of
    [] ->
        Debug;
    _ ->
        sys:handle_debug(
          Debug, fun print_event/3, {Name,State}, Entry)
    end.

%%%==========================================================================
%%% Internal callbacks

-spec wakeup_from_hibernate(_,_,#{}) -> any().
wakeup_from_hibernate(Parent, Debug, S) ->
    %% It is a new message that woke us up so we have to receive it now
    loop_receive(Parent, Debug, S).

%%%==========================================================================
%%% State Machine engine implementation of proc_lib/gen server

%% Server loop, consists of all loop* functions
%% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3

%% Entry point for system_continue/3
loop(Parent, Debug, #{hibernate := true, cancel_timers := 0} = S) ->
    loop_hibernate(Parent, Debug, S);
loop(Parent, Debug, S) ->
    loop_receive(Parent, Debug, S).

-spec loop_hibernate(pid(), term(), #{}) -> no_return().
loop_hibernate(Parent, Debug, S) ->
    %% Does not return but restarts process at
    %% wakeup_from_hibernate/3 that jumps to loop_receive/3
    proc_lib:hibernate(
      ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]),
    error(
      {should_not_have_arrived_here_but_instead_in,
       {wakeup_from_hibernate,3}}).

%% Entry point for wakeup_from_hibernate/3
loop_receive(Parent, Debug, S) ->
    receive
    Msg ->
        case Msg of
        {system,Pid,Req} ->
            #{hibernate := Hibernate} = S,
            %% Does not return but tail recursively calls
            %% system_continue/3 that jumps to loop/3
            sys:handle_system_msg(
              Req, Pid, Parent, ?MODULE, Debug, S,
              Hibernate);
        {'EXIT',Parent,Reason} = EXIT ->
            %% EXIT is not a 2-tuple therefore
            %% not an event but this will stand out
            %% in the crash report...
            Q = [EXIT],
            terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q);
        {timeout,TimerRef,TimerMsg} ->
            #{timer_refs := TimerRefs,
              timer_types := TimerTypes,
              hibernate := Hibernate} = S,
            case maps:find(TimerRef, TimerRefs) of
            {ok, TimerType} ->
                %% We know of this timer; is it a running
                %% timer or a timer being cancelled that
                %% managed to send a late timeout message?
                case maps:find(TimerType, TimerTypes) of
                {ok, TimerRef} ->
                    %% The timer type maps back to this
                    %% timer ref, so it was a running timer
                    Event = {TimerType,TimerMsg},
                    %% Unregister the triggered timeout
                    NewTimerRefs =
                    maps:remove(TimerRef, TimerRefs),
                    NewTimerTypes =
                    maps:remove(TimerType, TimerTypes),
                    loop_receive_result(
                      Parent, Debug,
                      S#{
                    timer_refs := NewTimerRefs,
                    timer_types := NewTimerTypes},
                      Hibernate,
                      Event);
                _ ->
                    %% This was a late timeout message
                    %% from timer being cancelled, so
                    %% ignore it and expect a cancel_timer
                    %% msg shortly
                    loop_receive(Parent, Debug, S)
                end;
            _ ->
                %% Not our timer; present it as an event
                Event = {info,Msg},
                loop_receive_result(
                  Parent, Debug, S, Hibernate, Event)
            end;
        {cancel_timer,TimerRef,_} ->
            #{timer_refs := TimerRefs,
              cancel_timers := CancelTimers,
              hibernate := Hibernate} = S,
            case maps:is_key(TimerRef, TimerRefs) of
            true ->
                %% We must have requested a cancel
                %% of this timer so it is already
                %% removed from TimerTypes
                NewTimerRefs =
                maps:remove(TimerRef, TimerRefs),
                NewCancelTimers = CancelTimers - 1,
                NewS =
                S#{
                  timer_refs := NewTimerRefs,
                  cancel_timers := NewCancelTimers},
                if
                Hibernate =:= true, NewCancelTimers =:= 0 ->
                    %% No more cancel_timer msgs to expect;
                    %% we can hibernate
                    loop_hibernate(Parent, Debug, NewS);
                NewCancelTimers >= 0 -> % Assert
                    loop_receive(Parent, Debug, NewS)
                end;
            _ ->
                %% Not our cancel_timer msg;
                %% present it as an event
                Event = {info,Msg},
                loop_receive_result(
                  Parent, Debug, S, Hibernate, Event)
            end;
        _ ->
            %% External msg
            #{hibernate := Hibernate} = S,
            Event =
            case Msg of
                {'$gen_call',From,Request} ->
                {{call,From},Request};
                {'$gen_cast',E} ->
                {cast,E};
                _ ->
                {info,Msg}
            end,
            loop_receive_result(
              Parent, Debug, S, Hibernate, Event)
        end
    end.

loop_receive_result(
  Parent, Debug,
  #{state := State,
    timer_types := TimerTypes, cancel_timers := CancelTimers} = S,
  Hibernate, Event) ->
    %% From now the 'hibernate' field in S is invalid
    %% and will be restored when looping back
    %% in loop_event_result/11
    NewDebug = sys_debug(Debug, S, State, {in,Event}),
    %% Here is the queue of not yet handled events created
    Events = [],
    %% Cancel any running event timer
    case
    cancel_timer_by_type(timeout, TimerTypes, CancelTimers)
    of
    {_,CancelTimers} ->
        %% No timer cancelled
        loop_event(Parent, NewDebug, S, Events, Event, Hibernate);
    {NewTimerTypes,NewCancelTimers} ->
        %% The timer is removed from NewTimerTypes but
        %% remains in TimerRefs until we get
        %% the cancel_timer msg
        NewS =
        S#{
          timer_types := NewTimerTypes,
          cancel_timers := NewCancelTimers},
        loop_event(Parent, NewDebug, NewS, Events, Event, Hibernate)
    end.

%% Entry point for handling an event, received or enqueued
loop_event(
  Parent, Debug,
  #{state := State, data := Data} = S,
  Events, {Type,Content} = Event, Hibernate) ->
    %%
    %% If (this old) Hibernate is true here it can only be
    %% because it was set from an event action
    %% and we did not go into hibernation since there were
    %% events in queue, so we do what the user
    %% might rely on i.e collect garbage which
    %% would have happened if we actually hibernated
    %% and immediately was awakened
    Hibernate andalso garbage_collect(),
    case call_state_function(S, Type, Content, State, Data) of
    {ok,Result,NewS} ->
        {NextState,NewData,Actions,EnterCall} =
        parse_event_result(
          true, Debug, NewS,
          Events, Event, State, Data, Result),
        loop_event_actions(
          Parent, Debug, NewS,
          Events, Event, NextState, NewData, Actions, EnterCall);
    {Class,Reason,Stacktrace} ->
        terminate(
          Class, Reason, Stacktrace, Debug, S,
          [Event|Events])
    end.

loop_event_actions(
  Parent, Debug,
  #{state := State, state_enter := StateEnter} = S,
  Events, Event, NextState, NewData,
  Actions, EnterCall) ->
    %% Hibernate is reborn here as false being
    %% the default value from parse_actions/4
    case parse_actions(Debug, S, State, Actions) of
    {ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} ->
        if
        StateEnter, EnterCall ->
            loop_event_enter(
              Parent, NewDebug, S,
              Events, Event, NextState, NewData,
              Hibernate, TimeoutsR, Postpone, NextEventsR);
        true ->
            loop_event_result(
              Parent, NewDebug, S,
              Events, Event, NextState, NewData,
              Hibernate, TimeoutsR, Postpone, NextEventsR)
        end;
    {Class,Reason,Stacktrace} ->
        terminate(
          Class, Reason, Stacktrace, Debug, S,
          [Event|Events])
    end.

loop_event_enter(
  Parent, Debug, #{state := State} = S,
  Events, Event, NextState, NewData,
  Hibernate, TimeoutsR, Postpone, NextEventsR) ->
    case call_state_function(S, enter, State, NextState, NewData) of
    {ok,Result,NewS} ->
        case parse_event_result(
           false, Debug, NewS,
           Events, Event, NextState, NewData, Result) of
        {_,NewerData,Actions,EnterCall} ->
            loop_event_enter_actions(
              Parent, Debug, NewS,
              Events, Event, NextState, NewerData,
              Hibernate, TimeoutsR, Postpone, NextEventsR,
              Actions, EnterCall)
        end;
    {Class,Reason,Stacktrace} ->
        terminate(
          Class, Reason, Stacktrace, Debug,
          S#{
        state := NextState,
        data := NewData,
        hibernate := Hibernate},
          [Event|Events])
    end.

loop_event_enter_actions(
  Parent, Debug, #{state_enter := StateEnter} = S,
  Events, Event, NextState, NewData,
  Hibernate, TimeoutsR, Postpone, NextEventsR,
  Actions, EnterCall) ->
    case
    parse_enter_actions(
      Debug, S, NextState, Actions, Hibernate, TimeoutsR)
    of
    {ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} ->
        if
        StateEnter, EnterCall ->
            loop_event_enter(
              Parent, NewDebug, S,
              Events, Event, NextState, NewData,
              NewHibernate, NewTimeoutsR, Postpone, NextEventsR);
        true ->
            loop_event_result(
              Parent, NewDebug, S,
              Events, Event, NextState, NewData,
              NewHibernate, NewTimeoutsR, Postpone, NextEventsR)
        end;
    {Class,Reason,Stacktrace} ->
        terminate(
          Class, Reason, Stacktrace, Debug,
          S#{
        state := NextState,
        data := NewData,
        hibernate := Hibernate},
          [Event|Events])
    end.

loop_event_result(
  Parent, Debug_0,
  #{state := State, postponed := P_0,
    timer_refs := TimerRefs_0, timer_types := TimerTypes_0,
    cancel_timers := CancelTimers_0} = S_0,
  Events_0, Event_0, NextState, NewData,
  Hibernate, TimeoutsR, Postpone, NextEventsR) ->
    %%
    %% All options have been collected and next_events are buffered.
    %% Do the actual state transition.
    %%
    {Debug_1,P_1} = % Move current event to postponed if Postpone
    case Postpone of
        true ->
        {sys_debug(Debug_0, S_0, State, {postpone,Event_0,State}),
         [Event_0|P_0]};
        false ->
        {sys_debug(Debug_0, S_0, State, {consume,Event_0,State}),
         P_0}
    end,
    {Events_1,P_2,{TimerTypes_1,CancelTimers_1}} =
    %% Move all postponed events to queue and cancel the
    %% state timeout if the state changes
    if
        NextState =:= State ->
        {Events_0,P_1,{TimerTypes_0,CancelTimers_0}};
        true ->
        {lists:reverse(P_1, Events_0),
         [],
         cancel_timer_by_type(
           state_timeout, TimerTypes_0, CancelTimers_0)}
            %% The state timer is removed from TimerTypes_1
            %% but remains in TimerRefs_0 until we get
            %% the cancel_timer msg
    end,
    {TimerRefs_2,TimerTypes_2,CancelTimers_2,TimeoutEvents} =
    %% Stop and start non-event timers
    parse_timers(TimerRefs_0, TimerTypes_1, CancelTimers_1, TimeoutsR),
    %% Place next events last in reversed queue
    Events_2R = lists:reverse(Events_1, NextEventsR),
    %% Enqueue immediate timeout events and start event timer
    Events_3R =    prepend_timeout_events(TimeoutEvents, Events_2R),
    S_1 =
    S_0#{
      state := NextState,
      data := NewData,
      postponed := P_2,
      timer_refs := TimerRefs_2,
      timer_types := TimerTypes_2,
      cancel_timers := CancelTimers_2,
      hibernate := Hibernate},
    case lists:reverse(Events_3R) of
    [] ->
        %% Get a new event
        loop(Parent, Debug_1, S_1);
    [Event|Events] ->
        %% Loop until out of enqueued events
        loop_event(Parent, Debug_1, S_1, Events, Event, Hibernate)
    end.


%%---------------------------------------------------------------------------
%% Server loop helpers

call_callback_mode(#{module := Module} = S) ->
    try Module:callback_mode() of
    CallbackMode ->
        callback_mode_result(S, CallbackMode)
    catch
    CallbackMode ->
        callback_mode_result(S, CallbackMode);
    Class:Reason ->
        {Class,Reason,erlang:get_stacktrace()}
    end.

callback_mode_result(S, CallbackMode) ->
    case
    parse_callback_mode(
      if
          is_atom(CallbackMode) ->
          [CallbackMode];
          true ->
          CallbackMode
      end, undefined, false)
    of
    {undefined,_} ->
        {error,
         {bad_return_from_callback_mode,CallbackMode},
         ?STACKTRACE()};
    {CBMode,StateEnter} ->
        {ok,
         S#{
           callback_mode := CBMode,
           state_enter := StateEnter}}
    end.

parse_callback_mode([], CBMode, StateEnter) ->
    {CBMode,StateEnter};
parse_callback_mode([H|T], CBMode, StateEnter) ->
    case callback_mode(H) of
    true ->
        parse_callback_mode(T, H, StateEnter);
    false ->
        case H of
        state_enter ->
            parse_callback_mode(T, CBMode, true);
        _ ->
            {undefined,StateEnter}
        end
    end;
parse_callback_mode(_, _CBMode, StateEnter) ->
    {undefined,StateEnter}.


call_state_function(
  #{callback_mode := undefined} = S, Type, Content, State, Data) ->
    case call_callback_mode(S) of
    {ok,NewS} ->
        call_state_function(NewS, Type, Content, State, Data);
    Error ->
        Error
    end;
call_state_function(
  #{callback_mode := CallbackMode, module := Module} = S,
  Type, Content, State, Data) ->
    try
    case CallbackMode of
        state_functions ->
        Module:State(Type, Content, Data);
        handle_event_function ->
        Module:handle_event(Type, Content, State, Data)
    end
    of
    Result ->
        {ok,Result,S}
    catch
    Result ->
        {ok,Result,S};
    Class:Reason ->
        {Class,Reason,erlang:get_stacktrace()}
    end.


%% Interpret all callback return variants
parse_event_result(
  AllowStateChange, Debug, S,
  Events, Event, State, Data, Result) ->
    case Result of
    stop ->
        terminate(
          exit, normal, ?STACKTRACE(), Debug,
          S#{state := State, data := Data},
          [Event|Events]);
    {stop,Reason} ->
        terminate(
          exit, Reason, ?STACKTRACE(), Debug,
          S#{state := State, data := Data},
          [Event|Events]);
    {stop,Reason,NewData} ->
        terminate(
          exit, Reason, ?STACKTRACE(), Debug,
          S#{state := State, data := NewData},
          [Event|Events]);
    %%
    {stop_and_reply,Reason,Replies} ->
        reply_then_terminate(
          exit, Reason, ?STACKTRACE(), Debug,
          S#{state := State, data := Data},
          [Event|Events], Replies);
    {stop_and_reply,Reason,Replies,NewData} ->
        reply_then_terminate(
          exit, Reason, ?STACKTRACE(), Debug,
          S#{state := State, data := NewData},
          [Event|Events], Replies);
    %%
    {next_state,State,NewData} ->
        {State,NewData,[],false};
    {next_state,NextState,NewData} when AllowStateChange ->
        {NextState,NewData,[],true};
    {next_state,State,NewData,Actions} ->
        {State,NewData,Actions,false};
    {next_state,NextState,NewData,Actions} when AllowStateChange ->
        {NextState,NewData,Actions,true};
    %%
    {keep_state,NewData} ->
        {State,NewData,[],false};
    {keep_state,NewData,Actions} ->
        {State,NewData,Actions,false};
    keep_state_and_data ->
        {State,Data,[],false};
    {keep_state_and_data,Actions} ->
        {State,Data,Actions,false};
    %%
    {repeat_state,NewData} ->
        {State,NewData,[],true};
    {repeat_state,NewData,Actions} ->
        {State,NewData,Actions,true};
    repeat_state_and_data ->
        {State,Data,[],true};
    {repeat_state_and_data,Actions} ->
        {State,Data,Actions,true};
    %%
    _ ->
        terminate(
          error,
          {bad_return_from_state_function,Result},
          ?STACKTRACE(), Debug,
          S#{state := State, data := Data},
          [Event|Events])
    end.


parse_enter_actions(Debug, S, State, Actions, Hibernate, TimeoutsR) ->
    Postpone = forbidden,
    NextEventsR = forbidden,
    parse_actions(
      Debug, S, State, listify(Actions),
      Hibernate, TimeoutsR, Postpone, NextEventsR).

parse_actions(Debug, S, State, Actions) ->
    Hibernate = false,
    TimeoutsR = [{timeout,infinity,infinity}], %% Will cancel event timer
    Postpone = false,
    NextEventsR = [],
    parse_actions(
      Debug, S, State, listify(Actions),
      Hibernate, TimeoutsR, Postpone, NextEventsR).
%%
parse_actions(
  Debug, _S, _State, [],
  Hibernate, TimeoutsR, Postpone, NextEventsR) ->
    {ok,Debug,Hibernate,TimeoutsR,Postpone,NextEventsR};
parse_actions(
  Debug, S, State, [Action|Actions],
  Hibernate, TimeoutsR, Postpone, NextEventsR) ->
    case Action of
    %% Actual actions
    {reply,From,Reply} ->
        case from(From) of
        true ->
            NewDebug = do_reply(Debug, S, State, From, Reply),
            parse_actions(
              NewDebug, S, State, Actions,
              Hibernate, TimeoutsR, Postpone, NextEventsR);
        false ->
            {error,
             {bad_action_from_state_function,Action},
             ?STACKTRACE()}
        end;
    %%
    %% Actions that set options
    {hibernate,NewHibernate} when is_boolean(NewHibernate) ->
        parse_actions(
          Debug, S, State, Actions,
          NewHibernate, TimeoutsR, Postpone, NextEventsR);
    hibernate ->
        NewHibernate = true,
        parse_actions(
          Debug, S, State, Actions,
          NewHibernate, TimeoutsR, Postpone, NextEventsR);
    %%
    {postpone,NewPostpone}
      when is_boolean(NewPostpone), Postpone =/= forbidden ->
        parse_actions(
          Debug, S, State, Actions,
          Hibernate, TimeoutsR, NewPostpone, NextEventsR);
    postpone when Postpone =/= forbidden ->
        NewPostpone = true,
        parse_actions(
          Debug, S, State, Actions,
          Hibernate, TimeoutsR, NewPostpone, NextEventsR);
    %%
    {next_event,Type,Content} ->
        case event_type(Type) of
        true when NextEventsR =/= forbidden ->
            NewDebug =
            sys_debug(Debug, S, State, {in,{Type,Content}}),
            parse_actions(
              NewDebug, S, State, Actions,
              Hibernate, TimeoutsR, Postpone,
              [{Type,Content}|NextEventsR]);
        _ ->
            {error,
             {bad_action_from_state_function,Action},
             ?STACKTRACE()}
        end;
    %%
    {state_timeout,_,_} = Timeout ->
        parse_actions_timeout(
          Debug, S, State, Actions,
          Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout);
    {timeout,_,_} = Timeout ->
        parse_actions_timeout(
          Debug, S, State, Actions,
          Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout);
    Time ->
        parse_actions_timeout(
          Debug, S, State, Actions,
          Hibernate, TimeoutsR, Postpone, NextEventsR, Time)
    end.

parse_actions_timeout(
  Debug, S, State, Actions,
  Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout) ->
    Time =
    case Timeout of
        {_,T,_} -> T;
        T -> T
    end,
    case validate_time(Time) of
    true ->
        parse_actions(
          Debug, S, State, Actions,
          Hibernate, [Timeout|TimeoutsR],
          Postpone, NextEventsR);
    false ->
        {error,
         {bad_action_from_state_function,Timeout},
         ?STACKTRACE()}
    end.

validate_time(Time) when is_integer(Time), Time >= 0 -> true;
validate_time(infinity) -> true;
validate_time(_) -> false.

%% Stop and start timers as well as create timeout zero events
%% and pending event timer
%%
%% Stop and start timers non-event timers
parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR) ->
    parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR, #{}, []).
%%
parse_timers(
  TimerRefs, TimerTypes, CancelTimers, [], _Seen, TimeoutEvents) ->
    {TimerRefs,TimerTypes,CancelTimers,TimeoutEvents};
parse_timers(
  TimerRefs, TimerTypes, CancelTimers, [Timeout|TimeoutsR],
  Seen, TimeoutEvents) ->
    case Timeout of
    {TimerType,Time,TimerMsg} ->
        parse_timers(
              TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
              Seen, TimeoutEvents,
              TimerType, Time, TimerMsg);
    Time ->
        parse_timers(
              TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
              Seen, TimeoutEvents,
              timeout, Time, Time)
    end.

parse_timers(
  TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
  Seen, TimeoutEvents,
  TimerType, Time, TimerMsg) ->
    case maps:is_key(TimerType, Seen) of
    true ->
        %% Type seen before - ignore
        parse_timers(
          TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
          Seen, TimeoutEvents);
    false ->
        %% Unseen type - handle
        NewSeen = maps:put(TimerType, true, Seen),
        case Time of
        infinity ->
            %% Cancel any running timer
            {NewTimerTypes,NewCancelTimers} =
            cancel_timer_by_type(
              TimerType, TimerTypes, CancelTimers),
            parse_timers(
              TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR,
              NewSeen, TimeoutEvents);
        0 ->
            %% Cancel any running timer
            {NewTimerTypes,NewCancelTimers} =
            cancel_timer_by_type(
              TimerType, TimerTypes, CancelTimers),
            %% Handle zero time timeouts later
            TimeoutEvent = {TimerType,TimerMsg},
            parse_timers(
              TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR,
              NewSeen, [TimeoutEvent|TimeoutEvents]);
        _ ->
            %% (Re)start the timer
            TimerRef =
            erlang:start_timer(Time, self(), TimerMsg),
            case maps:find(TimerType, TimerTypes) of
            {ok, OldTimerRef} ->
                %% Cancel the running timer
                cancel_timer(OldTimerRef),
                NewCancelTimers = CancelTimers + 1,
                %% Insert the new timer into
                %% both TimerRefs and TimerTypes
                parse_timers(
                  maps:put(TimerRef, TimerType, TimerRefs),
                  maps:put(TimerType, TimerRef, TimerTypes),
                  NewCancelTimers, TimeoutsR,
                  NewSeen, TimeoutEvents);
            _ ->
                parse_timers(
                  maps:put(TimerRef, TimerType, TimerRefs),
                  maps:put(TimerType, TimerRef, TimerTypes),
                  CancelTimers, TimeoutsR,
                  NewSeen, TimeoutEvents)
            end
        end
    end.

%% Enqueue immediate timeout events (timeout 0 events)
%%
%% Event timer timeout 0 events gets special treatment since
%% an event timer is cancelled by any received event,
%% so if there are enqueued events before the event timer
%% timeout 0 event - the event timer is cancelled hence no event.
%%
%% Other (state_timeout) timeout 0 events that are after
%% the event timer timeout 0 events are considered to
%% belong to timers that were started after the event timer
%% timeout 0 event fired, so they do not cancel the event timer.
%%
prepend_timeout_events([], EventsR) ->
    EventsR;
prepend_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) ->
    prepend_timeout_events(TimeoutEvents, [TimeoutEvent]);
prepend_timeout_events([{timeout,_}|TimeoutEvents], EventsR) ->
    prepend_timeout_events(TimeoutEvents, EventsR);
prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) ->
    %% Just prepend all others
    prepend_timeout_events(TimeoutEvents, [TimeoutEvent|EventsR]).



%%---------------------------------------------------------------------------
%% Server helpers

reply_then_terminate(
  Class, Reason, Stacktrace, Debug,
  #{state := State} = S, Q, Replies) ->
    do_reply_then_terminate(
      Class, Reason, Stacktrace, Debug,
      S, Q, listify(Replies), State).
%%
do_reply_then_terminate(
  Class, Reason, Stacktrace, Debug, S, Q, [], _State) ->
    terminate(Class, Reason, Stacktrace, Debug, S, Q);
do_reply_then_terminate(
  Class, Reason, Stacktrace, Debug, S, Q, [R|Rs], State) ->
    case R of
    {reply,{_To,_Tag}=From,Reply} ->
        NewDebug = do_reply(Debug, S, State, From, Reply),
        do_reply_then_terminate(
          Class, Reason, Stacktrace, NewDebug, S, Q, Rs, State);
    _ ->
        terminate(
          error,
          {bad_reply_action_from_state_function,R},
          ?STACKTRACE(),
          Debug, S, Q)
    end.

do_reply(Debug, S, State, From, Reply) ->
    reply(From, Reply),
    sys_debug(Debug, S, State, {out,Reply,From}).


terminate(
  Class, Reason, Stacktrace, Debug,
  #{module := Module, state := State, data := Data, postponed := P} = S,
  Q) ->
    case erlang:function_exported(Module, terminate, 3) of
    true ->
        try Module:terminate(Reason, State, Data) of
        _ -> ok
        catch
        _ -> ok;
        C:R ->
            ST = erlang:get_stacktrace(),
            error_info(
              C, R, ST, S, Q, P,
              format_status(terminate, get(), S)),
            sys:print_log(Debug),
            erlang:raise(C, R, ST)
        end;
    false ->
        ok
    end,
    _ =
    case Reason of
        normal ->
        sys_debug(Debug, S, State, {terminate,Reason});
        shutdown ->
        sys_debug(Debug, S, State, {terminate,Reason});
        {shutdown,_} ->
        sys_debug(Debug, S, State, {terminate,Reason});
        _ ->
        error_info(
          Class, Reason, Stacktrace, S, Q, P,
          format_status(terminate, get(), S)),
        sys:print_log(Debug)
    end,
    case Stacktrace of
    [] ->
        erlang:Class(Reason);
    _ ->
        erlang:raise(Class, Reason, Stacktrace)
    end.

error_info(
  Class, Reason, Stacktrace,
  #{name := Name,
    callback_mode := CallbackMode,
    state_enter := StateEnter},
  Q, P, FmtData) ->
    {FixedReason,FixedStacktrace} =
    case Stacktrace of
        [{M,F,Args,_}|ST]
          when Class =:= error, Reason =:= undef ->
        case code:is_loaded(M) of
            false ->
            {{'module could not be loaded',M},ST};
            _ ->
            Arity =
                if
                is_list(Args) ->
                    length(Args);
                is_integer(Args) ->
                    Args
                end,
            case erlang:function_exported(M, F, Arity) of
                true ->
                {Reason,Stacktrace};
                false ->
                {{'function not exported',{M,F,Arity}},
                 ST}
            end
        end;
        _ -> {Reason,Stacktrace}
    end,
    CBMode =
     case StateEnter of
         true ->
         [CallbackMode,state_enter];
         false ->
         CallbackMode
     end,
    error_logger:format(
      "** State machine ~p terminating~n" ++
      case Q of
          [] -> "";
          _ -> "** Last event = ~p~n"
      end ++
      "** When server state  = ~p~n" ++
      "** Reason for termination = ~w:~p~n" ++
      "** Callback mode = ~p~n" ++
      case Q of
          [_,_|_] -> "** Queued = ~p~n";
          _ -> ""
      end ++
      case P of
          [] -> "";
          _ -> "** Postponed = ~p~n"
      end ++
      case FixedStacktrace of
          [] -> "";
          _ -> "** Stacktrace =~n**  ~p~n"
      end,
      [Name |
       case Q of
       [] -> [];
       [Event|_] -> [Event]
       end] ++
      [FmtData,
       Class,FixedReason,
       CBMode] ++
      case Q of
          [_|[_|_] = Events] -> [Events];
          _ -> []
      end ++
      case P of
          [] -> [];
          _ -> [P]
      end ++
      case FixedStacktrace of
          [] -> [];
          _ -> [FixedStacktrace]
      end).


%% Call Module:format_status/2 or return a default value
format_status(
  Opt, PDict,
  #{module := Module, state := State, data := Data}) ->
    case erlang:function_exported(Module, format_status, 2) of
    true ->
        try Module:format_status(Opt, [PDict,State,Data])
        catch
        Result -> Result;
        _:_ ->
            format_status_default(
              Opt, State,
              atom_to_list(Module) ++ ":format_status/2 crashed")
        end;
    false ->
        format_status_default(Opt, State, Data)
    end.

%% The default Module:format_status/2
format_status_default(Opt, State, Data) ->
    StateData = {State,Data},
    case Opt of
    terminate ->
        StateData;
    _ ->
        [{data,[{"State",StateData}]}]
    end.

listify(Item) when is_list(Item) ->
    Item;
listify(Item) ->
    [Item].

%% Cancel timer if running, otherwise no op
%%
%% This is an asynchronous cancel so the timer is not really cancelled
%% until we get a cancel_timer msg i.e {cancel_timer,TimerRef,_}.
%% In the mean time we might get a timeout message.
%%
%% Remove the timer from TimerTypes.
%% When we get the cancel_timer msg we remove it from TimerRefs.
cancel_timer_by_type(TimerType, TimerTypes, CancelTimers) ->
    case maps:find(TimerType, TimerTypes) of
    {ok, TimerRef} ->
        cancel_timer(TimerRef),
        {maps:remove(TimerType, TimerTypes),CancelTimers + 1};
    _ ->
        {TimerTypes,CancelTimers}
    end.

-ifdef(POST_OTP_17).
cancel_timer(TimerRef) ->
    ok = erlang:cancel_timer(TimerRef, [{async,true}]).
-else.
cancel_timer(TimerRef) ->
    % one more dirty hack for retro compatibility - simulate VM behaviour
    Result = erlang:cancel_timer(TimerRef) ,
    self() ! {cancel_timer, TimerRef, Result},
    ok.
-endif.

-endif.