{-# 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 (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 {
            seqThreadsResponse :: Int
DAP.seqThreadsResponse = Int
resSeq
          , request_seqThreadsResponse :: Int
DAP.request_seqThreadsResponse = ThreadsRequest -> Int
DAP.seqThreadsRequest ThreadsRequest
req
          , successThreadsResponse :: Bool
DAP.successThreadsResponse = 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
$ ThreadsResponse -> Response
ThreadsResponse ThreadsResponse
res

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