{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Haskell.Debug.Adapter.State.DebugRun.Terminate where
import Control.Monad.IO.Class
import qualified System.Log.Logger as L
import qualified Haskell.DAP as DAP
import Haskell.Debug.Adapter.Type
import Haskell.Debug.Adapter.Constant
import qualified Haskell.Debug.Adapter.Utility as U
import qualified Haskell.Debug.Adapter.State.Utility as SU
instance StateActivityIF DebugRunStateData DAP.TerminateRequest where
action :: AppState DebugRunStateData
-> Request TerminateRequest -> AppContext (Maybe StateTransit)
action AppState DebugRunStateData
_ (TerminateRequest TerminateRequest
req) = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ErrMsg -> ErrMsg -> IO ()
L.debugM ErrMsg
_LOG_APP forall a b. (a -> b) -> a -> b
$ ErrMsg
"DebugRunState TerminateRequest called. " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ErrMsg
show TerminateRequest
req
TerminateRequest -> AppContext (Maybe StateTransit)
app TerminateRequest
req
app :: DAP.TerminateRequest -> AppContext (Maybe StateTransit)
app :: TerminateRequest -> AppContext (Maybe StateTransit)
app TerminateRequest
req = do
StateT AppStores (ExceptT ErrMsg IO) ()
SU.terminateGHCi
Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
let res :: TerminateResponse
res = TerminateResponse
DAP.defaultTerminateResponse {
seqTerminateResponse :: Int
DAP.seqTerminateResponse = Int
resSeq
, request_seqTerminateResponse :: Int
DAP.request_seqTerminateResponse = TerminateRequest -> Int
DAP.seqTerminateRequest TerminateRequest
req
, successTerminateResponse :: Bool
DAP.successTerminateResponse = Bool
True
}
Response -> StateT AppStores (ExceptT ErrMsg IO) ()
U.addResponse forall a b. (a -> b) -> a -> b
$ TerminateResponse -> Response
TerminateResponse TerminateResponse
res
StateT AppStores (ExceptT ErrMsg IO) ()
U.sendTerminatedEvent
StateT AppStores (ExceptT ErrMsg IO) ()
U.sendExitedEvent
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just StateTransit
DebugRun_Shutdown