{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Haskell.Debug.Adapter.State.Shutdown where

import Control.Monad.IO.Class
import Control.Monad.Except
import qualified System.Log.Logger as L

import Haskell.Debug.Adapter.Type
import Haskell.Debug.Adapter.Utility
import Haskell.Debug.Adapter.Constant


-- |
--
instance AppStateIF ShutdownStateData where
  -- |
  --
  entryAction :: AppState ShutdownStateData -> AppContext ()
entryAction AppState ShutdownStateData
ShutdownState = do
    IO () -> AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
L.debugM String
_LOG_APP String
"ShutdownState entryAction called."

    Event -> AppContext ()
addEvent Event
CriticalExitEvent

    () -> AppContext ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


  -- |
  --
  exitAction :: AppState ShutdownStateData -> AppContext ()
exitAction AppState ShutdownStateData
ShutdownState = do
    let msg :: String
msg = String
"ShutdownState exitAction must not be called."
    String -> AppContext ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
msg


  -- |
  --
  doActivity :: AppState ShutdownStateData
-> WrapRequest -> AppContext (Maybe StateTransit)
doActivity AppState ShutdownStateData
ShutdownState WrapRequest
_ = do
    let msg :: String
msg = String
"ShutdownState does not support any request."
    String -> String -> AppContext ()
infoEV String
_LOG_APP String
msg
    Maybe StateTransit -> AppContext (Maybe StateTransit)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StateTransit
forall a. Maybe a
Nothing