{-# 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

-- |
--  Any errors should be sent back as False result Response
--
instance StateActivityIF DebugRunStateData DAP.TerminateRequest where
  action :: AppState DebugRunStateData
-> Request TerminateRequest -> AppContext (Maybe StateTransit)
action AppState DebugRunStateData
_ (TerminateRequest TerminateRequest
req) = do
    IO () -> StateT AppStores (ExceptT ErrMsg IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT AppStores (ExceptT ErrMsg IO) ())
-> IO () -> StateT AppStores (ExceptT ErrMsg IO) ()
forall a b. (a -> b) -> a -> b
$ ErrMsg -> ErrMsg -> IO ()
L.debugM ErrMsg
_LOG_APP (ErrMsg -> IO ()) -> ErrMsg -> IO ()
forall a b. (a -> b) -> a -> b
$ ErrMsg
"DebugRunState TerminateRequest called. " ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ TerminateRequest -> ErrMsg
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 (Response -> StateT AppStores (ExceptT ErrMsg IO) ())
-> Response -> StateT AppStores (ExceptT ErrMsg IO) ()
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

  Maybe StateTransit -> AppContext (Maybe StateTransit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe StateTransit -> AppContext (Maybe StateTransit))
-> Maybe StateTransit -> AppContext (Maybe StateTransit)
forall a b. (a -> b) -> a -> b
$ StateTransit -> Maybe StateTransit
forall a. a -> Maybe a
Just StateTransit
DebugRun_Shutdown