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

module Haskell.Debug.Adapter.State.DebugRun.Threads 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

-- |
--  Any errors should be sent back as False result Response
--
instance StateActivityIF DebugRunStateData DAP.ThreadsRequest where
  action :: AppState DebugRunStateData
-> Request ThreadsRequest -> AppContext (Maybe StateTransit)
action AppState DebugRunStateData
_ (ThreadsRequest ThreadsRequest
req) = do
    IO () -> StateT AppStores (ExceptT ErrMsg IO) ()
forall a. IO a -> StateT AppStores (ExceptT ErrMsg IO) a
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 ThreadsRequest called. " ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ ThreadsRequest -> ErrMsg
forall a. Show a => a -> ErrMsg
show ThreadsRequest
req
    ThreadsRequest -> AppContext (Maybe StateTransit)
app ThreadsRequest
req

-- |
--
app :: DAP.ThreadsRequest -> AppContext (Maybe StateTransit)
app :: ThreadsRequest -> AppContext (Maybe StateTransit)
app ThreadsRequest
req = do
  Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
  let res :: ThreadsResponse
res = ThreadsResponse
DAP.defaultThreadsResponse {
            DAP.seqThreadsResponse = resSeq
          , DAP.request_seqThreadsResponse = DAP.seqThreadsRequest req
          , DAP.successThreadsResponse = 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
$ ThreadsResponse -> Response
ThreadsResponse ThreadsResponse
res

  Maybe StateTransit -> AppContext (Maybe StateTransit)
forall a. a -> StateT AppStores (ExceptT ErrMsg IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StateTransit
forall a. Maybe a
Nothing