-----------------------------------------------------------------------------
-- |
-- Module      :  DAP.Response
-- Copyright   :  (C) 2023 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Stability   :  experimental
-- Portability :  non-portable
----------------------------------------------------------------------------
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
----------------------------------------------------------------------------
module DAP.Response
  ( -- * Response message API
    sendAttachResponse
  , sendBreakpointLocationsResponse
  , sendCompletionsResponse
  , sendConfigurationDoneResponse
  , sendContinueResponse
  , sendDataBreakpointInfoResponse
  , sendDisassembleResponse
  , sendDisconnectResponse
  , sendEvaluateResponse
  , sendExceptionInfoResponse
  , sendGotoResponse
  , sendGotoTargetsResponse
  , sendInitializeResponse
  , sendLaunchResponse
  , sendLoadedSourcesResponse
  , sendModulesResponse
  , sendNextResponse
  , sendPauseResponse
  , sendReadMemoryResponse
  , sendRestartResponse
  , sendRestartFrameResponse
  , sendReverseContinueResponse
  , sendScopesResponse
  , sendSetBreakpointsResponse
  , sendSetDataBreakpointsResponse
  , sendSetExceptionBreakpointsResponse
  , sendSetExpressionResponse
  , sendSetFunctionBreakpointsResponse
  , sendSetInstructionBreakpointsResponse
  , sendSetVariableResponse
  , sendSourceResponse
  , sendStackTraceResponse
  , sendStepBackResponse
  , sendStepInResponse
  , sendStepInTargetsResponse
  , sendStepOutResponse
  , sendTerminateResponse
  , sendTerminateThreadsResponse
  , sendThreadsResponse
  , sendVariablesResponse
  , sendWriteMemoryResponse
  , sendRunInTerminalResponse
  , sendStartDebuggingResponse
  ) where
----------------------------------------------------------------------------
import           DAP.Adaptor
import           DAP.Types
----------------------------------------------------------------------------
-- | AttachResponse has no body by default
sendAttachResponse :: Adaptor app ()
sendAttachResponse :: forall app. Adaptor app ()
sendAttachResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | BreakpointLocationResponse has no body by default
sendBreakpointLocationsResponse
  :: [BreakpointLocation]
  -> Adaptor app ()
sendBreakpointLocationsResponse :: forall app. [BreakpointLocation] -> Adaptor app ()
sendBreakpointLocationsResponse
  = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall breakpoint. [breakpoint] -> Breakpoints breakpoint
Breakpoints
----------------------------------------------------------------------------
-- | 'SetDataBreakpointsResponse'
sendSetDataBreakpointsResponse
  :: [Breakpoint]
  -> Adaptor app ()
sendSetDataBreakpointsResponse :: forall app. [Breakpoint] -> Adaptor app ()
sendSetDataBreakpointsResponse
  = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall breakpoint. [breakpoint] -> Breakpoints breakpoint
Breakpoints
----------------------------------------------------------------------------
-- | BreakpointResponse has no body by default
sendSetBreakpointsResponse
  :: [Breakpoint]
  -> Adaptor app ()
sendSetBreakpointsResponse :: forall app. [Breakpoint] -> Adaptor app ()
sendSetBreakpointsResponse
  = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall breakpoint. [breakpoint] -> Breakpoints breakpoint
Breakpoints
----------------------------------------------------------------------------
-- | SetInstructionsBreakpointResponse has no body by default
sendSetInstructionBreakpointsResponse
  :: [Breakpoint]
  -> Adaptor app ()
sendSetInstructionBreakpointsResponse :: forall app. [Breakpoint] -> Adaptor app ()
sendSetInstructionBreakpointsResponse
  = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall breakpoint. [breakpoint] -> Breakpoints breakpoint
Breakpoints
----------------------------------------------------------------------------
-- | SetFunctionBreakpointResponse has no body by default
sendSetFunctionBreakpointsResponse
  :: [Breakpoint]
  -> Adaptor app ()
sendSetFunctionBreakpointsResponse :: forall app. [Breakpoint] -> Adaptor app ()
sendSetFunctionBreakpointsResponse
  = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall breakpoint. [breakpoint] -> Breakpoints breakpoint
Breakpoints
----------------------------------------------------------------------------
-- | SetExceptionBreakpointsResponse has no body by default
sendSetExceptionBreakpointsResponse
  :: [Breakpoint]
  -> Adaptor app ()
sendSetExceptionBreakpointsResponse :: forall app. [Breakpoint] -> Adaptor app ()
sendSetExceptionBreakpointsResponse
  = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall breakpoint. [breakpoint] -> Breakpoints breakpoint
Breakpoints
----------------------------------------------------------------------------
-- | ContinueResponse
sendContinueResponse
  :: ContinueResponse
  -> Adaptor app ()
sendContinueResponse :: forall app. ContinueResponse -> Adaptor app ()
sendContinueResponse ContinueResponse
continueResponse = do
  forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse (forall value app. ToJSON value => value -> Adaptor app ()
setBody ContinueResponse
continueResponse)
----------------------------------------------------------------------------
-- | ConfigurationDoneResponse
sendConfigurationDoneResponse
  :: Adaptor app ()
sendConfigurationDoneResponse :: forall app. Adaptor app ()
sendConfigurationDoneResponse = do
  forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | LaunchResponse
sendLaunchResponse
  :: Adaptor app ()
sendLaunchResponse :: forall app. Adaptor app ()
sendLaunchResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | RestartResponse
sendRestartResponse
  :: Adaptor app ()
sendRestartResponse :: forall app. Adaptor app ()
sendRestartResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | DisconnectResponse
sendDisconnectResponse
  :: Adaptor app ()
sendDisconnectResponse :: forall app. Adaptor app ()
sendDisconnectResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | TerminateResponse
sendTerminateResponse
  :: Adaptor app ()
sendTerminateResponse :: forall app. Adaptor app ()
sendTerminateResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | NextResponse
sendNextResponse
  :: Adaptor app ()
sendNextResponse :: forall app. Adaptor app ()
sendNextResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | StepInResponse
sendStepInResponse
  :: Adaptor app ()
sendStepInResponse :: forall app. Adaptor app ()
sendStepInResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | StepOutResponse
sendStepOutResponse
  :: Adaptor app ()
sendStepOutResponse :: forall app. Adaptor app ()
sendStepOutResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | StepBackResponse
sendStepBackResponse
  :: Adaptor app ()
sendStepBackResponse :: forall app. Adaptor app ()
sendStepBackResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | ReverseContinueResponse
sendReverseContinueResponse
  :: Adaptor app ()
sendReverseContinueResponse :: forall app. Adaptor app ()
sendReverseContinueResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | RestartFrameResponse
sendRestartFrameResponse
  :: Adaptor app ()
sendRestartFrameResponse :: forall app. Adaptor app ()
sendRestartFrameResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | InitializeReponse
sendInitializeResponse
  :: Adaptor app ()
sendInitializeResponse :: forall app. Adaptor app ()
sendInitializeResponse = do
  Capabilities
capabilities <- forall app. Adaptor app Capabilities
getServerCapabilities
  forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse (forall value app. ToJSON value => value -> Adaptor app ()
setBody Capabilities
capabilities)
----------------------------------------------------------------------------
-- | GotoResponse
sendGotoResponse
  :: Adaptor app ()
sendGotoResponse :: forall app. Adaptor app ()
sendGotoResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | GotoTargetsResponse
sendGotoTargetsResponse
  :: Adaptor app ()
sendGotoTargetsResponse :: forall app. Adaptor app ()
sendGotoTargetsResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | PauseResponse
sendPauseResponse
  :: Adaptor app ()
sendPauseResponse :: forall app. Adaptor app ()
sendPauseResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
-- | TerminateThreadsResponse
sendTerminateThreadsResponse
  :: Adaptor app ()
sendTerminateThreadsResponse :: forall app. Adaptor app ()
sendTerminateThreadsResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------
sendModulesResponse :: ModulesResponse -> Adaptor app ()
sendModulesResponse :: forall app. ModulesResponse -> Adaptor app ()
sendModulesResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendStackTraceResponse :: StackTraceResponse -> Adaptor app ()
sendStackTraceResponse :: forall app. StackTraceResponse -> Adaptor app ()
sendStackTraceResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendSourceResponse :: SourceResponse -> Adaptor app ()
sendSourceResponse :: forall app. SourceResponse -> Adaptor app ()
sendSourceResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendThreadsResponse :: [Thread] -> Adaptor app ()
sendThreadsResponse :: forall app. [Thread] -> Adaptor app ()
sendThreadsResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Thread] -> ThreadsResponse
ThreadsResponse
----------------------------------------------------------------------------
sendLoadedSourcesResponse :: [Source] -> Adaptor app ()
sendLoadedSourcesResponse :: forall app. [Source] -> Adaptor app ()
sendLoadedSourcesResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Source] -> LoadedSourcesResponse
LoadedSourcesResponse
----------------------------------------------------------------------------
sendWriteMemoryResponse :: WriteMemoryResponse -> Adaptor app ()
sendWriteMemoryResponse :: forall app. WriteMemoryResponse -> Adaptor app ()
sendWriteMemoryResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendReadMemoryResponse :: ReadMemoryResponse -> Adaptor app ()
sendReadMemoryResponse :: forall app. ReadMemoryResponse -> Adaptor app ()
sendReadMemoryResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendCompletionsResponse :: CompletionsResponse -> Adaptor app ()
sendCompletionsResponse :: forall app. CompletionsResponse -> Adaptor app ()
sendCompletionsResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendDataBreakpointInfoResponse :: DataBreakpointInfoResponse -> Adaptor app ()
sendDataBreakpointInfoResponse :: forall app. DataBreakpointInfoResponse -> Adaptor app ()
sendDataBreakpointInfoResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendDisassembleResponse :: DisassembleResponse -> Adaptor app ()
sendDisassembleResponse :: forall app. DisassembleResponse -> Adaptor app ()
sendDisassembleResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendEvaluateResponse :: EvaluateResponse -> Adaptor app ()
sendEvaluateResponse :: forall app. EvaluateResponse -> Adaptor app ()
sendEvaluateResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendExceptionInfoResponse :: ExceptionInfoResponse -> Adaptor app ()
sendExceptionInfoResponse :: forall app. ExceptionInfoResponse -> Adaptor app ()
sendExceptionInfoResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendScopesResponse :: ScopesResponse -> Adaptor app ()
sendScopesResponse :: forall app. ScopesResponse -> Adaptor app ()
sendScopesResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendSetExpressionResponse :: SetExpressionResponse -> Adaptor app ()
sendSetExpressionResponse :: forall app. SetExpressionResponse -> Adaptor app ()
sendSetExpressionResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendSetVariableResponse :: SetVariableResponse -> Adaptor app ()
sendSetVariableResponse :: forall app. SetVariableResponse -> Adaptor app ()
sendSetVariableResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendStepInTargetsResponse :: StepInTargetsResponse -> Adaptor app ()
sendStepInTargetsResponse :: forall app. StepInTargetsResponse -> Adaptor app ()
sendStepInTargetsResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendVariablesResponse :: VariablesResponse -> Adaptor app ()
sendVariablesResponse :: forall app. VariablesResponse -> Adaptor app ()
sendVariablesResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendRunInTerminalResponse :: RunInTerminalResponse -> Adaptor app ()
sendRunInTerminalResponse :: forall app. RunInTerminalResponse -> Adaptor app ()
sendRunInTerminalResponse = forall app. Adaptor app () -> Adaptor app ()
sendSuccesfulResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value app. ToJSON value => value -> Adaptor app ()
setBody
----------------------------------------------------------------------------
sendStartDebuggingResponse :: Adaptor app ()
sendStartDebuggingResponse :: forall app. Adaptor app ()
sendStartDebuggingResponse = forall app. Adaptor app ()
sendSuccesfulEmptyResponse
----------------------------------------------------------------------------