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

module Haskell.Debug.Adapter.State.GHCiRun.ConfigurationDone where

import Control.Monad.IO.Class
import qualified System.Log.Logger as L
import Control.Monad.State
import Control.Lens


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 GHCiRunStateData DAP.ConfigurationDoneRequest where
  action :: AppState GHCiRunStateData
-> Request ConfigurationDoneRequest
-> AppContext (Maybe StateTransit)
action AppState GHCiRunStateData
_ (ConfigurationDoneRequest ConfigurationDoneRequest
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
"GHCiRunState ConfigurationDoneRequest called. " ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ ConfigurationDoneRequest -> ErrMsg
forall a. Show a => a -> ErrMsg
show ConfigurationDoneRequest
req
    ConfigurationDoneRequest -> AppContext (Maybe StateTransit)
app ConfigurationDoneRequest
req

-- |
--   @see https://github.com/Microsoft/vscode/issues/4902
--   @see https://microsoft.github.io/debug-adapter-protocol/overview
--
app :: DAP.ConfigurationDoneRequest -> AppContext (Maybe StateTransit)
app :: ConfigurationDoneRequest -> AppContext (Maybe StateTransit)
app ConfigurationDoneRequest
req = do

  -- U.sendConsoleEvent _DEBUG_START_MSG
  -- U.sendStdoutEvent _GHCI_PROMPT_HDA

  Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
  let res :: ConfigurationDoneResponse
res = ConfigurationDoneResponse
DAP.defaultConfigurationDoneResponse {
            seqConfigurationDoneResponse :: Int
DAP.seqConfigurationDoneResponse = Int
resSeq
          , request_seqConfigurationDoneResponse :: Int
DAP.request_seqConfigurationDoneResponse = ConfigurationDoneRequest -> Int
DAP.seqConfigurationDoneRequest ConfigurationDoneRequest
req
          , successConfigurationDoneResponse :: Bool
DAP.successConfigurationDoneResponse = 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
$ ConfigurationDoneResponse -> Response
ConfigurationDoneResponse ConfigurationDoneResponse
res

  -- launch response must be sent after configuration done response.
  Int
reqSeq <- Getting Int AppStores Int -> AppStores -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int AppStores Int
Lens' AppStores Int
launchReqSeqAppStores (AppStores -> Int)
-> StateT AppStores (ExceptT ErrMsg IO) AppStores -> AppContext Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT AppStores (ExceptT ErrMsg IO) AppStores
forall s (m :: * -> *). MonadState s m => m s
get
  Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
  let res :: LaunchResponse
res = LaunchResponse
DAP.defaultLaunchResponse {
            seqLaunchResponse :: Int
DAP.seqLaunchResponse         = Int
resSeq
          , request_seqLaunchResponse :: Int
DAP.request_seqLaunchResponse = Int
reqSeq
          , successLaunchResponse :: Bool
DAP.successLaunchResponse     = 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
$ LaunchResponse -> Response
LaunchResponse LaunchResponse
res

  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
GHCiRun_DebugRun

{-
-- |
--
--
_DEBUG_START_MSG :: String
_DEBUG_START_MSG = L.intercalate "\n" [
    ""
  , "  Now, ghci launched and configuration done."
  , "  Press F5 to start debugging."
  , "  Or modify source code. it will be loaded to ghci automatically."
  , " "
  ]
-}