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

module Haskell.Debug.Adapter.State.Init.Initialize 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 Haskell.Debug.Adapter.Utility



-- |
--   Any errors should be critical. don't catch anything here.
--
instance StateActivityIF InitStateData DAP.InitializeRequest where
  action :: AppState InitStateData
-> Request InitializeRequest -> AppContext (Maybe StateTransit)
action AppState InitStateData
_ (InitializeRequest InitializeRequest
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
"InitState InitializeRequest called. " ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ InitializeRequest -> ErrMsg
forall a. Show a => a -> ErrMsg
show InitializeRequest
req
    InitializeRequest -> AppContext (Maybe StateTransit)
app InitializeRequest
req

-- |
--
app :: DAP.InitializeRequest -> AppContext (Maybe StateTransit)
app :: InitializeRequest -> AppContext (Maybe StateTransit)
app InitializeRequest
req = do
  ErrMsg -> ErrMsg -> StateT AppStores (ExceptT ErrMsg IO) ()
debugEV ErrMsg
_LOG_APP ErrMsg
"initialize request called."

  Int
resSeq <- AppContext Int
U.getIncreasedResponseSequence
  let capa :: InitializeResponseBody
capa = InitializeResponseBody
DAP.defaultInitializeResponseBody {
             DAP.supportsConfigurationDoneRequestInitializeResponseBody  = True
           , DAP.supportsFunctionBreakpointsInitializeResponseBody       = True
           , DAP.supportsConditionalBreakpointsInitializeResponseBody    = True
           , DAP.supportsHitConditionalBreakpointsInitializeResponseBody = True
           , DAP.supportsEvaluateForHoversInitializeResponseBody         = True
           , DAP.exceptionBreakpointFiltersInitializeResponseBody        = [
             --    DAP.ExceptionBreakpointsFilter "break-on-error" "break-on-error" False
             --  , DAP.ExceptionBreakpointsFilter "break-on-exception" "break-on-exception" False
               ]
           , DAP.supportsStepBackInitializeResponseBody                  = False
           , DAP.supportsSetVariableInitializeResponseBody               = False
           , DAP.supportsRestartFrameInitializeResponseBody              = False
           , DAP.supportsGotoTargetsRequestInitializeResponseBody        = False
           , DAP.supportsStepInTargetsRequestInitializeResponseBody      = False
           , DAP.supportsCompletionsRequestInitializeResponseBody        = True
           , DAP.supportsModulesRequestInitializeResponseBody            = False  -- no GUI on VSCode
           , DAP.additionalModuleColumnsInitializeResponseBody           = []     -- no GUI on VSCode
           , DAP.supportsLogPointsInitializeResponseBody                 = True
           , DAP.supportsTerminateRequestInitializeResponseBody          = True
           }
      res :: InitializeResponse
res  = InitializeResponse
DAP.defaultInitializeResponse {
             DAP.seqInitializeResponse         = resSeq
           , DAP.request_seqInitializeResponse = DAP.seqInitializeRequest req
           , DAP.successInitializeResponse     = True
           , DAP.bodyInitializeResponse        = capa
           }

  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
$ InitializeResponse -> Response
InitializeResponse InitializeResponse
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