{-# 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 (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 {
             supportsConfigurationDoneRequestInitializeResponseBody :: Bool
DAP.supportsConfigurationDoneRequestInitializeResponseBody  = Bool
True
           , supportsFunctionBreakpointsInitializeResponseBody :: Bool
DAP.supportsFunctionBreakpointsInitializeResponseBody       = Bool
True
           , supportsConditionalBreakpointsInitializeResponseBody :: Bool
DAP.supportsConditionalBreakpointsInitializeResponseBody    = Bool
True
           , supportsHitConditionalBreakpointsInitializeResponseBody :: Bool
DAP.supportsHitConditionalBreakpointsInitializeResponseBody = Bool
True
           , supportsEvaluateForHoversInitializeResponseBody :: Bool
DAP.supportsEvaluateForHoversInitializeResponseBody         = Bool
True
           , exceptionBreakpointFiltersInitializeResponseBody :: [ExceptionBreakpointsFilter]
DAP.exceptionBreakpointFiltersInitializeResponseBody        = [
             --    DAP.ExceptionBreakpointsFilter "break-on-error" "break-on-error" False
             --  , DAP.ExceptionBreakpointsFilter "break-on-exception" "break-on-exception" False
               ]
           , supportsStepBackInitializeResponseBody :: Bool
DAP.supportsStepBackInitializeResponseBody                  = Bool
False
           , supportsSetVariableInitializeResponseBody :: Bool
DAP.supportsSetVariableInitializeResponseBody               = Bool
False
           , supportsRestartFrameInitializeResponseBody :: Bool
DAP.supportsRestartFrameInitializeResponseBody              = Bool
False
           , supportsGotoTargetsRequestInitializeResponseBody :: Bool
DAP.supportsGotoTargetsRequestInitializeResponseBody        = Bool
False
           , supportsStepInTargetsRequestInitializeResponseBody :: Bool
DAP.supportsStepInTargetsRequestInitializeResponseBody      = Bool
False
           , supportsCompletionsRequestInitializeResponseBody :: Bool
DAP.supportsCompletionsRequestInitializeResponseBody        = Bool
True
           , supportsModulesRequestInitializeResponseBody :: Bool
DAP.supportsModulesRequestInitializeResponseBody            = Bool
False  -- no GUI on VSCode
           , additionalModuleColumnsInitializeResponseBody :: [ColumnDescriptor]
DAP.additionalModuleColumnsInitializeResponseBody           = []     -- no GUI on VSCode
           , supportsLogPointsInitializeResponseBody :: Bool
DAP.supportsLogPointsInitializeResponseBody                 = Bool
True
           , supportsTerminateRequestInitializeResponseBody :: Bool
DAP.supportsTerminateRequestInitializeResponseBody          = Bool
True
           }
      res :: InitializeResponse
res  = InitializeResponse
DAP.defaultInitializeResponse {
             seqInitializeResponse :: Int
DAP.seqInitializeResponse         = Int
resSeq
           , request_seqInitializeResponse :: Int
DAP.request_seqInitializeResponse = InitializeRequest -> Int
DAP.seqInitializeRequest InitializeRequest
req
           , successInitializeResponse :: Bool
DAP.successInitializeResponse     = Bool
True
           , bodyInitializeResponse :: InitializeResponseBody
DAP.bodyInitializeResponse        = InitializeResponseBody
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe StateTransit
forall a. Maybe a
Nothing