module Haskell.Debug.Adapter.State.DebugRun.Source where

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


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.GHCi as P
import qualified Haskell.Debug.Adapter.State.Utility as SU



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


-- |
--
app :: DAP.SourceRequest -> AppContext (Maybe StateTransit)
app :: SourceRequest -> AppContext (Maybe StateTransit)
app SourceRequest
req = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ErrMsg -> AppContext (Maybe StateTransit)
errHdl forall a b. (a -> b) -> a -> b
$ do

  let args :: SourceRequestArguments
args = SourceRequest -> SourceRequestArguments
DAP.argumentsSourceRequest SourceRequest
req
      dap :: ErrMsg
dap = ErrMsg
":dap-source "
      cmd :: ErrMsg
cmd = ErrMsg
dap forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ErrMsg
U.showDAP SourceRequestArguments
args
      dbg :: ErrMsg
dbg = ErrMsg
dap forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ErrMsg
show SourceRequestArguments
args

  ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
P.command ErrMsg
cmd
  ErrMsg -> ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.debugEV ErrMsg
_LOG_APP ErrMsg
dbg
  AppContext [ErrMsg]
P.expectPmpt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ErrMsg] -> StateT AppStores (ExceptT ErrMsg IO) ErrMsg
SU.takeDapResult forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
dapHdl

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

  where

    -- |
    --
    dapHdl :: String -> AppContext ()
    dapHdl :: ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
dapHdl ErrMsg
str = case forall a. Read a => ErrMsg -> Either ErrMsg a
R.readEither ErrMsg
str of
      Left ErrMsg
err -> ErrMsg -> AppContext (Maybe StateTransit)
errHdl ErrMsg
err  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Right (Left ErrMsg
err) -> ErrMsg -> AppContext (Maybe StateTransit)
errHdl ErrMsg
err forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Right (Right SourceResponseBody
body) -> do
        Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
        let res :: SourceResponse
res = SourceResponse
DAP.defaultSourceResponse {
            seqSourceResponse :: Int
DAP.seqSourceResponse = Int
resSeq
          , request_seqSourceResponse :: Int
DAP.request_seqSourceResponse = SourceRequest -> Int
DAP.seqSourceRequest SourceRequest
req
          , successSourceResponse :: Bool
DAP.successSourceResponse = Bool
True
          , bodySourceResponse :: SourceResponseBody
DAP.bodySourceResponse = SourceResponseBody
body
          }

        Response -> StateT AppStores (ExceptT ErrMsg IO) ()
U.addResponse forall a b. (a -> b) -> a -> b
$ SourceResponse -> Response
SourceResponse SourceResponse
res


    -- |
    --
    errHdl :: String -> AppContext (Maybe StateTransit)
    errHdl :: ErrMsg -> AppContext (Maybe StateTransit)
errHdl ErrMsg
msg = do
      ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
U.sendErrorEventLF ErrMsg
msg
      Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
      let res :: SourceResponse
res = SourceResponse
DAP.defaultSourceResponse {
          seqSourceResponse :: Int
DAP.seqSourceResponse = Int
resSeq
        , request_seqSourceResponse :: Int
DAP.request_seqSourceResponse = SourceRequest -> Int
DAP.seqSourceRequest SourceRequest
req
        , successSourceResponse :: Bool
DAP.successSourceResponse = Bool
False
        , messageSourceResponse :: ErrMsg
DAP.messageSourceResponse = ErrMsg
msg
        }

      Response -> StateT AppStores (ExceptT ErrMsg IO) ()
U.addResponse forall a b. (a -> b) -> a -> b
$ SourceResponse -> Response
SourceResponse SourceResponse
res
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing