{-|
Module      : Haskell.DAP
Description : Implementation of DAP interface data type.
Copyright   : 2017-2019 phoityne_hs
License     : BSD3

Implementation of DAP interface data type.

@see : https://microsoft.github.io/debug-adapter-protocol/

@see : https://github.com/Microsoft/vscode-debugadapter-node/blob/master/protocol/src/debugProtocol.ts

-}
module Haskell.DAP (

    -- * commons
    _THREAD_ID
  , Request(..)
  , defaultRequest
  , Response(..)
  , ColumnDescriptor(..)
  , Source(..)
  , defaultSource
  , Breakpoint(..)
  , defaultBreakpoint
  , ExceptionBreakpointsFilter(..)

    -- * initialize
  , InitializeRequest(..)
  , defaultInitializeRequest
  , InitializeRequestArguments(..)
  , defaultInitializeRequestArguments
  , InitializeResponse(..)
  , defaultInitializeResponse
  , InitializeResponseBody(..)
  , defaultInitializeResponseBody

    -- * disconnect
  , DisconnectRequest(..)
  , DisconnectRequestArguments(..)
  , DisconnectResponse(..)
  , defaultDisconnectResponse

    -- * pause
  , PauseRequest(..)
  , PauseRequestArguments(..)
  , PauseResponse(..)
  , defaultPauseResponse

    -- * terminate
  , TerminateRequest(..)
  , TerminateRequestArguments(..)
  , TerminateResponse(..)
  , defaultTerminateResponse

    -- * launch
  , LaunchRequest(..)
  , LaunchRequestArguments(..)
  , LaunchResponse(..)
  , defaultLaunchResponse

    -- * setBreakpoints
  , SourceBreakpoint(..)
  , SetBreakpointsRequest(..)
  , SetBreakpointsRequestArguments(..)
  , SetBreakpointsResponse(..)
  , SetBreakpointsResponseBody(..)
  , defaultSetBreakpointsResponse
  , defaultSetBreakpointsResponseBody

    -- * setFunctionBreakpoints
  , FunctionBreakpoint(..)
  , SetFunctionBreakpointsRequest(..)
  , SetFunctionBreakpointsRequestArguments(..)
  , SetFunctionBreakpointsResponse(..)
  , SetFunctionBreakpointsResponseBody(..)
  , defaultSetFunctionBreakpointsResponse
  , defaultSetFunctionBreakpointsResponseBody

    -- * setExceptionBreakpoints
  , SetExceptionBreakpointsRequest(..)
  , SetExceptionBreakpointsRequestArguments(..)
  , SetExceptionBreakpointsResponse(..)
  , defaultSetExceptionBreakpointsResponse

    -- * configurationDone
  , ConfigurationDoneRequest(..)
  , ConfigurationDoneResponse(..)
  , defaultConfigurationDoneResponse

    -- * threads
  , ThreadsRequest(..)
  , defaultThreadsResponse
  , Thread(..)
  , ThreadsResponse(..)
  , ThreadsResponseBody(..)
  , defaultThreadsResponseBody

    -- * stackTrace
  , StackTraceRequest(..)
  , StackTraceRequestArguments(..)
  , StackFrame(..)
  , defaultStackFrame
  , StackTraceResponse(..)
  , defaultStackTraceResponse
  , StackTraceResponseBody(..)
  , defaultStackTraceResponseBody

    -- * scopes
  , ScopesRequest(..)
  , ScopesRequestArguments(..)
  , Scope(..)
  , defaultScope
  , ScopesResponse(..)
  , defaultScopesResponse
  , ScopesResponseBody(..)
  , defaultScopesResponseBody

    -- * variables
  , VariablesRequest(..)
  , VariablesRequestArguments(..)
  , Variable(..)
  , defaultVariable
  , VariablePresentationHint(..)
  , VariablesResponse(..)
  , defaultVariablesResponse
  , VariablesResponseBody(..)
  , defaultVariablesResponseBody

    -- * continue
  , ContinueRequest(..)
  , ContinueRequestArguments(..)
  , defaultContinueRequestArguments
  , ContinueResponse(..)
  , defaultContinueResponse

    -- * next
  , NextRequest(..)
  , NextRequestArguments(..)
  , NextResponse(..)
  , defaultNextResponse

    -- * stepIn
  , StepInRequest(..)
  , StepInRequestArguments(..)
  , StepInResponse(..)
  , defaultStepInResponse

    -- * evaluate
  , EvaluateRequest(..)
  , EvaluateRequestArguments(..)
  , EvaluateResponse(..)
  , defaultEvaluateResponse
  , EvaluateResponseBody(..)
  , defaultEvaluateResponseBody

    -- * completions
  , CompletionsRequest(..)
  , CompletionsRequestArguments(..)
  , CompletionsItem(..)
  , CompletionsResponse(..)
  , defaultCompletionsResponse
  , CompletionsResponseBody(..)
  , defaultCompletionsResponseBody

    -- * event
  , OutputEvent(..)
  , defaultOutputEvent
  , OutputEventBody(..)
  , defaultOutputEventBody

  , InitializedEvent(..)
  , defaultInitializedEvent

  , TerminatedEvent(..)
  , defaultTerminatedEvent
  , TerminatedEventBody(..)
  , defaultTerminatedEventBody

  , ExitedEvent(..)
  , defaultExitedEvent
  , ExitedEventBody(..)
  , defaultExitedEventBody

  , ContinuedEvent(..)
  , defaultContinuedEvent
  , ContinuedEventBody(..)
  , defaultContinuedEventBody

  , StoppedEvent(..)
  , defaultStoppedEvent
  , StoppedEventBody(..)
  , defaultStoppedEventBody

) where

import qualified Data.Map as M


----------------------------------------------------------------------------
--  commons
----------------------------------------------------------------------------

-- |
--   The debugee thread id is fixed 0.
--
_THREAD_ID :: Int
_THREAD_ID :: Int
_THREAD_ID = Int
0


-- |
--   Client-initiated request
--
data Request =
  Request {
    Request -> Int
seqRequest       :: Int     -- ^Sequence number.
  , Request -> String
typeRequest      :: String  -- ^Message type. Values: 'request', 'response', 'event', etc.
  , Request -> String
commandRequest   :: String  -- ^The command to execute
  } deriving (Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show, ReadPrec [Request]
ReadPrec Request
Int -> ReadS Request
ReadS [Request]
(Int -> ReadS Request)
-> ReadS [Request]
-> ReadPrec Request
-> ReadPrec [Request]
-> Read Request
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Request]
$creadListPrec :: ReadPrec [Request]
readPrec :: ReadPrec Request
$creadPrec :: ReadPrec Request
readList :: ReadS [Request]
$creadList :: ReadS [Request]
readsPrec :: Int -> ReadS Request
$creadsPrec :: Int -> ReadS Request
Read, Request -> Request -> Bool
(Request -> Request -> Bool)
-> (Request -> Request -> Bool) -> Eq Request
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Request -> Request -> Bool
$c/= :: Request -> Request -> Bool
== :: Request -> Request -> Bool
$c== :: Request -> Request -> Bool
Eq)


-- |
--
defaultRequest :: Request
defaultRequest :: Request
defaultRequest = Request :: Int -> String -> String -> Request
Request {
    seqRequest :: Int
seqRequest     = Int
0
  , typeRequest :: String
typeRequest    = String
"request"
  , commandRequest :: String
commandRequest = String
""
  }


-- |
--  Response for a request.
--
data Response =
  Response {
    Response -> Int
seqResponse         :: Int     -- ^Sequence number.
  , Response -> String
typeResponse        :: String  -- ^Message type. Values: 'request', 'response', 'event', etc.
  , Response -> Int
request_seqResponse :: Int     -- ^Sequence number of the corresponding request.
  , Response -> Bool
successResponse     :: Bool    -- ^Outcome of the request.
  , Response -> String
commandResponse     :: String  -- ^The command requested.
  , Response -> String
messageResponse     :: String  -- ^Contains error message if success == false.
  } deriving (Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show, ReadPrec [Response]
ReadPrec Response
Int -> ReadS Response
ReadS [Response]
(Int -> ReadS Response)
-> ReadS [Response]
-> ReadPrec Response
-> ReadPrec [Response]
-> Read Response
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Response]
$creadListPrec :: ReadPrec [Response]
readPrec :: ReadPrec Response
$creadPrec :: ReadPrec Response
readList :: ReadS [Response]
$creadList :: ReadS [Response]
readsPrec :: Int -> ReadS Response
$creadsPrec :: Int -> ReadS Response
Read, Response -> Response -> Bool
(Response -> Response -> Bool)
-> (Response -> Response -> Bool) -> Eq Response
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Response -> Response -> Bool
$c/= :: Response -> Response -> Bool
== :: Response -> Response -> Bool
$c== :: Response -> Response -> Bool
Eq)


-- |
--   A ColumnDescriptor specifies what module attribute to show in a column of the ModulesView,
--
--   how to format it, and what the column's label should be.
--
--   It is only used if the underlying UI actually supports this level of customization.
--
data ColumnDescriptor =
  ColumnDescriptor {
    ColumnDescriptor -> String
attributeNameColumnDescriptor :: String        -- ^Name of the attribute rendered in this column.
  , ColumnDescriptor -> String
labelColumnDescriptor         :: String        -- ^Header UI label of column.
  , ColumnDescriptor -> Maybe String
formatColumnDescriptor        :: Maybe String  -- ^Format to use for the rendered values in this column. TBD how the format strings looks like.
  , ColumnDescriptor -> Maybe String
typeColumnDescriptor          :: Maybe String  -- ^Datatype of values in this column.  Defaults to 'string' if not specified. 'string' | 'number' | 'boolean' | 'unixTimestampUTC';
  , ColumnDescriptor -> Maybe Int
widthColumnDescriptor         :: Maybe Int     -- ^Width of this column in characters (hint only).
  } deriving (Int -> ColumnDescriptor -> ShowS
[ColumnDescriptor] -> ShowS
ColumnDescriptor -> String
(Int -> ColumnDescriptor -> ShowS)
-> (ColumnDescriptor -> String)
-> ([ColumnDescriptor] -> ShowS)
-> Show ColumnDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnDescriptor] -> ShowS
$cshowList :: [ColumnDescriptor] -> ShowS
show :: ColumnDescriptor -> String
$cshow :: ColumnDescriptor -> String
showsPrec :: Int -> ColumnDescriptor -> ShowS
$cshowsPrec :: Int -> ColumnDescriptor -> ShowS
Show, ReadPrec [ColumnDescriptor]
ReadPrec ColumnDescriptor
Int -> ReadS ColumnDescriptor
ReadS [ColumnDescriptor]
(Int -> ReadS ColumnDescriptor)
-> ReadS [ColumnDescriptor]
-> ReadPrec ColumnDescriptor
-> ReadPrec [ColumnDescriptor]
-> Read ColumnDescriptor
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColumnDescriptor]
$creadListPrec :: ReadPrec [ColumnDescriptor]
readPrec :: ReadPrec ColumnDescriptor
$creadPrec :: ReadPrec ColumnDescriptor
readList :: ReadS [ColumnDescriptor]
$creadList :: ReadS [ColumnDescriptor]
readsPrec :: Int -> ReadS ColumnDescriptor
$creadsPrec :: Int -> ReadS ColumnDescriptor
Read, ColumnDescriptor -> ColumnDescriptor -> Bool
(ColumnDescriptor -> ColumnDescriptor -> Bool)
-> (ColumnDescriptor -> ColumnDescriptor -> Bool)
-> Eq ColumnDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnDescriptor -> ColumnDescriptor -> Bool
$c/= :: ColumnDescriptor -> ColumnDescriptor -> Bool
== :: ColumnDescriptor -> ColumnDescriptor -> Bool
$c== :: ColumnDescriptor -> ColumnDescriptor -> Bool
Eq)


-- |
--   A Source is a descriptor for source code.
--
--   It is returned from the debug adapter as part of a StackFrame and it is used by clients
--
--   when specifying breakpoints.
--
data Source =
  Source {
    Source -> Maybe String
nameSource             :: Maybe String  -- ^The short name of the source. Every source returned from the debug adapter has a name. When sending a source to the debug adapter this name is optional.
  , Source -> String
pathSource             :: String        -- ^The path of the source to be shown in the UI. It is only used to locate and load the content of the source if no sourceReference is specified (or its vaule is 0).
  , Source -> Maybe Int
sourceReferenceSource  :: Maybe Int     -- ^If sourceReference > 0 the contents of the source must be retrieved through the SourceRequest (even if a path is specified). A sourceReference is only valid for a session, so it must not be used to persist a source.
  , Source -> Maybe String
originSource           :: Maybe String  -- ^The (optional) origin of this source: possible values 'internal module', 'inlined content from source map', etc.
  } deriving (Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
(Int -> Source -> ShowS)
-> (Source -> String) -> ([Source] -> ShowS) -> Show Source
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Source] -> ShowS
$cshowList :: [Source] -> ShowS
show :: Source -> String
$cshow :: Source -> String
showsPrec :: Int -> Source -> ShowS
$cshowsPrec :: Int -> Source -> ShowS
Show, ReadPrec [Source]
ReadPrec Source
Int -> ReadS Source
ReadS [Source]
(Int -> ReadS Source)
-> ReadS [Source]
-> ReadPrec Source
-> ReadPrec [Source]
-> Read Source
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Source]
$creadListPrec :: ReadPrec [Source]
readPrec :: ReadPrec Source
$creadPrec :: ReadPrec Source
readList :: ReadS [Source]
$creadList :: ReadS [Source]
readsPrec :: Int -> ReadS Source
$creadsPrec :: Int -> ReadS Source
Read, Source -> Source -> Bool
(Source -> Source -> Bool)
-> (Source -> Source -> Bool) -> Eq Source
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c== :: Source -> Source -> Bool
Eq)


-- |
--
defaultSource :: Source
defaultSource :: Source
defaultSource = Source :: Maybe String -> String -> Maybe Int -> Maybe String -> Source
Source {
    nameSource :: Maybe String
nameSource             = Maybe String
forall a. Maybe a
Nothing
  , pathSource :: String
pathSource             = String
""
  , sourceReferenceSource :: Maybe Int
sourceReferenceSource  = Maybe Int
forall a. Maybe a
Nothing
  , originSource :: Maybe String
originSource           = Maybe String
forall a. Maybe a
Nothing
  }



-- |
--   Information about a Breakpoint created in setBreakpoints or setFunctionBreakpoints.
--
data Breakpoint =
  Breakpoint {
    Breakpoint -> Maybe Int
idBreakpoint        :: Maybe Int -- ^An optional unique identifier for the breakpoint.
  , Breakpoint -> Bool
verifiedBreakpoint  :: Bool      -- ^If true breakpoint could be set (but not necessarily at the desired location).
  , Breakpoint -> String
messageBreakpoint   :: String    -- ^An optional message about the state of the breakpoint. This is shown to the user and can be used to explain why a breakpoint could not be verified.
  , Breakpoint -> Source
sourceBreakpoint    :: Source    -- ^The source where the breakpoint is located.
  , Breakpoint -> Int
lineBreakpoint      :: Int       -- ^The start line of the actual range covered by the breakpoint.
  , Breakpoint -> Int
columnBreakpoint    :: Int       -- ^An optional start column of the actual range covered by the breakpoint.
  , Breakpoint -> Int
endLineBreakpoint   :: Int       -- ^An optional end line of the actual range covered by the breakpoint.
  , Breakpoint -> Int
endColumnBreakpoint :: Int       -- ^An optional end column of the actual range covered by the breakpoint. If no end line is given, then the end column is assumed to be in the start line.
  } deriving (Int -> Breakpoint -> ShowS
[Breakpoint] -> ShowS
Breakpoint -> String
(Int -> Breakpoint -> ShowS)
-> (Breakpoint -> String)
-> ([Breakpoint] -> ShowS)
-> Show Breakpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Breakpoint] -> ShowS
$cshowList :: [Breakpoint] -> ShowS
show :: Breakpoint -> String
$cshow :: Breakpoint -> String
showsPrec :: Int -> Breakpoint -> ShowS
$cshowsPrec :: Int -> Breakpoint -> ShowS
Show, ReadPrec [Breakpoint]
ReadPrec Breakpoint
Int -> ReadS Breakpoint
ReadS [Breakpoint]
(Int -> ReadS Breakpoint)
-> ReadS [Breakpoint]
-> ReadPrec Breakpoint
-> ReadPrec [Breakpoint]
-> Read Breakpoint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Breakpoint]
$creadListPrec :: ReadPrec [Breakpoint]
readPrec :: ReadPrec Breakpoint
$creadPrec :: ReadPrec Breakpoint
readList :: ReadS [Breakpoint]
$creadList :: ReadS [Breakpoint]
readsPrec :: Int -> ReadS Breakpoint
$creadsPrec :: Int -> ReadS Breakpoint
Read, Breakpoint -> Breakpoint -> Bool
(Breakpoint -> Breakpoint -> Bool)
-> (Breakpoint -> Breakpoint -> Bool) -> Eq Breakpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Breakpoint -> Breakpoint -> Bool
$c/= :: Breakpoint -> Breakpoint -> Bool
== :: Breakpoint -> Breakpoint -> Bool
$c== :: Breakpoint -> Breakpoint -> Bool
Eq)


-- |
--
defaultBreakpoint :: Breakpoint
defaultBreakpoint :: Breakpoint
defaultBreakpoint = Breakpoint :: Maybe Int
-> Bool
-> String
-> Source
-> Int
-> Int
-> Int
-> Int
-> Breakpoint
Breakpoint {
    idBreakpoint :: Maybe Int
idBreakpoint        = Maybe Int
forall a. Maybe a
Nothing
  , verifiedBreakpoint :: Bool
verifiedBreakpoint  = Bool
False
  , messageBreakpoint :: String
messageBreakpoint   = String
""
  , sourceBreakpoint :: Source
sourceBreakpoint    = Source
defaultSource
  , lineBreakpoint :: Int
lineBreakpoint      = Int
0
  , columnBreakpoint :: Int
columnBreakpoint    = Int
0
  , endLineBreakpoint :: Int
endLineBreakpoint   = Int
0
  , endColumnBreakpoint :: Int
endColumnBreakpoint = Int
0
  }


-- |
--   An ExceptionBreakpointsFilter is shown in the UI as an option for configuring how exceptions are dealt with.
--
data ExceptionBreakpointsFilter =
  ExceptionBreakpointsFilter {
    ExceptionBreakpointsFilter -> String
filterExceptionBreakpointsFilter  :: String  -- ^The internal ID of the filter. This value is passed to the setExceptionBreakpoints request.
  , ExceptionBreakpointsFilter -> String
labelExceptionBreakpointsFilter   :: String  -- ^The name of the filter. This will be shown in the UI.
  , ExceptionBreakpointsFilter -> Bool
defaultExceptionBreakpointsFilter :: Bool    -- ^Initial value of the filter. If not specified a value 'false' is assumed.
  } deriving (Int -> ExceptionBreakpointsFilter -> ShowS
[ExceptionBreakpointsFilter] -> ShowS
ExceptionBreakpointsFilter -> String
(Int -> ExceptionBreakpointsFilter -> ShowS)
-> (ExceptionBreakpointsFilter -> String)
-> ([ExceptionBreakpointsFilter] -> ShowS)
-> Show ExceptionBreakpointsFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExceptionBreakpointsFilter] -> ShowS
$cshowList :: [ExceptionBreakpointsFilter] -> ShowS
show :: ExceptionBreakpointsFilter -> String
$cshow :: ExceptionBreakpointsFilter -> String
showsPrec :: Int -> ExceptionBreakpointsFilter -> ShowS
$cshowsPrec :: Int -> ExceptionBreakpointsFilter -> ShowS
Show, ReadPrec [ExceptionBreakpointsFilter]
ReadPrec ExceptionBreakpointsFilter
Int -> ReadS ExceptionBreakpointsFilter
ReadS [ExceptionBreakpointsFilter]
(Int -> ReadS ExceptionBreakpointsFilter)
-> ReadS [ExceptionBreakpointsFilter]
-> ReadPrec ExceptionBreakpointsFilter
-> ReadPrec [ExceptionBreakpointsFilter]
-> Read ExceptionBreakpointsFilter
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExceptionBreakpointsFilter]
$creadListPrec :: ReadPrec [ExceptionBreakpointsFilter]
readPrec :: ReadPrec ExceptionBreakpointsFilter
$creadPrec :: ReadPrec ExceptionBreakpointsFilter
readList :: ReadS [ExceptionBreakpointsFilter]
$creadList :: ReadS [ExceptionBreakpointsFilter]
readsPrec :: Int -> ReadS ExceptionBreakpointsFilter
$creadsPrec :: Int -> ReadS ExceptionBreakpointsFilter
Read, ExceptionBreakpointsFilter -> ExceptionBreakpointsFilter -> Bool
(ExceptionBreakpointsFilter -> ExceptionBreakpointsFilter -> Bool)
-> (ExceptionBreakpointsFilter
    -> ExceptionBreakpointsFilter -> Bool)
-> Eq ExceptionBreakpointsFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExceptionBreakpointsFilter -> ExceptionBreakpointsFilter -> Bool
$c/= :: ExceptionBreakpointsFilter -> ExceptionBreakpointsFilter -> Bool
== :: ExceptionBreakpointsFilter -> ExceptionBreakpointsFilter -> Bool
$c== :: ExceptionBreakpointsFilter -> ExceptionBreakpointsFilter -> Bool
Eq)


----------------------------------------------------------------------------
--  Initialize
----------------------------------------------------------------------------

-- |
--   Initialize request; value of command field is 'initialize'.
--
--   The 'initialize' request is sent as the first request from the client to the debug adapter in order to configure it with client capabilities and to retrieve capabilities from the debug adapter.
--
--   Until the debug adapter has responded to with an 'initialize' response, the client must not send any additional requests or events to the debug adapter. In addition the debug adapter is not allowed to send any requests or events to the client until it has responded with an 'initialize' response.
--
--   The 'initialize' request may only be sent once.
--
data InitializeRequest =
  InitializeRequest {
    InitializeRequest -> Int
seqInitializeRequest       :: Int                         -- ^Sequence number
  , InitializeRequest -> String
typeInitializeRequest      :: String                      -- ^One of "request", "response", or "event"
  , InitializeRequest -> String
commandInitializeRequest   :: String                      -- ^The command to execute
  , InitializeRequest -> InitializeRequestArguments
argumentsInitializeRequest :: InitializeRequestArguments  -- ^Object containing arguments for the command
  } deriving (Int -> InitializeRequest -> ShowS
[InitializeRequest] -> ShowS
InitializeRequest -> String
(Int -> InitializeRequest -> ShowS)
-> (InitializeRequest -> String)
-> ([InitializeRequest] -> ShowS)
-> Show InitializeRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitializeRequest] -> ShowS
$cshowList :: [InitializeRequest] -> ShowS
show :: InitializeRequest -> String
$cshow :: InitializeRequest -> String
showsPrec :: Int -> InitializeRequest -> ShowS
$cshowsPrec :: Int -> InitializeRequest -> ShowS
Show, ReadPrec [InitializeRequest]
ReadPrec InitializeRequest
Int -> ReadS InitializeRequest
ReadS [InitializeRequest]
(Int -> ReadS InitializeRequest)
-> ReadS [InitializeRequest]
-> ReadPrec InitializeRequest
-> ReadPrec [InitializeRequest]
-> Read InitializeRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitializeRequest]
$creadListPrec :: ReadPrec [InitializeRequest]
readPrec :: ReadPrec InitializeRequest
$creadPrec :: ReadPrec InitializeRequest
readList :: ReadS [InitializeRequest]
$creadList :: ReadS [InitializeRequest]
readsPrec :: Int -> ReadS InitializeRequest
$creadsPrec :: Int -> ReadS InitializeRequest
Read, InitializeRequest -> InitializeRequest -> Bool
(InitializeRequest -> InitializeRequest -> Bool)
-> (InitializeRequest -> InitializeRequest -> Bool)
-> Eq InitializeRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitializeRequest -> InitializeRequest -> Bool
$c/= :: InitializeRequest -> InitializeRequest -> Bool
== :: InitializeRequest -> InitializeRequest -> Bool
$c== :: InitializeRequest -> InitializeRequest -> Bool
Eq)


-- |
--
defaultInitializeRequest :: InitializeRequest
defaultInitializeRequest :: InitializeRequest
defaultInitializeRequest = InitializeRequest :: Int
-> String
-> String
-> InitializeRequestArguments
-> InitializeRequest
InitializeRequest {
    seqInitializeRequest :: Int
seqInitializeRequest       = Int
0
  , typeInitializeRequest :: String
typeInitializeRequest      = String
"request"
  , commandInitializeRequest :: String
commandInitializeRequest   = String
"initialize"
  , argumentsInitializeRequest :: InitializeRequestArguments
argumentsInitializeRequest = InitializeRequestArguments
defaultInitializeRequestArguments
  }


-- |
--   Arguments for 'initialize' request.
--
data InitializeRequestArguments =
  InitializeRequestArguments {
    InitializeRequestArguments -> String
adapterIDInitializeRequestArguments       :: String  -- ^The ID of the debugger adapter. Used to select or verify debugger adapter.
  , InitializeRequestArguments -> Bool
linesStartAt1InitializeRequestArguments   :: Bool    -- ^If true all line numbers are 1-based (default).
  , InitializeRequestArguments -> Bool
columnsStartAt1InitializeRequestArguments :: Bool    -- ^If true all column numbers are 1-based (default).
  , InitializeRequestArguments -> String
pathFormatInitializeRequestArguments      :: String  -- ^Determines in what format paths are specified. Possible values are 'path' or 'uri'. The default is 'path', which is the native format.
  } deriving (Int -> InitializeRequestArguments -> ShowS
[InitializeRequestArguments] -> ShowS
InitializeRequestArguments -> String
(Int -> InitializeRequestArguments -> ShowS)
-> (InitializeRequestArguments -> String)
-> ([InitializeRequestArguments] -> ShowS)
-> Show InitializeRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitializeRequestArguments] -> ShowS
$cshowList :: [InitializeRequestArguments] -> ShowS
show :: InitializeRequestArguments -> String
$cshow :: InitializeRequestArguments -> String
showsPrec :: Int -> InitializeRequestArguments -> ShowS
$cshowsPrec :: Int -> InitializeRequestArguments -> ShowS
Show, ReadPrec [InitializeRequestArguments]
ReadPrec InitializeRequestArguments
Int -> ReadS InitializeRequestArguments
ReadS [InitializeRequestArguments]
(Int -> ReadS InitializeRequestArguments)
-> ReadS [InitializeRequestArguments]
-> ReadPrec InitializeRequestArguments
-> ReadPrec [InitializeRequestArguments]
-> Read InitializeRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitializeRequestArguments]
$creadListPrec :: ReadPrec [InitializeRequestArguments]
readPrec :: ReadPrec InitializeRequestArguments
$creadPrec :: ReadPrec InitializeRequestArguments
readList :: ReadS [InitializeRequestArguments]
$creadList :: ReadS [InitializeRequestArguments]
readsPrec :: Int -> ReadS InitializeRequestArguments
$creadsPrec :: Int -> ReadS InitializeRequestArguments
Read, InitializeRequestArguments -> InitializeRequestArguments -> Bool
(InitializeRequestArguments -> InitializeRequestArguments -> Bool)
-> (InitializeRequestArguments
    -> InitializeRequestArguments -> Bool)
-> Eq InitializeRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitializeRequestArguments -> InitializeRequestArguments -> Bool
$c/= :: InitializeRequestArguments -> InitializeRequestArguments -> Bool
== :: InitializeRequestArguments -> InitializeRequestArguments -> Bool
$c== :: InitializeRequestArguments -> InitializeRequestArguments -> Bool
Eq)


-- |
--
defaultInitializeRequestArguments :: InitializeRequestArguments
defaultInitializeRequestArguments :: InitializeRequestArguments
defaultInitializeRequestArguments = InitializeRequestArguments :: String -> Bool -> Bool -> String -> InitializeRequestArguments
InitializeRequestArguments {
    adapterIDInitializeRequestArguments :: String
adapterIDInitializeRequestArguments       = String
""
  , linesStartAt1InitializeRequestArguments :: Bool
linesStartAt1InitializeRequestArguments   = Bool
False
  , columnsStartAt1InitializeRequestArguments :: Bool
columnsStartAt1InitializeRequestArguments = Bool
False
  , pathFormatInitializeRequestArguments :: String
pathFormatInitializeRequestArguments      = String
""
  }


-- |
--   Response to 'initialize' request.
--
data InitializeResponse =
  InitializeResponse {
    InitializeResponse -> Int
seqInitializeResponse         :: Int     -- ^Sequence number
  , InitializeResponse -> String
typeInitializeResponse        :: String  -- ^One of "request", "response", or "event"
  , InitializeResponse -> Int
request_seqInitializeResponse :: Int     -- ^Sequence number of the corresponding request
  , InitializeResponse -> Bool
successInitializeResponse     :: Bool    -- ^Outcome of the request
  , InitializeResponse -> String
commandInitializeResponse     :: String  -- ^The command requested
  , InitializeResponse -> String
messageInitializeResponse     :: String  -- ^Contains error message if success == false.
  , InitializeResponse -> InitializeResponseBody
bodyInitializeResponse        :: InitializeResponseBody  -- ^The capabilities of this debug adapter
  } deriving (Int -> InitializeResponse -> ShowS
[InitializeResponse] -> ShowS
InitializeResponse -> String
(Int -> InitializeResponse -> ShowS)
-> (InitializeResponse -> String)
-> ([InitializeResponse] -> ShowS)
-> Show InitializeResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitializeResponse] -> ShowS
$cshowList :: [InitializeResponse] -> ShowS
show :: InitializeResponse -> String
$cshow :: InitializeResponse -> String
showsPrec :: Int -> InitializeResponse -> ShowS
$cshowsPrec :: Int -> InitializeResponse -> ShowS
Show, ReadPrec [InitializeResponse]
ReadPrec InitializeResponse
Int -> ReadS InitializeResponse
ReadS [InitializeResponse]
(Int -> ReadS InitializeResponse)
-> ReadS [InitializeResponse]
-> ReadPrec InitializeResponse
-> ReadPrec [InitializeResponse]
-> Read InitializeResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitializeResponse]
$creadListPrec :: ReadPrec [InitializeResponse]
readPrec :: ReadPrec InitializeResponse
$creadPrec :: ReadPrec InitializeResponse
readList :: ReadS [InitializeResponse]
$creadList :: ReadS [InitializeResponse]
readsPrec :: Int -> ReadS InitializeResponse
$creadsPrec :: Int -> ReadS InitializeResponse
Read, InitializeResponse -> InitializeResponse -> Bool
(InitializeResponse -> InitializeResponse -> Bool)
-> (InitializeResponse -> InitializeResponse -> Bool)
-> Eq InitializeResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitializeResponse -> InitializeResponse -> Bool
$c/= :: InitializeResponse -> InitializeResponse -> Bool
== :: InitializeResponse -> InitializeResponse -> Bool
$c== :: InitializeResponse -> InitializeResponse -> Bool
Eq)


-- |
--
defaultInitializeResponse :: InitializeResponse
defaultInitializeResponse :: InitializeResponse
defaultInitializeResponse = InitializeResponse :: Int
-> String
-> Int
-> Bool
-> String
-> String
-> InitializeResponseBody
-> InitializeResponse
InitializeResponse {
    seqInitializeResponse :: Int
seqInitializeResponse         = Int
0
  , typeInitializeResponse :: String
typeInitializeResponse        = String
"response"
  , request_seqInitializeResponse :: Int
request_seqInitializeResponse = Int
0
  , successInitializeResponse :: Bool
successInitializeResponse     = Bool
False
  , commandInitializeResponse :: String
commandInitializeResponse     = String
"initialize"
  , messageInitializeResponse :: String
messageInitializeResponse     = String
""
  , bodyInitializeResponse :: InitializeResponseBody
bodyInitializeResponse        = InitializeResponseBody
defaultInitializeResponseBody
  }


-- |
--   Information about the capabilities of a debug adapter.
--
data InitializeResponseBody =
  InitializeResponseBody {
    InitializeResponseBody -> Bool
supportsConfigurationDoneRequestInitializeResponseBody  :: Bool  -- ^The debug adapter supports the 'configurationDone' request.
  , InitializeResponseBody -> Bool
supportsFunctionBreakpointsInitializeResponseBody       :: Bool  -- ^The debug adapter supports functionBreakpoints.
  , InitializeResponseBody -> Bool
supportsConditionalBreakpointsInitializeResponseBody    :: Bool  -- ^The debug adapter supports conditionalBreakpoints.
  , InitializeResponseBody -> Bool
supportsHitConditionalBreakpointsInitializeResponseBody :: Bool  -- ^The debug adapter supports breakpoints that break execution after a specified number of hits.
  , InitializeResponseBody -> Bool
supportsEvaluateForHoversInitializeResponseBody         :: Bool  -- ^The debug adapter supports a (side effect free) evaluate request for data hovers.
  , InitializeResponseBody -> [ExceptionBreakpointsFilter]
exceptionBreakpointFiltersInitializeResponseBody        :: [ExceptionBreakpointsFilter]  -- ^Available filters for the setExceptionBreakpoints request.
  , InitializeResponseBody -> Bool
supportsStepBackInitializeResponseBody                  :: Bool  -- ^The debug adapter supports stepping back.
  , InitializeResponseBody -> Bool
supportsSetVariableInitializeResponseBody               :: Bool  -- ^The debug adapter supports setting a variable to a value.
  , InitializeResponseBody -> Bool
supportsRestartFrameInitializeResponseBody              :: Bool  -- ^The debug adapter supports restarting a frame.
  , InitializeResponseBody -> Bool
supportsGotoTargetsRequestInitializeResponseBody        :: Bool  -- ^The debug adapter supports the gotoTargetsRequest.
  , InitializeResponseBody -> Bool
supportsStepInTargetsRequestInitializeResponseBody      :: Bool  -- ^The debug adapter supports the stepInTargetsRequest.
  , InitializeResponseBody -> Bool
supportsCompletionsRequestInitializeResponseBody        :: Bool  -- ^The debug adapter supports the completionsRequest.
  , InitializeResponseBody -> Bool
supportsModulesRequestInitializeResponseBody            :: Bool  -- ^The debug adapter supports the modules request.
  , InitializeResponseBody -> [ColumnDescriptor]
additionalModuleColumnsInitializeResponseBody           :: [ColumnDescriptor] -- ^The set of additional module information exposed by the debug adapter.
  , InitializeResponseBody -> Bool
supportsLogPointsInitializeResponseBody                 :: Bool  -- ^The debug adapter supports logpoints by interpreting the 'logMessage' attribute of the SourceBreakpoint.
  , InitializeResponseBody -> Bool
supportsTerminateRequestInitializeResponseBody          :: Bool  -- ^The debug adapter supports the 'terminate' request.
  } deriving (Int -> InitializeResponseBody -> ShowS
[InitializeResponseBody] -> ShowS
InitializeResponseBody -> String
(Int -> InitializeResponseBody -> ShowS)
-> (InitializeResponseBody -> String)
-> ([InitializeResponseBody] -> ShowS)
-> Show InitializeResponseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitializeResponseBody] -> ShowS
$cshowList :: [InitializeResponseBody] -> ShowS
show :: InitializeResponseBody -> String
$cshow :: InitializeResponseBody -> String
showsPrec :: Int -> InitializeResponseBody -> ShowS
$cshowsPrec :: Int -> InitializeResponseBody -> ShowS
Show, ReadPrec [InitializeResponseBody]
ReadPrec InitializeResponseBody
Int -> ReadS InitializeResponseBody
ReadS [InitializeResponseBody]
(Int -> ReadS InitializeResponseBody)
-> ReadS [InitializeResponseBody]
-> ReadPrec InitializeResponseBody
-> ReadPrec [InitializeResponseBody]
-> Read InitializeResponseBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitializeResponseBody]
$creadListPrec :: ReadPrec [InitializeResponseBody]
readPrec :: ReadPrec InitializeResponseBody
$creadPrec :: ReadPrec InitializeResponseBody
readList :: ReadS [InitializeResponseBody]
$creadList :: ReadS [InitializeResponseBody]
readsPrec :: Int -> ReadS InitializeResponseBody
$creadsPrec :: Int -> ReadS InitializeResponseBody
Read, InitializeResponseBody -> InitializeResponseBody -> Bool
(InitializeResponseBody -> InitializeResponseBody -> Bool)
-> (InitializeResponseBody -> InitializeResponseBody -> Bool)
-> Eq InitializeResponseBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitializeResponseBody -> InitializeResponseBody -> Bool
$c/= :: InitializeResponseBody -> InitializeResponseBody -> Bool
== :: InitializeResponseBody -> InitializeResponseBody -> Bool
$c== :: InitializeResponseBody -> InitializeResponseBody -> Bool
Eq)

-- |
--
defaultInitializeResponseBody :: InitializeResponseBody
defaultInitializeResponseBody :: InitializeResponseBody
defaultInitializeResponseBody = InitializeResponseBody :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> [ExceptionBreakpointsFilter]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> [ColumnDescriptor]
-> Bool
-> Bool
-> InitializeResponseBody
InitializeResponseBody {
    supportsConfigurationDoneRequestInitializeResponseBody :: Bool
supportsConfigurationDoneRequestInitializeResponseBody  = Bool
False
  , supportsFunctionBreakpointsInitializeResponseBody :: Bool
supportsFunctionBreakpointsInitializeResponseBody       = Bool
False
  , supportsConditionalBreakpointsInitializeResponseBody :: Bool
supportsConditionalBreakpointsInitializeResponseBody    = Bool
False
  , supportsHitConditionalBreakpointsInitializeResponseBody :: Bool
supportsHitConditionalBreakpointsInitializeResponseBody = Bool
False
  , supportsEvaluateForHoversInitializeResponseBody :: Bool
supportsEvaluateForHoversInitializeResponseBody         = Bool
False
  , exceptionBreakpointFiltersInitializeResponseBody :: [ExceptionBreakpointsFilter]
exceptionBreakpointFiltersInitializeResponseBody        = []
  , supportsStepBackInitializeResponseBody :: Bool
supportsStepBackInitializeResponseBody                  = Bool
False
  , supportsSetVariableInitializeResponseBody :: Bool
supportsSetVariableInitializeResponseBody               = Bool
False
  , supportsRestartFrameInitializeResponseBody :: Bool
supportsRestartFrameInitializeResponseBody              = Bool
False
  , supportsGotoTargetsRequestInitializeResponseBody :: Bool
supportsGotoTargetsRequestInitializeResponseBody        = Bool
False
  , supportsStepInTargetsRequestInitializeResponseBody :: Bool
supportsStepInTargetsRequestInitializeResponseBody      = Bool
False
  , supportsCompletionsRequestInitializeResponseBody :: Bool
supportsCompletionsRequestInitializeResponseBody        = Bool
False
  , supportsModulesRequestInitializeResponseBody :: Bool
supportsModulesRequestInitializeResponseBody            = Bool
False
  , additionalModuleColumnsInitializeResponseBody :: [ColumnDescriptor]
additionalModuleColumnsInitializeResponseBody           = []
  , supportsLogPointsInitializeResponseBody :: Bool
supportsLogPointsInitializeResponseBody                 = Bool
False
  , supportsTerminateRequestInitializeResponseBody :: Bool
supportsTerminateRequestInitializeResponseBody          = Bool
False
  }


----------------------------------------------------------------------------
--  Disconnect
----------------------------------------------------------------------------

-- |
--   Disconnect request; value of command field is 'disconnect'.
--
--	The 'disconnect' request is sent from the client to the debug adapter in order to stop debugging.
--
--  It asks the debug adapter to disconnect from the debuggee and to terminate the debug adapter.
--
--  If the debuggee has been started with the 'launch' request, the 'disconnect' request terminates the debuggee.
--
--  If the 'attach' request was used to connect to the debuggee, 'disconnect' does not terminate the debuggee.
--
-- This behavior can be controlled with the 'terminateDebuggee' argument (if supported by the debug adapter).
--
data DisconnectRequest =
  DisconnectRequest {
    DisconnectRequest -> Int
seqDisconnectRequest       :: Int                        -- ^Sequence number
  , DisconnectRequest -> String
typeDisconnectRequest      :: String                     -- ^One of "request", "response", or "event"
  , DisconnectRequest -> String
commandDisconnectRequest   :: String                     -- ^The command to execute
  , DisconnectRequest -> Maybe DisconnectRequestArguments
argumentsDisconnectRequest :: Maybe DisconnectRequestArguments  -- ^Arguments for "disconnect" request.
  } deriving (Int -> DisconnectRequest -> ShowS
[DisconnectRequest] -> ShowS
DisconnectRequest -> String
(Int -> DisconnectRequest -> ShowS)
-> (DisconnectRequest -> String)
-> ([DisconnectRequest] -> ShowS)
-> Show DisconnectRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisconnectRequest] -> ShowS
$cshowList :: [DisconnectRequest] -> ShowS
show :: DisconnectRequest -> String
$cshow :: DisconnectRequest -> String
showsPrec :: Int -> DisconnectRequest -> ShowS
$cshowsPrec :: Int -> DisconnectRequest -> ShowS
Show, ReadPrec [DisconnectRequest]
ReadPrec DisconnectRequest
Int -> ReadS DisconnectRequest
ReadS [DisconnectRequest]
(Int -> ReadS DisconnectRequest)
-> ReadS [DisconnectRequest]
-> ReadPrec DisconnectRequest
-> ReadPrec [DisconnectRequest]
-> Read DisconnectRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisconnectRequest]
$creadListPrec :: ReadPrec [DisconnectRequest]
readPrec :: ReadPrec DisconnectRequest
$creadPrec :: ReadPrec DisconnectRequest
readList :: ReadS [DisconnectRequest]
$creadList :: ReadS [DisconnectRequest]
readsPrec :: Int -> ReadS DisconnectRequest
$creadsPrec :: Int -> ReadS DisconnectRequest
Read, DisconnectRequest -> DisconnectRequest -> Bool
(DisconnectRequest -> DisconnectRequest -> Bool)
-> (DisconnectRequest -> DisconnectRequest -> Bool)
-> Eq DisconnectRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisconnectRequest -> DisconnectRequest -> Bool
$c/= :: DisconnectRequest -> DisconnectRequest -> Bool
== :: DisconnectRequest -> DisconnectRequest -> Bool
$c== :: DisconnectRequest -> DisconnectRequest -> Bool
Eq)


-- |
--   Arguments for 'disconnect' request.
--
data DisconnectRequestArguments =
  DisconnectArguments {
    DisconnectRequestArguments -> Maybe Bool
restartDisconnectRequestArguments :: Maybe Bool  -- ^A value of true indicates that this 'disconnect' request is part of a restart sequence.
  } deriving (Int -> DisconnectRequestArguments -> ShowS
[DisconnectRequestArguments] -> ShowS
DisconnectRequestArguments -> String
(Int -> DisconnectRequestArguments -> ShowS)
-> (DisconnectRequestArguments -> String)
-> ([DisconnectRequestArguments] -> ShowS)
-> Show DisconnectRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisconnectRequestArguments] -> ShowS
$cshowList :: [DisconnectRequestArguments] -> ShowS
show :: DisconnectRequestArguments -> String
$cshow :: DisconnectRequestArguments -> String
showsPrec :: Int -> DisconnectRequestArguments -> ShowS
$cshowsPrec :: Int -> DisconnectRequestArguments -> ShowS
Show, ReadPrec [DisconnectRequestArguments]
ReadPrec DisconnectRequestArguments
Int -> ReadS DisconnectRequestArguments
ReadS [DisconnectRequestArguments]
(Int -> ReadS DisconnectRequestArguments)
-> ReadS [DisconnectRequestArguments]
-> ReadPrec DisconnectRequestArguments
-> ReadPrec [DisconnectRequestArguments]
-> Read DisconnectRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisconnectRequestArguments]
$creadListPrec :: ReadPrec [DisconnectRequestArguments]
readPrec :: ReadPrec DisconnectRequestArguments
$creadPrec :: ReadPrec DisconnectRequestArguments
readList :: ReadS [DisconnectRequestArguments]
$creadList :: ReadS [DisconnectRequestArguments]
readsPrec :: Int -> ReadS DisconnectRequestArguments
$creadsPrec :: Int -> ReadS DisconnectRequestArguments
Read, DisconnectRequestArguments -> DisconnectRequestArguments -> Bool
(DisconnectRequestArguments -> DisconnectRequestArguments -> Bool)
-> (DisconnectRequestArguments
    -> DisconnectRequestArguments -> Bool)
-> Eq DisconnectRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisconnectRequestArguments -> DisconnectRequestArguments -> Bool
$c/= :: DisconnectRequestArguments -> DisconnectRequestArguments -> Bool
== :: DisconnectRequestArguments -> DisconnectRequestArguments -> Bool
$c== :: DisconnectRequestArguments -> DisconnectRequestArguments -> Bool
Eq)


-- |
--   Response to 'disconnect' request. This is just an acknowledgement, so no body field is required.
--
data DisconnectResponse =
  DisconnectResponse {
    DisconnectResponse -> Int
seqDisconnectResponse         :: Int     -- ^Sequence number
  , DisconnectResponse -> String
typeDisconnectResponse        :: String  -- ^One of "request", "response", or "event"
  , DisconnectResponse -> Int
request_seqDisconnectResponse :: Int     -- ^Sequence number of the corresponding request
  , DisconnectResponse -> Bool
successDisconnectResponse     :: Bool    -- ^Outcome of the request
  , DisconnectResponse -> String
commandDisconnectResponse     :: String  -- ^The command requested
  , DisconnectResponse -> String
messageDisconnectResponse     :: String  -- ^Contains error message if success == false.
  } deriving (Int -> DisconnectResponse -> ShowS
[DisconnectResponse] -> ShowS
DisconnectResponse -> String
(Int -> DisconnectResponse -> ShowS)
-> (DisconnectResponse -> String)
-> ([DisconnectResponse] -> ShowS)
-> Show DisconnectResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisconnectResponse] -> ShowS
$cshowList :: [DisconnectResponse] -> ShowS
show :: DisconnectResponse -> String
$cshow :: DisconnectResponse -> String
showsPrec :: Int -> DisconnectResponse -> ShowS
$cshowsPrec :: Int -> DisconnectResponse -> ShowS
Show, ReadPrec [DisconnectResponse]
ReadPrec DisconnectResponse
Int -> ReadS DisconnectResponse
ReadS [DisconnectResponse]
(Int -> ReadS DisconnectResponse)
-> ReadS [DisconnectResponse]
-> ReadPrec DisconnectResponse
-> ReadPrec [DisconnectResponse]
-> Read DisconnectResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisconnectResponse]
$creadListPrec :: ReadPrec [DisconnectResponse]
readPrec :: ReadPrec DisconnectResponse
$creadPrec :: ReadPrec DisconnectResponse
readList :: ReadS [DisconnectResponse]
$creadList :: ReadS [DisconnectResponse]
readsPrec :: Int -> ReadS DisconnectResponse
$creadsPrec :: Int -> ReadS DisconnectResponse
Read, DisconnectResponse -> DisconnectResponse -> Bool
(DisconnectResponse -> DisconnectResponse -> Bool)
-> (DisconnectResponse -> DisconnectResponse -> Bool)
-> Eq DisconnectResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisconnectResponse -> DisconnectResponse -> Bool
$c/= :: DisconnectResponse -> DisconnectResponse -> Bool
== :: DisconnectResponse -> DisconnectResponse -> Bool
$c== :: DisconnectResponse -> DisconnectResponse -> Bool
Eq)


-- |
--
defaultDisconnectResponse :: DisconnectResponse
defaultDisconnectResponse :: DisconnectResponse
defaultDisconnectResponse = DisconnectResponse :: Int
-> String -> Int -> Bool -> String -> String -> DisconnectResponse
DisconnectResponse {
    seqDisconnectResponse :: Int
seqDisconnectResponse         = Int
0
  , typeDisconnectResponse :: String
typeDisconnectResponse        = String
"response"
  , request_seqDisconnectResponse :: Int
request_seqDisconnectResponse = Int
0
  , successDisconnectResponse :: Bool
successDisconnectResponse     = Bool
False
  , commandDisconnectResponse :: String
commandDisconnectResponse     = String
"disconnect"
  , messageDisconnectResponse :: String
messageDisconnectResponse     = String
""
  }



----------------------------------------------------------------------------
--  PauseRequest
----------------------------------------------------------------------------

-- |
--   Pause request; value of command field is "pause".
--
--     The request suspenses the debuggee.
--
--     The debug adapter first sends the response and then a 'stopped' event (with reason 'pause') after the thread has been paused successfully.
--
data PauseRequest =
  PauseRequest {
    PauseRequest -> Int
seqPauseRequest       :: Int                        -- ^Sequence number
  , PauseRequest -> String
typePauseRequest      :: String                     -- ^One of "request", "response", or "event"
  , PauseRequest -> String
commandPauseRequest   :: String                     -- ^The command to execute
  , PauseRequest -> Maybe PauseRequestArguments
argumentsPauseRequest :: Maybe PauseRequestArguments  -- ^Arguments for "pause" request.
  } deriving (Int -> PauseRequest -> ShowS
[PauseRequest] -> ShowS
PauseRequest -> String
(Int -> PauseRequest -> ShowS)
-> (PauseRequest -> String)
-> ([PauseRequest] -> ShowS)
-> Show PauseRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PauseRequest] -> ShowS
$cshowList :: [PauseRequest] -> ShowS
show :: PauseRequest -> String
$cshow :: PauseRequest -> String
showsPrec :: Int -> PauseRequest -> ShowS
$cshowsPrec :: Int -> PauseRequest -> ShowS
Show, ReadPrec [PauseRequest]
ReadPrec PauseRequest
Int -> ReadS PauseRequest
ReadS [PauseRequest]
(Int -> ReadS PauseRequest)
-> ReadS [PauseRequest]
-> ReadPrec PauseRequest
-> ReadPrec [PauseRequest]
-> Read PauseRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PauseRequest]
$creadListPrec :: ReadPrec [PauseRequest]
readPrec :: ReadPrec PauseRequest
$creadPrec :: ReadPrec PauseRequest
readList :: ReadS [PauseRequest]
$creadList :: ReadS [PauseRequest]
readsPrec :: Int -> ReadS PauseRequest
$creadsPrec :: Int -> ReadS PauseRequest
Read, PauseRequest -> PauseRequest -> Bool
(PauseRequest -> PauseRequest -> Bool)
-> (PauseRequest -> PauseRequest -> Bool) -> Eq PauseRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PauseRequest -> PauseRequest -> Bool
$c/= :: PauseRequest -> PauseRequest -> Bool
== :: PauseRequest -> PauseRequest -> Bool
$c== :: PauseRequest -> PauseRequest -> Bool
Eq)


-- |
--   Arguments for "pause" request.
--
data PauseRequestArguments =
  PauseArguments {
    PauseRequestArguments -> Int
threadIdPauseRequestArguments :: Int  -- ^Pause execution for this thread.
  } deriving (Int -> PauseRequestArguments -> ShowS
[PauseRequestArguments] -> ShowS
PauseRequestArguments -> String
(Int -> PauseRequestArguments -> ShowS)
-> (PauseRequestArguments -> String)
-> ([PauseRequestArguments] -> ShowS)
-> Show PauseRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PauseRequestArguments] -> ShowS
$cshowList :: [PauseRequestArguments] -> ShowS
show :: PauseRequestArguments -> String
$cshow :: PauseRequestArguments -> String
showsPrec :: Int -> PauseRequestArguments -> ShowS
$cshowsPrec :: Int -> PauseRequestArguments -> ShowS
Show, ReadPrec [PauseRequestArguments]
ReadPrec PauseRequestArguments
Int -> ReadS PauseRequestArguments
ReadS [PauseRequestArguments]
(Int -> ReadS PauseRequestArguments)
-> ReadS [PauseRequestArguments]
-> ReadPrec PauseRequestArguments
-> ReadPrec [PauseRequestArguments]
-> Read PauseRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PauseRequestArguments]
$creadListPrec :: ReadPrec [PauseRequestArguments]
readPrec :: ReadPrec PauseRequestArguments
$creadPrec :: ReadPrec PauseRequestArguments
readList :: ReadS [PauseRequestArguments]
$creadList :: ReadS [PauseRequestArguments]
readsPrec :: Int -> ReadS PauseRequestArguments
$creadsPrec :: Int -> ReadS PauseRequestArguments
Read, PauseRequestArguments -> PauseRequestArguments -> Bool
(PauseRequestArguments -> PauseRequestArguments -> Bool)
-> (PauseRequestArguments -> PauseRequestArguments -> Bool)
-> Eq PauseRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PauseRequestArguments -> PauseRequestArguments -> Bool
$c/= :: PauseRequestArguments -> PauseRequestArguments -> Bool
== :: PauseRequestArguments -> PauseRequestArguments -> Bool
$c== :: PauseRequestArguments -> PauseRequestArguments -> Bool
Eq)


-- |
--   Response to "pause" request. This is just an acknowledgement, so no body field is required.
--
data PauseResponse =
  PauseResponse {
    PauseResponse -> Int
seqPauseResponse         :: Int     -- ^Sequence number
  , PauseResponse -> String
typePauseResponse        :: String  -- ^One of "request", "response", or "event"
  , PauseResponse -> Int
request_seqPauseResponse :: Int     -- ^Sequence number of the corresponding request
  , PauseResponse -> Bool
successPauseResponse     :: Bool    -- ^Outcome of the request
  , PauseResponse -> String
commandPauseResponse     :: String  -- ^The command requested
  , PauseResponse -> String
messagePauseResponse     :: String  -- ^Contains error message if success == false.
  } deriving (Int -> PauseResponse -> ShowS
[PauseResponse] -> ShowS
PauseResponse -> String
(Int -> PauseResponse -> ShowS)
-> (PauseResponse -> String)
-> ([PauseResponse] -> ShowS)
-> Show PauseResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PauseResponse] -> ShowS
$cshowList :: [PauseResponse] -> ShowS
show :: PauseResponse -> String
$cshow :: PauseResponse -> String
showsPrec :: Int -> PauseResponse -> ShowS
$cshowsPrec :: Int -> PauseResponse -> ShowS
Show, ReadPrec [PauseResponse]
ReadPrec PauseResponse
Int -> ReadS PauseResponse
ReadS [PauseResponse]
(Int -> ReadS PauseResponse)
-> ReadS [PauseResponse]
-> ReadPrec PauseResponse
-> ReadPrec [PauseResponse]
-> Read PauseResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PauseResponse]
$creadListPrec :: ReadPrec [PauseResponse]
readPrec :: ReadPrec PauseResponse
$creadPrec :: ReadPrec PauseResponse
readList :: ReadS [PauseResponse]
$creadList :: ReadS [PauseResponse]
readsPrec :: Int -> ReadS PauseResponse
$creadsPrec :: Int -> ReadS PauseResponse
Read, PauseResponse -> PauseResponse -> Bool
(PauseResponse -> PauseResponse -> Bool)
-> (PauseResponse -> PauseResponse -> Bool) -> Eq PauseResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PauseResponse -> PauseResponse -> Bool
$c/= :: PauseResponse -> PauseResponse -> Bool
== :: PauseResponse -> PauseResponse -> Bool
$c== :: PauseResponse -> PauseResponse -> Bool
Eq)


-- |
--
defaultPauseResponse :: PauseResponse
defaultPauseResponse :: PauseResponse
defaultPauseResponse = PauseResponse :: Int -> String -> Int -> Bool -> String -> String -> PauseResponse
PauseResponse {
    seqPauseResponse :: Int
seqPauseResponse         = Int
0
  , typePauseResponse :: String
typePauseResponse        = String
"response"
  , request_seqPauseResponse :: Int
request_seqPauseResponse = Int
0
  , successPauseResponse :: Bool
successPauseResponse     = Bool
False
  , commandPauseResponse :: String
commandPauseResponse     = String
"pause"
  , messagePauseResponse :: String
messagePauseResponse     = String
""
  }




----------------------------------------------------------------------------
--  Terminate
----------------------------------------------------------------------------

-- |
--   Terminate request; value of command field is 'terminate'.
--
--	The 'terminate' request is sent from the client to the debug adapter in order to give the debuggee a chance for terminating itself.
--
data TerminateRequest =
  TerminateRequest {
    TerminateRequest -> Int
seqTerminateRequest       :: Int                        -- ^Sequence number
  , TerminateRequest -> String
typeTerminateRequest      :: String                     -- ^One of "request", "response", or "event"
  , TerminateRequest -> String
commandTerminateRequest   :: String                     -- ^The command to execute
  , TerminateRequest -> Maybe TerminateRequestArguments
argumentsTerminateRequest :: Maybe TerminateRequestArguments  -- ^Arguments for "terminate" request.
  } deriving (Int -> TerminateRequest -> ShowS
[TerminateRequest] -> ShowS
TerminateRequest -> String
(Int -> TerminateRequest -> ShowS)
-> (TerminateRequest -> String)
-> ([TerminateRequest] -> ShowS)
-> Show TerminateRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TerminateRequest] -> ShowS
$cshowList :: [TerminateRequest] -> ShowS
show :: TerminateRequest -> String
$cshow :: TerminateRequest -> String
showsPrec :: Int -> TerminateRequest -> ShowS
$cshowsPrec :: Int -> TerminateRequest -> ShowS
Show, ReadPrec [TerminateRequest]
ReadPrec TerminateRequest
Int -> ReadS TerminateRequest
ReadS [TerminateRequest]
(Int -> ReadS TerminateRequest)
-> ReadS [TerminateRequest]
-> ReadPrec TerminateRequest
-> ReadPrec [TerminateRequest]
-> Read TerminateRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TerminateRequest]
$creadListPrec :: ReadPrec [TerminateRequest]
readPrec :: ReadPrec TerminateRequest
$creadPrec :: ReadPrec TerminateRequest
readList :: ReadS [TerminateRequest]
$creadList :: ReadS [TerminateRequest]
readsPrec :: Int -> ReadS TerminateRequest
$creadsPrec :: Int -> ReadS TerminateRequest
Read, TerminateRequest -> TerminateRequest -> Bool
(TerminateRequest -> TerminateRequest -> Bool)
-> (TerminateRequest -> TerminateRequest -> Bool)
-> Eq TerminateRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TerminateRequest -> TerminateRequest -> Bool
$c/= :: TerminateRequest -> TerminateRequest -> Bool
== :: TerminateRequest -> TerminateRequest -> Bool
$c== :: TerminateRequest -> TerminateRequest -> Bool
Eq)


-- |
--   Arguments for 'terminate' request.
--
data TerminateRequestArguments =
  TerminateArguments {
    TerminateRequestArguments -> Maybe Bool
restartTerminateRequestArguments :: Maybe Bool  -- ^A value of true indicates that this 'terminate' request is part of a restart sequence.
  } deriving (Int -> TerminateRequestArguments -> ShowS
[TerminateRequestArguments] -> ShowS
TerminateRequestArguments -> String
(Int -> TerminateRequestArguments -> ShowS)
-> (TerminateRequestArguments -> String)
-> ([TerminateRequestArguments] -> ShowS)
-> Show TerminateRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TerminateRequestArguments] -> ShowS
$cshowList :: [TerminateRequestArguments] -> ShowS
show :: TerminateRequestArguments -> String
$cshow :: TerminateRequestArguments -> String
showsPrec :: Int -> TerminateRequestArguments -> ShowS
$cshowsPrec :: Int -> TerminateRequestArguments -> ShowS
Show, ReadPrec [TerminateRequestArguments]
ReadPrec TerminateRequestArguments
Int -> ReadS TerminateRequestArguments
ReadS [TerminateRequestArguments]
(Int -> ReadS TerminateRequestArguments)
-> ReadS [TerminateRequestArguments]
-> ReadPrec TerminateRequestArguments
-> ReadPrec [TerminateRequestArguments]
-> Read TerminateRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TerminateRequestArguments]
$creadListPrec :: ReadPrec [TerminateRequestArguments]
readPrec :: ReadPrec TerminateRequestArguments
$creadPrec :: ReadPrec TerminateRequestArguments
readList :: ReadS [TerminateRequestArguments]
$creadList :: ReadS [TerminateRequestArguments]
readsPrec :: Int -> ReadS TerminateRequestArguments
$creadsPrec :: Int -> ReadS TerminateRequestArguments
Read, TerminateRequestArguments -> TerminateRequestArguments -> Bool
(TerminateRequestArguments -> TerminateRequestArguments -> Bool)
-> (TerminateRequestArguments -> TerminateRequestArguments -> Bool)
-> Eq TerminateRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TerminateRequestArguments -> TerminateRequestArguments -> Bool
$c/= :: TerminateRequestArguments -> TerminateRequestArguments -> Bool
== :: TerminateRequestArguments -> TerminateRequestArguments -> Bool
$c== :: TerminateRequestArguments -> TerminateRequestArguments -> Bool
Eq)


-- |
--   Response to 'terminate' request. This is just an acknowledgement, so no body field is required.
--
data TerminateResponse =
  TerminateResponse {
    TerminateResponse -> Int
seqTerminateResponse         :: Int     -- ^Sequence number
  , TerminateResponse -> String
typeTerminateResponse        :: String  -- ^One of "request", "response", or "event"
  , TerminateResponse -> Int
request_seqTerminateResponse :: Int     -- ^Sequence number of the corresponding request
  , TerminateResponse -> Bool
successTerminateResponse     :: Bool    -- ^Outcome of the request
  , TerminateResponse -> String
commandTerminateResponse     :: String  -- ^The command requested
  , TerminateResponse -> String
messageTerminateResponse     :: String  -- ^Contains error message if success == false.
  } deriving (Int -> TerminateResponse -> ShowS
[TerminateResponse] -> ShowS
TerminateResponse -> String
(Int -> TerminateResponse -> ShowS)
-> (TerminateResponse -> String)
-> ([TerminateResponse] -> ShowS)
-> Show TerminateResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TerminateResponse] -> ShowS
$cshowList :: [TerminateResponse] -> ShowS
show :: TerminateResponse -> String
$cshow :: TerminateResponse -> String
showsPrec :: Int -> TerminateResponse -> ShowS
$cshowsPrec :: Int -> TerminateResponse -> ShowS
Show, ReadPrec [TerminateResponse]
ReadPrec TerminateResponse
Int -> ReadS TerminateResponse
ReadS [TerminateResponse]
(Int -> ReadS TerminateResponse)
-> ReadS [TerminateResponse]
-> ReadPrec TerminateResponse
-> ReadPrec [TerminateResponse]
-> Read TerminateResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TerminateResponse]
$creadListPrec :: ReadPrec [TerminateResponse]
readPrec :: ReadPrec TerminateResponse
$creadPrec :: ReadPrec TerminateResponse
readList :: ReadS [TerminateResponse]
$creadList :: ReadS [TerminateResponse]
readsPrec :: Int -> ReadS TerminateResponse
$creadsPrec :: Int -> ReadS TerminateResponse
Read, TerminateResponse -> TerminateResponse -> Bool
(TerminateResponse -> TerminateResponse -> Bool)
-> (TerminateResponse -> TerminateResponse -> Bool)
-> Eq TerminateResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TerminateResponse -> TerminateResponse -> Bool
$c/= :: TerminateResponse -> TerminateResponse -> Bool
== :: TerminateResponse -> TerminateResponse -> Bool
$c== :: TerminateResponse -> TerminateResponse -> Bool
Eq)


-- |
--
defaultTerminateResponse :: TerminateResponse
defaultTerminateResponse :: TerminateResponse
defaultTerminateResponse = TerminateResponse :: Int
-> String -> Int -> Bool -> String -> String -> TerminateResponse
TerminateResponse {
    seqTerminateResponse :: Int
seqTerminateResponse         = Int
0
  , typeTerminateResponse :: String
typeTerminateResponse        = String
"response"
  , request_seqTerminateResponse :: Int
request_seqTerminateResponse = Int
0
  , successTerminateResponse :: Bool
successTerminateResponse     = Bool
False
  , commandTerminateResponse :: String
commandTerminateResponse     = String
"terminate"
  , messageTerminateResponse :: String
messageTerminateResponse     = String
""
  }


----------------------------------------------------------------------------
--  Launch
----------------------------------------------------------------------------

-- |
--   Launch request; value of command field is 'launch'.
--
--		The launch request is sent from the client to the debug adapter to start the debuggee with or without debugging (if 'noDebug' is true).
--
--     Since launching is debugger/runtime specific, the arguments for this request are not part of this specification.
--
data LaunchRequest =
  LaunchRequest {
    LaunchRequest -> Int
seqLaunchRequest       :: Int                     -- ^Sequence number
  , LaunchRequest -> String
typeLaunchRequest      :: String                  -- ^One of "request", "response", or "event"
  , LaunchRequest -> String
commandLaunchRequest   :: String                  -- ^The command to execute
  , LaunchRequest -> LaunchRequestArguments
argumentsLaunchRequest :: LaunchRequestArguments  -- ^Arguments for "launch" request.
  } deriving (Int -> LaunchRequest -> ShowS
[LaunchRequest] -> ShowS
LaunchRequest -> String
(Int -> LaunchRequest -> ShowS)
-> (LaunchRequest -> String)
-> ([LaunchRequest] -> ShowS)
-> Show LaunchRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LaunchRequest] -> ShowS
$cshowList :: [LaunchRequest] -> ShowS
show :: LaunchRequest -> String
$cshow :: LaunchRequest -> String
showsPrec :: Int -> LaunchRequest -> ShowS
$cshowsPrec :: Int -> LaunchRequest -> ShowS
Show, ReadPrec [LaunchRequest]
ReadPrec LaunchRequest
Int -> ReadS LaunchRequest
ReadS [LaunchRequest]
(Int -> ReadS LaunchRequest)
-> ReadS [LaunchRequest]
-> ReadPrec LaunchRequest
-> ReadPrec [LaunchRequest]
-> Read LaunchRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LaunchRequest]
$creadListPrec :: ReadPrec [LaunchRequest]
readPrec :: ReadPrec LaunchRequest
$creadPrec :: ReadPrec LaunchRequest
readList :: ReadS [LaunchRequest]
$creadList :: ReadS [LaunchRequest]
readsPrec :: Int -> ReadS LaunchRequest
$creadsPrec :: Int -> ReadS LaunchRequest
Read, LaunchRequest -> LaunchRequest -> Bool
(LaunchRequest -> LaunchRequest -> Bool)
-> (LaunchRequest -> LaunchRequest -> Bool) -> Eq LaunchRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LaunchRequest -> LaunchRequest -> Bool
$c/= :: LaunchRequest -> LaunchRequest -> Bool
== :: LaunchRequest -> LaunchRequest -> Bool
$c== :: LaunchRequest -> LaunchRequest -> Bool
Eq)


-- |
--   Arguments for 'launch' request. Additional attributes are implementation specific.
--
data LaunchRequestArguments =
  LaunchRequestArguments {
    LaunchRequestArguments -> Maybe Bool
noDebugLaunchRequestArguments      :: Maybe Bool -- ^If noDebug is true the launch request should launch the program without enabling debugging.
  , LaunchRequestArguments -> String
nameLaunchRequestArguments         :: String     -- ^Phoityne specific argument. Must be "haskell-debug-adapter".
  , LaunchRequestArguments -> String
typeLaunchRequestArguments         :: String     -- ^Phoityne specific argument. Must be "ghc".
  , LaunchRequestArguments -> String
requestLaunchRequestArguments      :: String     -- ^Phoityne specific argument. Must be "launch".
  , LaunchRequestArguments -> String
startupLaunchRequestArguments      :: String     -- ^Phoityne specific argument. The path to debug start file.
  , LaunchRequestArguments -> String
workspaceLaunchRequestArguments    :: String     -- ^Phoityne specific argument. The path to debugee workspace.
  , LaunchRequestArguments -> String
logFileLaunchRequestArguments      :: String     -- ^Phoityne specific argument. The path to the log file.
  , LaunchRequestArguments -> String
logLevelLaunchRequestArguments     :: String     -- ^Phoityne specific argument. The Logging Prioryt
  , LaunchRequestArguments -> String
ghciPromptLaunchRequestArguments   :: String     -- ^Phoityne specific argument. The ghci prompt used by hda.
  , LaunchRequestArguments -> String
ghciCmdLaunchRequestArguments      :: String     -- ^Phoityne specific argument. The command to start debugging.
  , LaunchRequestArguments -> Bool
stopOnEntryLaunchRequestArguments  :: Bool       -- ^Phoityne specific argument. Stop at the debugged function entry point.
  , LaunchRequestArguments -> Maybe String
mainArgsLaunchRequestArguments     :: Maybe String         -- ^Phoityne specific argument. required. Arguments of main function.
  , LaunchRequestArguments -> Map String String
ghciEnvLaunchRequestArguments      :: M.Map String String  -- ^Phoityne specific argument. required. Additional Environments while debugging.
  , LaunchRequestArguments -> Maybe String
ghciInitialPromptLaunchRequestArguments :: Maybe String    -- ^Phoityne specific argument. The ghci initial prompt.
  , LaunchRequestArguments -> Maybe String
startupFuncLaunchRequestArguments  :: Maybe String         -- ^Phoityne specific argument. The debug entry function.
  , LaunchRequestArguments -> Maybe String
startupArgsLaunchRequestArguments  :: Maybe String         -- ^Phoityne specific argument. Arguments of the debug entry function.
  , LaunchRequestArguments -> Maybe Bool
forceInspectLaunchRequestArguments :: Maybe Bool           -- ^Phoityne specific argument. Inspect variable force.
  } deriving (Int -> LaunchRequestArguments -> ShowS
[LaunchRequestArguments] -> ShowS
LaunchRequestArguments -> String
(Int -> LaunchRequestArguments -> ShowS)
-> (LaunchRequestArguments -> String)
-> ([LaunchRequestArguments] -> ShowS)
-> Show LaunchRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LaunchRequestArguments] -> ShowS
$cshowList :: [LaunchRequestArguments] -> ShowS
show :: LaunchRequestArguments -> String
$cshow :: LaunchRequestArguments -> String
showsPrec :: Int -> LaunchRequestArguments -> ShowS
$cshowsPrec :: Int -> LaunchRequestArguments -> ShowS
Show, ReadPrec [LaunchRequestArguments]
ReadPrec LaunchRequestArguments
Int -> ReadS LaunchRequestArguments
ReadS [LaunchRequestArguments]
(Int -> ReadS LaunchRequestArguments)
-> ReadS [LaunchRequestArguments]
-> ReadPrec LaunchRequestArguments
-> ReadPrec [LaunchRequestArguments]
-> Read LaunchRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LaunchRequestArguments]
$creadListPrec :: ReadPrec [LaunchRequestArguments]
readPrec :: ReadPrec LaunchRequestArguments
$creadPrec :: ReadPrec LaunchRequestArguments
readList :: ReadS [LaunchRequestArguments]
$creadList :: ReadS [LaunchRequestArguments]
readsPrec :: Int -> ReadS LaunchRequestArguments
$creadsPrec :: Int -> ReadS LaunchRequestArguments
Read, LaunchRequestArguments -> LaunchRequestArguments -> Bool
(LaunchRequestArguments -> LaunchRequestArguments -> Bool)
-> (LaunchRequestArguments -> LaunchRequestArguments -> Bool)
-> Eq LaunchRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LaunchRequestArguments -> LaunchRequestArguments -> Bool
$c/= :: LaunchRequestArguments -> LaunchRequestArguments -> Bool
== :: LaunchRequestArguments -> LaunchRequestArguments -> Bool
$c== :: LaunchRequestArguments -> LaunchRequestArguments -> Bool
Eq)


-- |
--   Response to 'launch' request. This is just an acknowledgement, so no body field is required.
--
data LaunchResponse =
  LaunchResponse {
    LaunchResponse -> Int
seqLaunchResponse         :: Int     -- ^Sequence number
  , LaunchResponse -> String
typeLaunchResponse        :: String  -- ^One of "request", "response", or "event"
  , LaunchResponse -> Int
request_seqLaunchResponse :: Int     -- ^Sequence number of the corresponding request
  , LaunchResponse -> Bool
successLaunchResponse     :: Bool    -- ^Outcome of the request
  , LaunchResponse -> String
commandLaunchResponse     :: String  -- ^The command requested
  , LaunchResponse -> String
messageLaunchResponse     :: String  -- ^Contains error message if success == false.
  } deriving (Int -> LaunchResponse -> ShowS
[LaunchResponse] -> ShowS
LaunchResponse -> String
(Int -> LaunchResponse -> ShowS)
-> (LaunchResponse -> String)
-> ([LaunchResponse] -> ShowS)
-> Show LaunchResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LaunchResponse] -> ShowS
$cshowList :: [LaunchResponse] -> ShowS
show :: LaunchResponse -> String
$cshow :: LaunchResponse -> String
showsPrec :: Int -> LaunchResponse -> ShowS
$cshowsPrec :: Int -> LaunchResponse -> ShowS
Show, ReadPrec [LaunchResponse]
ReadPrec LaunchResponse
Int -> ReadS LaunchResponse
ReadS [LaunchResponse]
(Int -> ReadS LaunchResponse)
-> ReadS [LaunchResponse]
-> ReadPrec LaunchResponse
-> ReadPrec [LaunchResponse]
-> Read LaunchResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LaunchResponse]
$creadListPrec :: ReadPrec [LaunchResponse]
readPrec :: ReadPrec LaunchResponse
$creadPrec :: ReadPrec LaunchResponse
readList :: ReadS [LaunchResponse]
$creadList :: ReadS [LaunchResponse]
readsPrec :: Int -> ReadS LaunchResponse
$creadsPrec :: Int -> ReadS LaunchResponse
Read, LaunchResponse -> LaunchResponse -> Bool
(LaunchResponse -> LaunchResponse -> Bool)
-> (LaunchResponse -> LaunchResponse -> Bool) -> Eq LaunchResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LaunchResponse -> LaunchResponse -> Bool
$c/= :: LaunchResponse -> LaunchResponse -> Bool
== :: LaunchResponse -> LaunchResponse -> Bool
$c== :: LaunchResponse -> LaunchResponse -> Bool
Eq)


-- |
--
defaultLaunchResponse :: LaunchResponse
defaultLaunchResponse :: LaunchResponse
defaultLaunchResponse = LaunchResponse :: Int -> String -> Int -> Bool -> String -> String -> LaunchResponse
LaunchResponse {
    seqLaunchResponse :: Int
seqLaunchResponse         = Int
0
  , typeLaunchResponse :: String
typeLaunchResponse        = String
"response"
  , request_seqLaunchResponse :: Int
request_seqLaunchResponse = Int
0
  , successLaunchResponse :: Bool
successLaunchResponse     = Bool
False
  , commandLaunchResponse :: String
commandLaunchResponse     = String
"launch"
  , messageLaunchResponse :: String
messageLaunchResponse     = String
""
  }


----------------------------------------------------------------------------
--  SetBreakpoints
----------------------------------------------------------------------------

-- |
--   Properties of a breakpoint passed to the setBreakpoints request.
--
data SourceBreakpoint =
  SourceBreakpoint {
    SourceBreakpoint -> Int
lineSourceBreakpoint         :: Int           -- ^The source line of the breakpoint.
  , SourceBreakpoint -> Maybe Int
columnSourceBreakpoint       :: Maybe Int     -- ^An optional source column of the breakpoint.
  , SourceBreakpoint -> Maybe String
conditionSourceBreakpoint    :: Maybe String  -- ^An optional expression for conditional breakpoints.
  , SourceBreakpoint -> Maybe String
hitConditionSourceBreakpoint :: Maybe String  -- ^An optional expression that controls how many hits of the breakpoint are ignored. The backend is expected to interpret the expression as needed.
  , SourceBreakpoint -> Maybe String
logMessageSourceBreakpoint   :: Maybe String  -- ^If this attribute exists and is non-empty, the backend must not 'break' (stop) but log the message instead. Expressions within {} are interpolated.
  } deriving (Int -> SourceBreakpoint -> ShowS
[SourceBreakpoint] -> ShowS
SourceBreakpoint -> String
(Int -> SourceBreakpoint -> ShowS)
-> (SourceBreakpoint -> String)
-> ([SourceBreakpoint] -> ShowS)
-> Show SourceBreakpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceBreakpoint] -> ShowS
$cshowList :: [SourceBreakpoint] -> ShowS
show :: SourceBreakpoint -> String
$cshow :: SourceBreakpoint -> String
showsPrec :: Int -> SourceBreakpoint -> ShowS
$cshowsPrec :: Int -> SourceBreakpoint -> ShowS
Show, ReadPrec [SourceBreakpoint]
ReadPrec SourceBreakpoint
Int -> ReadS SourceBreakpoint
ReadS [SourceBreakpoint]
(Int -> ReadS SourceBreakpoint)
-> ReadS [SourceBreakpoint]
-> ReadPrec SourceBreakpoint
-> ReadPrec [SourceBreakpoint]
-> Read SourceBreakpoint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SourceBreakpoint]
$creadListPrec :: ReadPrec [SourceBreakpoint]
readPrec :: ReadPrec SourceBreakpoint
$creadPrec :: ReadPrec SourceBreakpoint
readList :: ReadS [SourceBreakpoint]
$creadList :: ReadS [SourceBreakpoint]
readsPrec :: Int -> ReadS SourceBreakpoint
$creadsPrec :: Int -> ReadS SourceBreakpoint
Read, SourceBreakpoint -> SourceBreakpoint -> Bool
(SourceBreakpoint -> SourceBreakpoint -> Bool)
-> (SourceBreakpoint -> SourceBreakpoint -> Bool)
-> Eq SourceBreakpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceBreakpoint -> SourceBreakpoint -> Bool
$c/= :: SourceBreakpoint -> SourceBreakpoint -> Bool
== :: SourceBreakpoint -> SourceBreakpoint -> Bool
$c== :: SourceBreakpoint -> SourceBreakpoint -> Bool
Eq)

-- |
--   SetBreakpoints request; value of command field is "setBreakpoints".
--
--   Sets multiple breakpoints for a single source and clears all previous breakpoints in that source.
--
--   To clear all breakpoint for a source, specify an empty array.
--
--   When a breakpoint is hit, a StoppedEvent (event type 'breakpoint') is generated.
--
data SetBreakpointsRequest =
  SetBreakpointsRequest {
    SetBreakpointsRequest -> Int
seqSetBreakpointsRequest       :: Int                      -- ^Sequence number
  , SetBreakpointsRequest -> String
typeSetBreakpointsRequest      :: String                   -- ^One of "request", "response", or "event"
  , SetBreakpointsRequest -> String
commandSetBreakpointsRequest   :: String                   -- ^The command to execute
  , SetBreakpointsRequest -> SetBreakpointsRequestArguments
argumentsSetBreakpointsRequest :: SetBreakpointsRequestArguments  -- ^Arguments for "setBreakpoints" request.
  } deriving (Int -> SetBreakpointsRequest -> ShowS
[SetBreakpointsRequest] -> ShowS
SetBreakpointsRequest -> String
(Int -> SetBreakpointsRequest -> ShowS)
-> (SetBreakpointsRequest -> String)
-> ([SetBreakpointsRequest] -> ShowS)
-> Show SetBreakpointsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetBreakpointsRequest] -> ShowS
$cshowList :: [SetBreakpointsRequest] -> ShowS
show :: SetBreakpointsRequest -> String
$cshow :: SetBreakpointsRequest -> String
showsPrec :: Int -> SetBreakpointsRequest -> ShowS
$cshowsPrec :: Int -> SetBreakpointsRequest -> ShowS
Show, ReadPrec [SetBreakpointsRequest]
ReadPrec SetBreakpointsRequest
Int -> ReadS SetBreakpointsRequest
ReadS [SetBreakpointsRequest]
(Int -> ReadS SetBreakpointsRequest)
-> ReadS [SetBreakpointsRequest]
-> ReadPrec SetBreakpointsRequest
-> ReadPrec [SetBreakpointsRequest]
-> Read SetBreakpointsRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetBreakpointsRequest]
$creadListPrec :: ReadPrec [SetBreakpointsRequest]
readPrec :: ReadPrec SetBreakpointsRequest
$creadPrec :: ReadPrec SetBreakpointsRequest
readList :: ReadS [SetBreakpointsRequest]
$creadList :: ReadS [SetBreakpointsRequest]
readsPrec :: Int -> ReadS SetBreakpointsRequest
$creadsPrec :: Int -> ReadS SetBreakpointsRequest
Read, SetBreakpointsRequest -> SetBreakpointsRequest -> Bool
(SetBreakpointsRequest -> SetBreakpointsRequest -> Bool)
-> (SetBreakpointsRequest -> SetBreakpointsRequest -> Bool)
-> Eq SetBreakpointsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetBreakpointsRequest -> SetBreakpointsRequest -> Bool
$c/= :: SetBreakpointsRequest -> SetBreakpointsRequest -> Bool
== :: SetBreakpointsRequest -> SetBreakpointsRequest -> Bool
$c== :: SetBreakpointsRequest -> SetBreakpointsRequest -> Bool
Eq)



-- |
--   Arguments for 'setBreakpoints' request.
--
data SetBreakpointsRequestArguments =
  SetBreakpointsRequestArguments {
    SetBreakpointsRequestArguments -> Source
sourceSetBreakpointsRequestArguments         :: Source              -- ^The source location of the breakpoints; either source.path or source.reference must be specified.
  , SetBreakpointsRequestArguments -> [SourceBreakpoint]
breakpointsSetBreakpointsRequestArguments    :: [SourceBreakpoint]  -- ^The code locations of the breakpoints.
  } deriving (Int -> SetBreakpointsRequestArguments -> ShowS
[SetBreakpointsRequestArguments] -> ShowS
SetBreakpointsRequestArguments -> String
(Int -> SetBreakpointsRequestArguments -> ShowS)
-> (SetBreakpointsRequestArguments -> String)
-> ([SetBreakpointsRequestArguments] -> ShowS)
-> Show SetBreakpointsRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetBreakpointsRequestArguments] -> ShowS
$cshowList :: [SetBreakpointsRequestArguments] -> ShowS
show :: SetBreakpointsRequestArguments -> String
$cshow :: SetBreakpointsRequestArguments -> String
showsPrec :: Int -> SetBreakpointsRequestArguments -> ShowS
$cshowsPrec :: Int -> SetBreakpointsRequestArguments -> ShowS
Show, ReadPrec [SetBreakpointsRequestArguments]
ReadPrec SetBreakpointsRequestArguments
Int -> ReadS SetBreakpointsRequestArguments
ReadS [SetBreakpointsRequestArguments]
(Int -> ReadS SetBreakpointsRequestArguments)
-> ReadS [SetBreakpointsRequestArguments]
-> ReadPrec SetBreakpointsRequestArguments
-> ReadPrec [SetBreakpointsRequestArguments]
-> Read SetBreakpointsRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetBreakpointsRequestArguments]
$creadListPrec :: ReadPrec [SetBreakpointsRequestArguments]
readPrec :: ReadPrec SetBreakpointsRequestArguments
$creadPrec :: ReadPrec SetBreakpointsRequestArguments
readList :: ReadS [SetBreakpointsRequestArguments]
$creadList :: ReadS [SetBreakpointsRequestArguments]
readsPrec :: Int -> ReadS SetBreakpointsRequestArguments
$creadsPrec :: Int -> ReadS SetBreakpointsRequestArguments
Read, SetBreakpointsRequestArguments
-> SetBreakpointsRequestArguments -> Bool
(SetBreakpointsRequestArguments
 -> SetBreakpointsRequestArguments -> Bool)
-> (SetBreakpointsRequestArguments
    -> SetBreakpointsRequestArguments -> Bool)
-> Eq SetBreakpointsRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetBreakpointsRequestArguments
-> SetBreakpointsRequestArguments -> Bool
$c/= :: SetBreakpointsRequestArguments
-> SetBreakpointsRequestArguments -> Bool
== :: SetBreakpointsRequestArguments
-> SetBreakpointsRequestArguments -> Bool
$c== :: SetBreakpointsRequestArguments
-> SetBreakpointsRequestArguments -> Bool
Eq)



-- |
--   Response to "setBreakpoints" request.
--
--   Returned is information about each breakpoint created by this request.
--
--   This includes the actual code location and whether the breakpoint could be verified.
--
--   The breakpoints returned are in the same order as the elements of the 'breakpoints'
--
--   (or the deprecated 'lines') in the SetBreakpointsRequestArguments.
--
data SetBreakpointsResponse =
  SetBreakpointsResponse {
    SetBreakpointsResponse -> Int
seqSetBreakpointsResponse         :: Int     -- ^Sequence number
  , SetBreakpointsResponse -> String
typeSetBreakpointsResponse        :: String  -- ^One of "request", "response", or "event"
  , SetBreakpointsResponse -> Int
request_seqSetBreakpointsResponse :: Int     -- ^Sequence number of the corresponding request
  , SetBreakpointsResponse -> Bool
successSetBreakpointsResponse     :: Bool    -- ^Outcome of the request
  , SetBreakpointsResponse -> String
commandSetBreakpointsResponse     :: String  -- ^The command requested
  , SetBreakpointsResponse -> String
messageSetBreakpointsResponse     :: String  -- ^Contains error message if success == false.
  , SetBreakpointsResponse -> SetBreakpointsResponseBody
bodySetBreakpointsResponse        :: SetBreakpointsResponseBody -- ^The body of SetBreakpointsResponse.
  } deriving (Int -> SetBreakpointsResponse -> ShowS
[SetBreakpointsResponse] -> ShowS
SetBreakpointsResponse -> String
(Int -> SetBreakpointsResponse -> ShowS)
-> (SetBreakpointsResponse -> String)
-> ([SetBreakpointsResponse] -> ShowS)
-> Show SetBreakpointsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetBreakpointsResponse] -> ShowS
$cshowList :: [SetBreakpointsResponse] -> ShowS
show :: SetBreakpointsResponse -> String
$cshow :: SetBreakpointsResponse -> String
showsPrec :: Int -> SetBreakpointsResponse -> ShowS
$cshowsPrec :: Int -> SetBreakpointsResponse -> ShowS
Show, ReadPrec [SetBreakpointsResponse]
ReadPrec SetBreakpointsResponse
Int -> ReadS SetBreakpointsResponse
ReadS [SetBreakpointsResponse]
(Int -> ReadS SetBreakpointsResponse)
-> ReadS [SetBreakpointsResponse]
-> ReadPrec SetBreakpointsResponse
-> ReadPrec [SetBreakpointsResponse]
-> Read SetBreakpointsResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetBreakpointsResponse]
$creadListPrec :: ReadPrec [SetBreakpointsResponse]
readPrec :: ReadPrec SetBreakpointsResponse
$creadPrec :: ReadPrec SetBreakpointsResponse
readList :: ReadS [SetBreakpointsResponse]
$creadList :: ReadS [SetBreakpointsResponse]
readsPrec :: Int -> ReadS SetBreakpointsResponse
$creadsPrec :: Int -> ReadS SetBreakpointsResponse
Read, SetBreakpointsResponse -> SetBreakpointsResponse -> Bool
(SetBreakpointsResponse -> SetBreakpointsResponse -> Bool)
-> (SetBreakpointsResponse -> SetBreakpointsResponse -> Bool)
-> Eq SetBreakpointsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetBreakpointsResponse -> SetBreakpointsResponse -> Bool
$c/= :: SetBreakpointsResponse -> SetBreakpointsResponse -> Bool
== :: SetBreakpointsResponse -> SetBreakpointsResponse -> Bool
$c== :: SetBreakpointsResponse -> SetBreakpointsResponse -> Bool
Eq)


-- |
--
defaultSetBreakpointsResponse :: SetBreakpointsResponse
defaultSetBreakpointsResponse :: SetBreakpointsResponse
defaultSetBreakpointsResponse = SetBreakpointsResponse :: Int
-> String
-> Int
-> Bool
-> String
-> String
-> SetBreakpointsResponseBody
-> SetBreakpointsResponse
SetBreakpointsResponse {
    seqSetBreakpointsResponse :: Int
seqSetBreakpointsResponse         = Int
0
  , typeSetBreakpointsResponse :: String
typeSetBreakpointsResponse        = String
"response"
  , request_seqSetBreakpointsResponse :: Int
request_seqSetBreakpointsResponse = Int
0
  , successSetBreakpointsResponse :: Bool
successSetBreakpointsResponse     = Bool
False
  , commandSetBreakpointsResponse :: String
commandSetBreakpointsResponse     = String
"setBreakpoints"
  , messageSetBreakpointsResponse :: String
messageSetBreakpointsResponse     = String
""
  , bodySetBreakpointsResponse :: SetBreakpointsResponseBody
bodySetBreakpointsResponse        = SetBreakpointsResponseBody
defaultSetBreakpointsResponseBody
  }

-- |
--   Response to "setBreakpoints" request.
--
--   Returned is information about each breakpoint created by this request.
--
--   This includes the actual code location and whether the breakpoint could be verified.
--
--   The breakpoints returned are in the same order as the elements of the 'breakpoints'
--
--   (or the deprecated 'lines') in the SetBreakpointsRequestArguments.
--
data SetBreakpointsResponseBody =
  SetBreakpointsResponseBody {
    SetBreakpointsResponseBody -> [Breakpoint]
breakpointsSetBreakpointsResponseBody :: [Breakpoint]  -- ^Information about the breakpoints. The array elements are in the same order as the elements of the 'breakpoints' (or the deprecated 'lines') in the SetBreakpointsRequestArguments.
  } deriving (Int -> SetBreakpointsResponseBody -> ShowS
[SetBreakpointsResponseBody] -> ShowS
SetBreakpointsResponseBody -> String
(Int -> SetBreakpointsResponseBody -> ShowS)
-> (SetBreakpointsResponseBody -> String)
-> ([SetBreakpointsResponseBody] -> ShowS)
-> Show SetBreakpointsResponseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetBreakpointsResponseBody] -> ShowS
$cshowList :: [SetBreakpointsResponseBody] -> ShowS
show :: SetBreakpointsResponseBody -> String
$cshow :: SetBreakpointsResponseBody -> String
showsPrec :: Int -> SetBreakpointsResponseBody -> ShowS
$cshowsPrec :: Int -> SetBreakpointsResponseBody -> ShowS
Show, ReadPrec [SetBreakpointsResponseBody]
ReadPrec SetBreakpointsResponseBody
Int -> ReadS SetBreakpointsResponseBody
ReadS [SetBreakpointsResponseBody]
(Int -> ReadS SetBreakpointsResponseBody)
-> ReadS [SetBreakpointsResponseBody]
-> ReadPrec SetBreakpointsResponseBody
-> ReadPrec [SetBreakpointsResponseBody]
-> Read SetBreakpointsResponseBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetBreakpointsResponseBody]
$creadListPrec :: ReadPrec [SetBreakpointsResponseBody]
readPrec :: ReadPrec SetBreakpointsResponseBody
$creadPrec :: ReadPrec SetBreakpointsResponseBody
readList :: ReadS [SetBreakpointsResponseBody]
$creadList :: ReadS [SetBreakpointsResponseBody]
readsPrec :: Int -> ReadS SetBreakpointsResponseBody
$creadsPrec :: Int -> ReadS SetBreakpointsResponseBody
Read, SetBreakpointsResponseBody -> SetBreakpointsResponseBody -> Bool
(SetBreakpointsResponseBody -> SetBreakpointsResponseBody -> Bool)
-> (SetBreakpointsResponseBody
    -> SetBreakpointsResponseBody -> Bool)
-> Eq SetBreakpointsResponseBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetBreakpointsResponseBody -> SetBreakpointsResponseBody -> Bool
$c/= :: SetBreakpointsResponseBody -> SetBreakpointsResponseBody -> Bool
== :: SetBreakpointsResponseBody -> SetBreakpointsResponseBody -> Bool
$c== :: SetBreakpointsResponseBody -> SetBreakpointsResponseBody -> Bool
Eq)


-- |
--
defaultSetBreakpointsResponseBody :: SetBreakpointsResponseBody
defaultSetBreakpointsResponseBody :: SetBreakpointsResponseBody
defaultSetBreakpointsResponseBody = SetBreakpointsResponseBody :: [Breakpoint] -> SetBreakpointsResponseBody
SetBreakpointsResponseBody {
    breakpointsSetBreakpointsResponseBody :: [Breakpoint]
breakpointsSetBreakpointsResponseBody = []
  }


----------------------------------------------------------------------------
--  SetFunctionBreakpoints
----------------------------------------------------------------------------

-- |
--   Properties of a breakpoint passed to the setFunctionBreakpoints request.
--
data FunctionBreakpoint =
  FunctionBreakpoint {
    FunctionBreakpoint -> String
nameFunctionBreakpoint         :: String        -- The name of the function.
  , FunctionBreakpoint -> Maybe String
conditionFunctionBreakpoint    :: Maybe String  -- An optional expression for conditional breakpoints.
  , FunctionBreakpoint -> Maybe String
hitConditionFunctionBreakpoint :: Maybe String  -- An optional expression that controls how many hits of the breakpoint are ignored. The backend is expected to interpret the expression as needed.
  } deriving (Int -> FunctionBreakpoint -> ShowS
[FunctionBreakpoint] -> ShowS
FunctionBreakpoint -> String
(Int -> FunctionBreakpoint -> ShowS)
-> (FunctionBreakpoint -> String)
-> ([FunctionBreakpoint] -> ShowS)
-> Show FunctionBreakpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionBreakpoint] -> ShowS
$cshowList :: [FunctionBreakpoint] -> ShowS
show :: FunctionBreakpoint -> String
$cshow :: FunctionBreakpoint -> String
showsPrec :: Int -> FunctionBreakpoint -> ShowS
$cshowsPrec :: Int -> FunctionBreakpoint -> ShowS
Show, ReadPrec [FunctionBreakpoint]
ReadPrec FunctionBreakpoint
Int -> ReadS FunctionBreakpoint
ReadS [FunctionBreakpoint]
(Int -> ReadS FunctionBreakpoint)
-> ReadS [FunctionBreakpoint]
-> ReadPrec FunctionBreakpoint
-> ReadPrec [FunctionBreakpoint]
-> Read FunctionBreakpoint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FunctionBreakpoint]
$creadListPrec :: ReadPrec [FunctionBreakpoint]
readPrec :: ReadPrec FunctionBreakpoint
$creadPrec :: ReadPrec FunctionBreakpoint
readList :: ReadS [FunctionBreakpoint]
$creadList :: ReadS [FunctionBreakpoint]
readsPrec :: Int -> ReadS FunctionBreakpoint
$creadsPrec :: Int -> ReadS FunctionBreakpoint
Read, FunctionBreakpoint -> FunctionBreakpoint -> Bool
(FunctionBreakpoint -> FunctionBreakpoint -> Bool)
-> (FunctionBreakpoint -> FunctionBreakpoint -> Bool)
-> Eq FunctionBreakpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionBreakpoint -> FunctionBreakpoint -> Bool
$c/= :: FunctionBreakpoint -> FunctionBreakpoint -> Bool
== :: FunctionBreakpoint -> FunctionBreakpoint -> Bool
$c== :: FunctionBreakpoint -> FunctionBreakpoint -> Bool
Eq)


-- |
--   SetFunctionBreakpoints request; value of command field is "setFunctionBreakpoints".
--
--   Sets multiple function breakpoints and clears all previous function breakpoints.
--
--   To clear all function breakpoint, specify an empty array.
--
--   When a function breakpoint is hit, a StoppedEvent (event type 'function breakpoint') is generated.
--
data SetFunctionBreakpointsRequest =
  SetFunctionBreakpointsRequest {
    SetFunctionBreakpointsRequest -> Int
seqSetFunctionBreakpointsRequest       :: Int                             -- ^Sequence number
  , SetFunctionBreakpointsRequest -> String
typeSetFunctionBreakpointsRequest      :: String                          -- ^One of "request", "response", or "event"
  , SetFunctionBreakpointsRequest -> String
commandSetFunctionBreakpointsRequest   :: String                          -- ^The command to execute
  , SetFunctionBreakpointsRequest
-> SetFunctionBreakpointsRequestArguments
argumentsSetFunctionBreakpointsRequest :: SetFunctionBreakpointsRequestArguments -- ^Arguments for "setFunctionBreakpoints" request.
  } deriving (Int -> SetFunctionBreakpointsRequest -> ShowS
[SetFunctionBreakpointsRequest] -> ShowS
SetFunctionBreakpointsRequest -> String
(Int -> SetFunctionBreakpointsRequest -> ShowS)
-> (SetFunctionBreakpointsRequest -> String)
-> ([SetFunctionBreakpointsRequest] -> ShowS)
-> Show SetFunctionBreakpointsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetFunctionBreakpointsRequest] -> ShowS
$cshowList :: [SetFunctionBreakpointsRequest] -> ShowS
show :: SetFunctionBreakpointsRequest -> String
$cshow :: SetFunctionBreakpointsRequest -> String
showsPrec :: Int -> SetFunctionBreakpointsRequest -> ShowS
$cshowsPrec :: Int -> SetFunctionBreakpointsRequest -> ShowS
Show, ReadPrec [SetFunctionBreakpointsRequest]
ReadPrec SetFunctionBreakpointsRequest
Int -> ReadS SetFunctionBreakpointsRequest
ReadS [SetFunctionBreakpointsRequest]
(Int -> ReadS SetFunctionBreakpointsRequest)
-> ReadS [SetFunctionBreakpointsRequest]
-> ReadPrec SetFunctionBreakpointsRequest
-> ReadPrec [SetFunctionBreakpointsRequest]
-> Read SetFunctionBreakpointsRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetFunctionBreakpointsRequest]
$creadListPrec :: ReadPrec [SetFunctionBreakpointsRequest]
readPrec :: ReadPrec SetFunctionBreakpointsRequest
$creadPrec :: ReadPrec SetFunctionBreakpointsRequest
readList :: ReadS [SetFunctionBreakpointsRequest]
$creadList :: ReadS [SetFunctionBreakpointsRequest]
readsPrec :: Int -> ReadS SetFunctionBreakpointsRequest
$creadsPrec :: Int -> ReadS SetFunctionBreakpointsRequest
Read, SetFunctionBreakpointsRequest
-> SetFunctionBreakpointsRequest -> Bool
(SetFunctionBreakpointsRequest
 -> SetFunctionBreakpointsRequest -> Bool)
-> (SetFunctionBreakpointsRequest
    -> SetFunctionBreakpointsRequest -> Bool)
-> Eq SetFunctionBreakpointsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetFunctionBreakpointsRequest
-> SetFunctionBreakpointsRequest -> Bool
$c/= :: SetFunctionBreakpointsRequest
-> SetFunctionBreakpointsRequest -> Bool
== :: SetFunctionBreakpointsRequest
-> SetFunctionBreakpointsRequest -> Bool
$c== :: SetFunctionBreakpointsRequest
-> SetFunctionBreakpointsRequest -> Bool
Eq)


-- |
--   Arguments for 'setFunctionBreakpoints' request.
--
data SetFunctionBreakpointsRequestArguments =
  SetFunctionBreakpointsRequestArguments {
    SetFunctionBreakpointsRequestArguments -> [FunctionBreakpoint]
breakpointsSetFunctionBreakpointsRequestArguments    :: [FunctionBreakpoint]  -- ^The function names of the breakpoints.
  } deriving (Int -> SetFunctionBreakpointsRequestArguments -> ShowS
[SetFunctionBreakpointsRequestArguments] -> ShowS
SetFunctionBreakpointsRequestArguments -> String
(Int -> SetFunctionBreakpointsRequestArguments -> ShowS)
-> (SetFunctionBreakpointsRequestArguments -> String)
-> ([SetFunctionBreakpointsRequestArguments] -> ShowS)
-> Show SetFunctionBreakpointsRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetFunctionBreakpointsRequestArguments] -> ShowS
$cshowList :: [SetFunctionBreakpointsRequestArguments] -> ShowS
show :: SetFunctionBreakpointsRequestArguments -> String
$cshow :: SetFunctionBreakpointsRequestArguments -> String
showsPrec :: Int -> SetFunctionBreakpointsRequestArguments -> ShowS
$cshowsPrec :: Int -> SetFunctionBreakpointsRequestArguments -> ShowS
Show, ReadPrec [SetFunctionBreakpointsRequestArguments]
ReadPrec SetFunctionBreakpointsRequestArguments
Int -> ReadS SetFunctionBreakpointsRequestArguments
ReadS [SetFunctionBreakpointsRequestArguments]
(Int -> ReadS SetFunctionBreakpointsRequestArguments)
-> ReadS [SetFunctionBreakpointsRequestArguments]
-> ReadPrec SetFunctionBreakpointsRequestArguments
-> ReadPrec [SetFunctionBreakpointsRequestArguments]
-> Read SetFunctionBreakpointsRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetFunctionBreakpointsRequestArguments]
$creadListPrec :: ReadPrec [SetFunctionBreakpointsRequestArguments]
readPrec :: ReadPrec SetFunctionBreakpointsRequestArguments
$creadPrec :: ReadPrec SetFunctionBreakpointsRequestArguments
readList :: ReadS [SetFunctionBreakpointsRequestArguments]
$creadList :: ReadS [SetFunctionBreakpointsRequestArguments]
readsPrec :: Int -> ReadS SetFunctionBreakpointsRequestArguments
$creadsPrec :: Int -> ReadS SetFunctionBreakpointsRequestArguments
Read, SetFunctionBreakpointsRequestArguments
-> SetFunctionBreakpointsRequestArguments -> Bool
(SetFunctionBreakpointsRequestArguments
 -> SetFunctionBreakpointsRequestArguments -> Bool)
-> (SetFunctionBreakpointsRequestArguments
    -> SetFunctionBreakpointsRequestArguments -> Bool)
-> Eq SetFunctionBreakpointsRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetFunctionBreakpointsRequestArguments
-> SetFunctionBreakpointsRequestArguments -> Bool
$c/= :: SetFunctionBreakpointsRequestArguments
-> SetFunctionBreakpointsRequestArguments -> Bool
== :: SetFunctionBreakpointsRequestArguments
-> SetFunctionBreakpointsRequestArguments -> Bool
$c== :: SetFunctionBreakpointsRequestArguments
-> SetFunctionBreakpointsRequestArguments -> Bool
Eq)


-- |
--   Response to "setFunctionBreakpoints" request.
--
data SetFunctionBreakpointsResponse =
  SetFunctionBreakpointsResponse {
    SetFunctionBreakpointsResponse -> Int
seqSetFunctionBreakpointsResponse         :: Int     -- ^Sequence number
  , SetFunctionBreakpointsResponse -> String
typeSetFunctionBreakpointsResponse        :: String  -- ^One of "request", "response", or "event"
  , SetFunctionBreakpointsResponse -> Int
request_seqSetFunctionBreakpointsResponse :: Int     -- ^Sequence number of the corresponding request
  , SetFunctionBreakpointsResponse -> Bool
successSetFunctionBreakpointsResponse     :: Bool    -- ^Outcome of the request
  , SetFunctionBreakpointsResponse -> String
commandSetFunctionBreakpointsResponse     :: String  -- ^The command requested
  , SetFunctionBreakpointsResponse -> String
messageSetFunctionBreakpointsResponse     :: String  -- ^Contains error message if success == false.
  , SetFunctionBreakpointsResponse
-> SetFunctionBreakpointsResponseBody
bodySetFunctionBreakpointsResponse        :: SetFunctionBreakpointsResponseBody  -- ^The body of the SetFunctionBreakpointsResponse
  } deriving (Int -> SetFunctionBreakpointsResponse -> ShowS
[SetFunctionBreakpointsResponse] -> ShowS
SetFunctionBreakpointsResponse -> String
(Int -> SetFunctionBreakpointsResponse -> ShowS)
-> (SetFunctionBreakpointsResponse -> String)
-> ([SetFunctionBreakpointsResponse] -> ShowS)
-> Show SetFunctionBreakpointsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetFunctionBreakpointsResponse] -> ShowS
$cshowList :: [SetFunctionBreakpointsResponse] -> ShowS
show :: SetFunctionBreakpointsResponse -> String
$cshow :: SetFunctionBreakpointsResponse -> String
showsPrec :: Int -> SetFunctionBreakpointsResponse -> ShowS
$cshowsPrec :: Int -> SetFunctionBreakpointsResponse -> ShowS
Show, ReadPrec [SetFunctionBreakpointsResponse]
ReadPrec SetFunctionBreakpointsResponse
Int -> ReadS SetFunctionBreakpointsResponse
ReadS [SetFunctionBreakpointsResponse]
(Int -> ReadS SetFunctionBreakpointsResponse)
-> ReadS [SetFunctionBreakpointsResponse]
-> ReadPrec SetFunctionBreakpointsResponse
-> ReadPrec [SetFunctionBreakpointsResponse]
-> Read SetFunctionBreakpointsResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetFunctionBreakpointsResponse]
$creadListPrec :: ReadPrec [SetFunctionBreakpointsResponse]
readPrec :: ReadPrec SetFunctionBreakpointsResponse
$creadPrec :: ReadPrec SetFunctionBreakpointsResponse
readList :: ReadS [SetFunctionBreakpointsResponse]
$creadList :: ReadS [SetFunctionBreakpointsResponse]
readsPrec :: Int -> ReadS SetFunctionBreakpointsResponse
$creadsPrec :: Int -> ReadS SetFunctionBreakpointsResponse
Read, SetFunctionBreakpointsResponse
-> SetFunctionBreakpointsResponse -> Bool
(SetFunctionBreakpointsResponse
 -> SetFunctionBreakpointsResponse -> Bool)
-> (SetFunctionBreakpointsResponse
    -> SetFunctionBreakpointsResponse -> Bool)
-> Eq SetFunctionBreakpointsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetFunctionBreakpointsResponse
-> SetFunctionBreakpointsResponse -> Bool
$c/= :: SetFunctionBreakpointsResponse
-> SetFunctionBreakpointsResponse -> Bool
== :: SetFunctionBreakpointsResponse
-> SetFunctionBreakpointsResponse -> Bool
$c== :: SetFunctionBreakpointsResponse
-> SetFunctionBreakpointsResponse -> Bool
Eq)


-- |
--
defaultSetFunctionBreakpointsResponse :: SetFunctionBreakpointsResponse
defaultSetFunctionBreakpointsResponse :: SetFunctionBreakpointsResponse
defaultSetFunctionBreakpointsResponse = SetFunctionBreakpointsResponse :: Int
-> String
-> Int
-> Bool
-> String
-> String
-> SetFunctionBreakpointsResponseBody
-> SetFunctionBreakpointsResponse
SetFunctionBreakpointsResponse {
    seqSetFunctionBreakpointsResponse :: Int
seqSetFunctionBreakpointsResponse         = Int
0
  , typeSetFunctionBreakpointsResponse :: String
typeSetFunctionBreakpointsResponse        = String
"response"
  , request_seqSetFunctionBreakpointsResponse :: Int
request_seqSetFunctionBreakpointsResponse = Int
0
  , successSetFunctionBreakpointsResponse :: Bool
successSetFunctionBreakpointsResponse     = Bool
False
  , commandSetFunctionBreakpointsResponse :: String
commandSetFunctionBreakpointsResponse     = String
"setFunctionBreakpoints"
  , messageSetFunctionBreakpointsResponse :: String
messageSetFunctionBreakpointsResponse     = String
""
  , bodySetFunctionBreakpointsResponse :: SetFunctionBreakpointsResponseBody
bodySetFunctionBreakpointsResponse        = SetFunctionBreakpointsResponseBody
defaultSetFunctionBreakpointsResponseBody
  }


-- |
--  Response to 'setFunctionBreakpoints' request.
--
--  Returned is information about each breakpoint created by this request.
--
data SetFunctionBreakpointsResponseBody =
  SetFunctionBreakpointsResponseBody {
    SetFunctionBreakpointsResponseBody -> [Breakpoint]
breakpointsSetFunctionBreakpointsResponseBody :: [Breakpoint]  -- ^Information about the breakpoints. The array elements correspond to the elements of the 'breakpoints' array.
  } deriving (Int -> SetFunctionBreakpointsResponseBody -> ShowS
[SetFunctionBreakpointsResponseBody] -> ShowS
SetFunctionBreakpointsResponseBody -> String
(Int -> SetFunctionBreakpointsResponseBody -> ShowS)
-> (SetFunctionBreakpointsResponseBody -> String)
-> ([SetFunctionBreakpointsResponseBody] -> ShowS)
-> Show SetFunctionBreakpointsResponseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetFunctionBreakpointsResponseBody] -> ShowS
$cshowList :: [SetFunctionBreakpointsResponseBody] -> ShowS
show :: SetFunctionBreakpointsResponseBody -> String
$cshow :: SetFunctionBreakpointsResponseBody -> String
showsPrec :: Int -> SetFunctionBreakpointsResponseBody -> ShowS
$cshowsPrec :: Int -> SetFunctionBreakpointsResponseBody -> ShowS
Show, ReadPrec [SetFunctionBreakpointsResponseBody]
ReadPrec SetFunctionBreakpointsResponseBody
Int -> ReadS SetFunctionBreakpointsResponseBody
ReadS [SetFunctionBreakpointsResponseBody]
(Int -> ReadS SetFunctionBreakpointsResponseBody)
-> ReadS [SetFunctionBreakpointsResponseBody]
-> ReadPrec SetFunctionBreakpointsResponseBody
-> ReadPrec [SetFunctionBreakpointsResponseBody]
-> Read SetFunctionBreakpointsResponseBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetFunctionBreakpointsResponseBody]
$creadListPrec :: ReadPrec [SetFunctionBreakpointsResponseBody]
readPrec :: ReadPrec SetFunctionBreakpointsResponseBody
$creadPrec :: ReadPrec SetFunctionBreakpointsResponseBody
readList :: ReadS [SetFunctionBreakpointsResponseBody]
$creadList :: ReadS [SetFunctionBreakpointsResponseBody]
readsPrec :: Int -> ReadS SetFunctionBreakpointsResponseBody
$creadsPrec :: Int -> ReadS SetFunctionBreakpointsResponseBody
Read, SetFunctionBreakpointsResponseBody
-> SetFunctionBreakpointsResponseBody -> Bool
(SetFunctionBreakpointsResponseBody
 -> SetFunctionBreakpointsResponseBody -> Bool)
-> (SetFunctionBreakpointsResponseBody
    -> SetFunctionBreakpointsResponseBody -> Bool)
-> Eq SetFunctionBreakpointsResponseBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetFunctionBreakpointsResponseBody
-> SetFunctionBreakpointsResponseBody -> Bool
$c/= :: SetFunctionBreakpointsResponseBody
-> SetFunctionBreakpointsResponseBody -> Bool
== :: SetFunctionBreakpointsResponseBody
-> SetFunctionBreakpointsResponseBody -> Bool
$c== :: SetFunctionBreakpointsResponseBody
-> SetFunctionBreakpointsResponseBody -> Bool
Eq)


-- |
--
defaultSetFunctionBreakpointsResponseBody :: SetFunctionBreakpointsResponseBody
defaultSetFunctionBreakpointsResponseBody :: SetFunctionBreakpointsResponseBody
defaultSetFunctionBreakpointsResponseBody = SetFunctionBreakpointsResponseBody :: [Breakpoint] -> SetFunctionBreakpointsResponseBody
SetFunctionBreakpointsResponseBody {
    breakpointsSetFunctionBreakpointsResponseBody :: [Breakpoint]
breakpointsSetFunctionBreakpointsResponseBody = []
  }


----------------------------------------------------------------------------
--  SetExceptionBreakpoints
----------------------------------------------------------------------------

-- |
--   SetExceptionBreakpoints request; value of command field is 'setExceptionBreakpoints'.
--
--   The request configures the debuggers response to thrown exceptions. If an exception is configured to break,
--
--   a StoppedEvent is fired (event type 'exception').
--
data SetExceptionBreakpointsRequest =
  SetExceptionBreakpointsRequest {
    SetExceptionBreakpointsRequest -> Int
seqSetExceptionBreakpointsRequest       :: Int                                     -- ^Sequence number
  , SetExceptionBreakpointsRequest -> String
typeSetExceptionBreakpointsRequest      :: String                                  -- ^One of "request", "response", or "event"
  , SetExceptionBreakpointsRequest -> String
commandSetExceptionBreakpointsRequest   :: String                                  -- ^The command to execute
  , SetExceptionBreakpointsRequest
-> SetExceptionBreakpointsRequestArguments
argumentsSetExceptionBreakpointsRequest :: SetExceptionBreakpointsRequestArguments -- ^Arguments for "setExceptionBreakpoints" request.
  } deriving (Int -> SetExceptionBreakpointsRequest -> ShowS
[SetExceptionBreakpointsRequest] -> ShowS
SetExceptionBreakpointsRequest -> String
(Int -> SetExceptionBreakpointsRequest -> ShowS)
-> (SetExceptionBreakpointsRequest -> String)
-> ([SetExceptionBreakpointsRequest] -> ShowS)
-> Show SetExceptionBreakpointsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetExceptionBreakpointsRequest] -> ShowS
$cshowList :: [SetExceptionBreakpointsRequest] -> ShowS
show :: SetExceptionBreakpointsRequest -> String
$cshow :: SetExceptionBreakpointsRequest -> String
showsPrec :: Int -> SetExceptionBreakpointsRequest -> ShowS
$cshowsPrec :: Int -> SetExceptionBreakpointsRequest -> ShowS
Show, ReadPrec [SetExceptionBreakpointsRequest]
ReadPrec SetExceptionBreakpointsRequest
Int -> ReadS SetExceptionBreakpointsRequest
ReadS [SetExceptionBreakpointsRequest]
(Int -> ReadS SetExceptionBreakpointsRequest)
-> ReadS [SetExceptionBreakpointsRequest]
-> ReadPrec SetExceptionBreakpointsRequest
-> ReadPrec [SetExceptionBreakpointsRequest]
-> Read SetExceptionBreakpointsRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetExceptionBreakpointsRequest]
$creadListPrec :: ReadPrec [SetExceptionBreakpointsRequest]
readPrec :: ReadPrec SetExceptionBreakpointsRequest
$creadPrec :: ReadPrec SetExceptionBreakpointsRequest
readList :: ReadS [SetExceptionBreakpointsRequest]
$creadList :: ReadS [SetExceptionBreakpointsRequest]
readsPrec :: Int -> ReadS SetExceptionBreakpointsRequest
$creadsPrec :: Int -> ReadS SetExceptionBreakpointsRequest
Read, SetExceptionBreakpointsRequest
-> SetExceptionBreakpointsRequest -> Bool
(SetExceptionBreakpointsRequest
 -> SetExceptionBreakpointsRequest -> Bool)
-> (SetExceptionBreakpointsRequest
    -> SetExceptionBreakpointsRequest -> Bool)
-> Eq SetExceptionBreakpointsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetExceptionBreakpointsRequest
-> SetExceptionBreakpointsRequest -> Bool
$c/= :: SetExceptionBreakpointsRequest
-> SetExceptionBreakpointsRequest -> Bool
== :: SetExceptionBreakpointsRequest
-> SetExceptionBreakpointsRequest -> Bool
$c== :: SetExceptionBreakpointsRequest
-> SetExceptionBreakpointsRequest -> Bool
Eq)


-- |
--   Arguments for 'setExceptionBreakpoints' request.
--
data SetExceptionBreakpointsRequestArguments =
  SetExceptionBreakpointsRequestArguments {
    SetExceptionBreakpointsRequestArguments -> [String]
filtersSetExceptionBreakpointsRequestArguments :: [String]  -- ^IDs of checked exception options. The set of IDs is returned via the 'exceptionBreakpointFilters' capability.
  } deriving (Int -> SetExceptionBreakpointsRequestArguments -> ShowS
[SetExceptionBreakpointsRequestArguments] -> ShowS
SetExceptionBreakpointsRequestArguments -> String
(Int -> SetExceptionBreakpointsRequestArguments -> ShowS)
-> (SetExceptionBreakpointsRequestArguments -> String)
-> ([SetExceptionBreakpointsRequestArguments] -> ShowS)
-> Show SetExceptionBreakpointsRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetExceptionBreakpointsRequestArguments] -> ShowS
$cshowList :: [SetExceptionBreakpointsRequestArguments] -> ShowS
show :: SetExceptionBreakpointsRequestArguments -> String
$cshow :: SetExceptionBreakpointsRequestArguments -> String
showsPrec :: Int -> SetExceptionBreakpointsRequestArguments -> ShowS
$cshowsPrec :: Int -> SetExceptionBreakpointsRequestArguments -> ShowS
Show, ReadPrec [SetExceptionBreakpointsRequestArguments]
ReadPrec SetExceptionBreakpointsRequestArguments
Int -> ReadS SetExceptionBreakpointsRequestArguments
ReadS [SetExceptionBreakpointsRequestArguments]
(Int -> ReadS SetExceptionBreakpointsRequestArguments)
-> ReadS [SetExceptionBreakpointsRequestArguments]
-> ReadPrec SetExceptionBreakpointsRequestArguments
-> ReadPrec [SetExceptionBreakpointsRequestArguments]
-> Read SetExceptionBreakpointsRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetExceptionBreakpointsRequestArguments]
$creadListPrec :: ReadPrec [SetExceptionBreakpointsRequestArguments]
readPrec :: ReadPrec SetExceptionBreakpointsRequestArguments
$creadPrec :: ReadPrec SetExceptionBreakpointsRequestArguments
readList :: ReadS [SetExceptionBreakpointsRequestArguments]
$creadList :: ReadS [SetExceptionBreakpointsRequestArguments]
readsPrec :: Int -> ReadS SetExceptionBreakpointsRequestArguments
$creadsPrec :: Int -> ReadS SetExceptionBreakpointsRequestArguments
Read, SetExceptionBreakpointsRequestArguments
-> SetExceptionBreakpointsRequestArguments -> Bool
(SetExceptionBreakpointsRequestArguments
 -> SetExceptionBreakpointsRequestArguments -> Bool)
-> (SetExceptionBreakpointsRequestArguments
    -> SetExceptionBreakpointsRequestArguments -> Bool)
-> Eq SetExceptionBreakpointsRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetExceptionBreakpointsRequestArguments
-> SetExceptionBreakpointsRequestArguments -> Bool
$c/= :: SetExceptionBreakpointsRequestArguments
-> SetExceptionBreakpointsRequestArguments -> Bool
== :: SetExceptionBreakpointsRequestArguments
-> SetExceptionBreakpointsRequestArguments -> Bool
$c== :: SetExceptionBreakpointsRequestArguments
-> SetExceptionBreakpointsRequestArguments -> Bool
Eq)



-- |
--   Response to 'setExceptionBreakpoints' request. This is just an acknowledgement, so no body field is required.
--
data SetExceptionBreakpointsResponse =
  SetExceptionBreakpointsResponse {
    SetExceptionBreakpointsResponse -> Int
seqSetExceptionBreakpointsResponse         :: Int     -- ^Sequence number
  , SetExceptionBreakpointsResponse -> String
typeSetExceptionBreakpointsResponse        :: String  -- ^One of "request", "response", or "event"
  , SetExceptionBreakpointsResponse -> Int
request_seqSetExceptionBreakpointsResponse :: Int     -- ^Sequence number of the corresponding request
  , SetExceptionBreakpointsResponse -> Bool
successSetExceptionBreakpointsResponse     :: Bool    -- ^Outcome of the request
  , SetExceptionBreakpointsResponse -> String
commandSetExceptionBreakpointsResponse     :: String  -- ^The command requested
  , SetExceptionBreakpointsResponse -> String
messageSetExceptionBreakpointsResponse     :: String  -- ^Contains error message if success == false.
  } deriving (Int -> SetExceptionBreakpointsResponse -> ShowS
[SetExceptionBreakpointsResponse] -> ShowS
SetExceptionBreakpointsResponse -> String
(Int -> SetExceptionBreakpointsResponse -> ShowS)
-> (SetExceptionBreakpointsResponse -> String)
-> ([SetExceptionBreakpointsResponse] -> ShowS)
-> Show SetExceptionBreakpointsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetExceptionBreakpointsResponse] -> ShowS
$cshowList :: [SetExceptionBreakpointsResponse] -> ShowS
show :: SetExceptionBreakpointsResponse -> String
$cshow :: SetExceptionBreakpointsResponse -> String
showsPrec :: Int -> SetExceptionBreakpointsResponse -> ShowS
$cshowsPrec :: Int -> SetExceptionBreakpointsResponse -> ShowS
Show, ReadPrec [SetExceptionBreakpointsResponse]
ReadPrec SetExceptionBreakpointsResponse
Int -> ReadS SetExceptionBreakpointsResponse
ReadS [SetExceptionBreakpointsResponse]
(Int -> ReadS SetExceptionBreakpointsResponse)
-> ReadS [SetExceptionBreakpointsResponse]
-> ReadPrec SetExceptionBreakpointsResponse
-> ReadPrec [SetExceptionBreakpointsResponse]
-> Read SetExceptionBreakpointsResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetExceptionBreakpointsResponse]
$creadListPrec :: ReadPrec [SetExceptionBreakpointsResponse]
readPrec :: ReadPrec SetExceptionBreakpointsResponse
$creadPrec :: ReadPrec SetExceptionBreakpointsResponse
readList :: ReadS [SetExceptionBreakpointsResponse]
$creadList :: ReadS [SetExceptionBreakpointsResponse]
readsPrec :: Int -> ReadS SetExceptionBreakpointsResponse
$creadsPrec :: Int -> ReadS SetExceptionBreakpointsResponse
Read, SetExceptionBreakpointsResponse
-> SetExceptionBreakpointsResponse -> Bool
(SetExceptionBreakpointsResponse
 -> SetExceptionBreakpointsResponse -> Bool)
-> (SetExceptionBreakpointsResponse
    -> SetExceptionBreakpointsResponse -> Bool)
-> Eq SetExceptionBreakpointsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetExceptionBreakpointsResponse
-> SetExceptionBreakpointsResponse -> Bool
$c/= :: SetExceptionBreakpointsResponse
-> SetExceptionBreakpointsResponse -> Bool
== :: SetExceptionBreakpointsResponse
-> SetExceptionBreakpointsResponse -> Bool
$c== :: SetExceptionBreakpointsResponse
-> SetExceptionBreakpointsResponse -> Bool
Eq)


-- |
--
defaultSetExceptionBreakpointsResponse :: SetExceptionBreakpointsResponse
defaultSetExceptionBreakpointsResponse :: SetExceptionBreakpointsResponse
defaultSetExceptionBreakpointsResponse = SetExceptionBreakpointsResponse :: Int
-> String
-> Int
-> Bool
-> String
-> String
-> SetExceptionBreakpointsResponse
SetExceptionBreakpointsResponse {
    seqSetExceptionBreakpointsResponse :: Int
seqSetExceptionBreakpointsResponse         = Int
0
  , typeSetExceptionBreakpointsResponse :: String
typeSetExceptionBreakpointsResponse        = String
"response"
  , request_seqSetExceptionBreakpointsResponse :: Int
request_seqSetExceptionBreakpointsResponse = Int
0
  , successSetExceptionBreakpointsResponse :: Bool
successSetExceptionBreakpointsResponse     = Bool
False
  , commandSetExceptionBreakpointsResponse :: String
commandSetExceptionBreakpointsResponse     = String
"setExceptionBreakpoints"
  , messageSetExceptionBreakpointsResponse :: String
messageSetExceptionBreakpointsResponse     = String
""
  }


----------------------------------------------------------------------------
--  ConfigurationDone
----------------------------------------------------------------------------

-- |
--   ConfigurationDone request; value of command field is 'configurationDone'.
--
--   The client of the debug protocol must send this request at the end of the sequence of configuration requests
--
--   (which was started by the InitializedEvent).
--
data ConfigurationDoneRequest =
  ConfigurationDoneRequest {
    ConfigurationDoneRequest -> Int
seqConfigurationDoneRequest       :: Int               -- ^Sequence number
  , ConfigurationDoneRequest -> String
typeConfigurationDoneRequest      :: String            -- ^One of "request", "response", or "event"
  , ConfigurationDoneRequest -> String
commandConfigurationDoneRequest   :: String            -- ^The command to execute
  } deriving (Int -> ConfigurationDoneRequest -> ShowS
[ConfigurationDoneRequest] -> ShowS
ConfigurationDoneRequest -> String
(Int -> ConfigurationDoneRequest -> ShowS)
-> (ConfigurationDoneRequest -> String)
-> ([ConfigurationDoneRequest] -> ShowS)
-> Show ConfigurationDoneRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigurationDoneRequest] -> ShowS
$cshowList :: [ConfigurationDoneRequest] -> ShowS
show :: ConfigurationDoneRequest -> String
$cshow :: ConfigurationDoneRequest -> String
showsPrec :: Int -> ConfigurationDoneRequest -> ShowS
$cshowsPrec :: Int -> ConfigurationDoneRequest -> ShowS
Show, ReadPrec [ConfigurationDoneRequest]
ReadPrec ConfigurationDoneRequest
Int -> ReadS ConfigurationDoneRequest
ReadS [ConfigurationDoneRequest]
(Int -> ReadS ConfigurationDoneRequest)
-> ReadS [ConfigurationDoneRequest]
-> ReadPrec ConfigurationDoneRequest
-> ReadPrec [ConfigurationDoneRequest]
-> Read ConfigurationDoneRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConfigurationDoneRequest]
$creadListPrec :: ReadPrec [ConfigurationDoneRequest]
readPrec :: ReadPrec ConfigurationDoneRequest
$creadPrec :: ReadPrec ConfigurationDoneRequest
readList :: ReadS [ConfigurationDoneRequest]
$creadList :: ReadS [ConfigurationDoneRequest]
readsPrec :: Int -> ReadS ConfigurationDoneRequest
$creadsPrec :: Int -> ReadS ConfigurationDoneRequest
Read, ConfigurationDoneRequest -> ConfigurationDoneRequest -> Bool
(ConfigurationDoneRequest -> ConfigurationDoneRequest -> Bool)
-> (ConfigurationDoneRequest -> ConfigurationDoneRequest -> Bool)
-> Eq ConfigurationDoneRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigurationDoneRequest -> ConfigurationDoneRequest -> Bool
$c/= :: ConfigurationDoneRequest -> ConfigurationDoneRequest -> Bool
== :: ConfigurationDoneRequest -> ConfigurationDoneRequest -> Bool
$c== :: ConfigurationDoneRequest -> ConfigurationDoneRequest -> Bool
Eq)


-- |
--   Response to 'configurationDone' request. This is just an acknowledgement, so no body field is required.
--
data ConfigurationDoneResponse =
  ConfigurationDoneResponse {
    ConfigurationDoneResponse -> Int
seqConfigurationDoneResponse         :: Int     -- ^Sequence number
  , ConfigurationDoneResponse -> String
typeConfigurationDoneResponse        :: String  -- ^One of "request", "response", or "event"
  , ConfigurationDoneResponse -> Int
request_seqConfigurationDoneResponse :: Int     -- ^Sequence number of the corresponding request
  , ConfigurationDoneResponse -> Bool
successConfigurationDoneResponse     :: Bool    -- ^Outcome of the request
  , ConfigurationDoneResponse -> String
commandConfigurationDoneResponse     :: String  -- ^The command requested
  , ConfigurationDoneResponse -> String
messageConfigurationDoneResponse     :: String  -- ^Contains error message if success == false.
  } deriving (Int -> ConfigurationDoneResponse -> ShowS
[ConfigurationDoneResponse] -> ShowS
ConfigurationDoneResponse -> String
(Int -> ConfigurationDoneResponse -> ShowS)
-> (ConfigurationDoneResponse -> String)
-> ([ConfigurationDoneResponse] -> ShowS)
-> Show ConfigurationDoneResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigurationDoneResponse] -> ShowS
$cshowList :: [ConfigurationDoneResponse] -> ShowS
show :: ConfigurationDoneResponse -> String
$cshow :: ConfigurationDoneResponse -> String
showsPrec :: Int -> ConfigurationDoneResponse -> ShowS
$cshowsPrec :: Int -> ConfigurationDoneResponse -> ShowS
Show, ReadPrec [ConfigurationDoneResponse]
ReadPrec ConfigurationDoneResponse
Int -> ReadS ConfigurationDoneResponse
ReadS [ConfigurationDoneResponse]
(Int -> ReadS ConfigurationDoneResponse)
-> ReadS [ConfigurationDoneResponse]
-> ReadPrec ConfigurationDoneResponse
-> ReadPrec [ConfigurationDoneResponse]
-> Read ConfigurationDoneResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConfigurationDoneResponse]
$creadListPrec :: ReadPrec [ConfigurationDoneResponse]
readPrec :: ReadPrec ConfigurationDoneResponse
$creadPrec :: ReadPrec ConfigurationDoneResponse
readList :: ReadS [ConfigurationDoneResponse]
$creadList :: ReadS [ConfigurationDoneResponse]
readsPrec :: Int -> ReadS ConfigurationDoneResponse
$creadsPrec :: Int -> ReadS ConfigurationDoneResponse
Read, ConfigurationDoneResponse -> ConfigurationDoneResponse -> Bool
(ConfigurationDoneResponse -> ConfigurationDoneResponse -> Bool)
-> (ConfigurationDoneResponse -> ConfigurationDoneResponse -> Bool)
-> Eq ConfigurationDoneResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigurationDoneResponse -> ConfigurationDoneResponse -> Bool
$c/= :: ConfigurationDoneResponse -> ConfigurationDoneResponse -> Bool
== :: ConfigurationDoneResponse -> ConfigurationDoneResponse -> Bool
$c== :: ConfigurationDoneResponse -> ConfigurationDoneResponse -> Bool
Eq)


-- |
--
defaultConfigurationDoneResponse :: ConfigurationDoneResponse
defaultConfigurationDoneResponse :: ConfigurationDoneResponse
defaultConfigurationDoneResponse = ConfigurationDoneResponse :: Int
-> String
-> Int
-> Bool
-> String
-> String
-> ConfigurationDoneResponse
ConfigurationDoneResponse {
    seqConfigurationDoneResponse :: Int
seqConfigurationDoneResponse         = Int
0
  , typeConfigurationDoneResponse :: String
typeConfigurationDoneResponse        = String
"response"
  , request_seqConfigurationDoneResponse :: Int
request_seqConfigurationDoneResponse = Int
0
  , successConfigurationDoneResponse :: Bool
successConfigurationDoneResponse     = Bool
False
  , commandConfigurationDoneResponse :: String
commandConfigurationDoneResponse     = String
"configurationDone"
  , messageConfigurationDoneResponse :: String
messageConfigurationDoneResponse     = String
""
  }


----------------------------------------------------------------------------
--  Thread
----------------------------------------------------------------------------

-- |
--   Thread request; value of command field is "threads".
--
--   The request retrieves a list of all threads.
--
data ThreadsRequest =
  ThreadsRequest {
    ThreadsRequest -> Int
seqThreadsRequest       :: Int              -- ^Sequence number
  , ThreadsRequest -> String
typeThreadsRequest      :: String           -- ^One of "request", "response", or "event"
  , ThreadsRequest -> String
commandThreadsRequest   :: String           -- ^The command to execute
  } deriving (Int -> ThreadsRequest -> ShowS
[ThreadsRequest] -> ShowS
ThreadsRequest -> String
(Int -> ThreadsRequest -> ShowS)
-> (ThreadsRequest -> String)
-> ([ThreadsRequest] -> ShowS)
-> Show ThreadsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreadsRequest] -> ShowS
$cshowList :: [ThreadsRequest] -> ShowS
show :: ThreadsRequest -> String
$cshow :: ThreadsRequest -> String
showsPrec :: Int -> ThreadsRequest -> ShowS
$cshowsPrec :: Int -> ThreadsRequest -> ShowS
Show, ReadPrec [ThreadsRequest]
ReadPrec ThreadsRequest
Int -> ReadS ThreadsRequest
ReadS [ThreadsRequest]
(Int -> ReadS ThreadsRequest)
-> ReadS [ThreadsRequest]
-> ReadPrec ThreadsRequest
-> ReadPrec [ThreadsRequest]
-> Read ThreadsRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ThreadsRequest]
$creadListPrec :: ReadPrec [ThreadsRequest]
readPrec :: ReadPrec ThreadsRequest
$creadPrec :: ReadPrec ThreadsRequest
readList :: ReadS [ThreadsRequest]
$creadList :: ReadS [ThreadsRequest]
readsPrec :: Int -> ReadS ThreadsRequest
$creadsPrec :: Int -> ReadS ThreadsRequest
Read, ThreadsRequest -> ThreadsRequest -> Bool
(ThreadsRequest -> ThreadsRequest -> Bool)
-> (ThreadsRequest -> ThreadsRequest -> Bool) -> Eq ThreadsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThreadsRequest -> ThreadsRequest -> Bool
$c/= :: ThreadsRequest -> ThreadsRequest -> Bool
== :: ThreadsRequest -> ThreadsRequest -> Bool
$c== :: ThreadsRequest -> ThreadsRequest -> Bool
Eq)


-- |
--  Response to "threads" request.
--
data ThreadsResponse =
  ThreadsResponse {
    ThreadsResponse -> Int
seqThreadsResponse         :: Int     -- ^Sequence number
  , ThreadsResponse -> String
typeThreadsResponse        :: String  -- ^One of "request", "response", or "event"
  , ThreadsResponse -> Int
request_seqThreadsResponse :: Int     -- ^Sequence number of the corresponding request
  , ThreadsResponse -> Bool
successThreadsResponse     :: Bool    -- ^Outcome of the request
  , ThreadsResponse -> String
commandThreadsResponse     :: String  -- ^The command requested
  , ThreadsResponse -> String
messageThreadsResponse     :: String  -- ^Contains error message if success == false.
  , ThreadsResponse -> ThreadsResponseBody
bodyThreadsResponse        :: ThreadsResponseBody -- ^The body of ThreadsResponse
  } deriving (Int -> ThreadsResponse -> ShowS
[ThreadsResponse] -> ShowS
ThreadsResponse -> String
(Int -> ThreadsResponse -> ShowS)
-> (ThreadsResponse -> String)
-> ([ThreadsResponse] -> ShowS)
-> Show ThreadsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreadsResponse] -> ShowS
$cshowList :: [ThreadsResponse] -> ShowS
show :: ThreadsResponse -> String
$cshow :: ThreadsResponse -> String
showsPrec :: Int -> ThreadsResponse -> ShowS
$cshowsPrec :: Int -> ThreadsResponse -> ShowS
Show, ReadPrec [ThreadsResponse]
ReadPrec ThreadsResponse
Int -> ReadS ThreadsResponse
ReadS [ThreadsResponse]
(Int -> ReadS ThreadsResponse)
-> ReadS [ThreadsResponse]
-> ReadPrec ThreadsResponse
-> ReadPrec [ThreadsResponse]
-> Read ThreadsResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ThreadsResponse]
$creadListPrec :: ReadPrec [ThreadsResponse]
readPrec :: ReadPrec ThreadsResponse
$creadPrec :: ReadPrec ThreadsResponse
readList :: ReadS [ThreadsResponse]
$creadList :: ReadS [ThreadsResponse]
readsPrec :: Int -> ReadS ThreadsResponse
$creadsPrec :: Int -> ReadS ThreadsResponse
Read, ThreadsResponse -> ThreadsResponse -> Bool
(ThreadsResponse -> ThreadsResponse -> Bool)
-> (ThreadsResponse -> ThreadsResponse -> Bool)
-> Eq ThreadsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThreadsResponse -> ThreadsResponse -> Bool
$c/= :: ThreadsResponse -> ThreadsResponse -> Bool
== :: ThreadsResponse -> ThreadsResponse -> Bool
$c== :: ThreadsResponse -> ThreadsResponse -> Bool
Eq)


-- |
--
defaultThreadsResponse :: ThreadsResponse
defaultThreadsResponse :: ThreadsResponse
defaultThreadsResponse = ThreadsResponse :: Int
-> String
-> Int
-> Bool
-> String
-> String
-> ThreadsResponseBody
-> ThreadsResponse
ThreadsResponse {
    seqThreadsResponse :: Int
seqThreadsResponse         = Int
0
  , typeThreadsResponse :: String
typeThreadsResponse        = String
"response"
  , request_seqThreadsResponse :: Int
request_seqThreadsResponse = Int
0
  , successThreadsResponse :: Bool
successThreadsResponse     = Bool
False
  , commandThreadsResponse :: String
commandThreadsResponse     = String
"threads"
  , messageThreadsResponse :: String
messageThreadsResponse     = String
""
  , bodyThreadsResponse :: ThreadsResponseBody
bodyThreadsResponse        = ThreadsResponseBody
defaultThreadsResponseBody
  }


-- |
--    Response to "threads" request.
--
data ThreadsResponseBody =
  ThreadsResponseBody {
    ThreadsResponseBody -> [Thread]
threadsThreadsResponseBody :: [Thread]  -- ^All threads.
  } deriving (Int -> ThreadsResponseBody -> ShowS
[ThreadsResponseBody] -> ShowS
ThreadsResponseBody -> String
(Int -> ThreadsResponseBody -> ShowS)
-> (ThreadsResponseBody -> String)
-> ([ThreadsResponseBody] -> ShowS)
-> Show ThreadsResponseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreadsResponseBody] -> ShowS
$cshowList :: [ThreadsResponseBody] -> ShowS
show :: ThreadsResponseBody -> String
$cshow :: ThreadsResponseBody -> String
showsPrec :: Int -> ThreadsResponseBody -> ShowS
$cshowsPrec :: Int -> ThreadsResponseBody -> ShowS
Show, ReadPrec [ThreadsResponseBody]
ReadPrec ThreadsResponseBody
Int -> ReadS ThreadsResponseBody
ReadS [ThreadsResponseBody]
(Int -> ReadS ThreadsResponseBody)
-> ReadS [ThreadsResponseBody]
-> ReadPrec ThreadsResponseBody
-> ReadPrec [ThreadsResponseBody]
-> Read ThreadsResponseBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ThreadsResponseBody]
$creadListPrec :: ReadPrec [ThreadsResponseBody]
readPrec :: ReadPrec ThreadsResponseBody
$creadPrec :: ReadPrec ThreadsResponseBody
readList :: ReadS [ThreadsResponseBody]
$creadList :: ReadS [ThreadsResponseBody]
readsPrec :: Int -> ReadS ThreadsResponseBody
$creadsPrec :: Int -> ReadS ThreadsResponseBody
Read, ThreadsResponseBody -> ThreadsResponseBody -> Bool
(ThreadsResponseBody -> ThreadsResponseBody -> Bool)
-> (ThreadsResponseBody -> ThreadsResponseBody -> Bool)
-> Eq ThreadsResponseBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThreadsResponseBody -> ThreadsResponseBody -> Bool
$c/= :: ThreadsResponseBody -> ThreadsResponseBody -> Bool
== :: ThreadsResponseBody -> ThreadsResponseBody -> Bool
$c== :: ThreadsResponseBody -> ThreadsResponseBody -> Bool
Eq)


-- |
--
defaultThreadsResponseBody :: ThreadsResponseBody
defaultThreadsResponseBody :: ThreadsResponseBody
defaultThreadsResponseBody = [Thread] -> ThreadsResponseBody
ThreadsResponseBody [Thread
defaultThread]


-- |
--   A Thread is a name/value pair.
--
--   If the value is structured (has children), a handle is provided to retrieve the children with the ThreadsRequest.
--
data Thread =
  Thread {
    Thread -> Int
idThread   :: Int     -- ^Unique identifier for the thread.
  , Thread -> String
nameThread :: String  -- ^A name of the thread.
  } deriving (Int -> Thread -> ShowS
[Thread] -> ShowS
Thread -> String
(Int -> Thread -> ShowS)
-> (Thread -> String) -> ([Thread] -> ShowS) -> Show Thread
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Thread] -> ShowS
$cshowList :: [Thread] -> ShowS
show :: Thread -> String
$cshow :: Thread -> String
showsPrec :: Int -> Thread -> ShowS
$cshowsPrec :: Int -> Thread -> ShowS
Show, ReadPrec [Thread]
ReadPrec Thread
Int -> ReadS Thread
ReadS [Thread]
(Int -> ReadS Thread)
-> ReadS [Thread]
-> ReadPrec Thread
-> ReadPrec [Thread]
-> Read Thread
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Thread]
$creadListPrec :: ReadPrec [Thread]
readPrec :: ReadPrec Thread
$creadPrec :: ReadPrec Thread
readList :: ReadS [Thread]
$creadList :: ReadS [Thread]
readsPrec :: Int -> ReadS Thread
$creadsPrec :: Int -> ReadS Thread
Read, Thread -> Thread -> Bool
(Thread -> Thread -> Bool)
-> (Thread -> Thread -> Bool) -> Eq Thread
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Thread -> Thread -> Bool
$c/= :: Thread -> Thread -> Bool
== :: Thread -> Thread -> Bool
$c== :: Thread -> Thread -> Bool
Eq)


-- |
--
defaultThread :: Thread
defaultThread :: Thread
defaultThread = Int -> String -> Thread
Thread Int
_THREAD_ID String
"ghci main thread"


----------------------------------------------------------------------------
--  StackTrace
----------------------------------------------------------------------------

-- |
--   StackTrace request; value of command field is "stackTrace".
--
--   The request returns a stacktrace from the current execution state.
--
data StackTraceRequest =
  StackTraceRequest {
    StackTraceRequest -> Int
seqStackTraceRequest       :: Int                  -- ^Sequence number
  , StackTraceRequest -> String
typeStackTraceRequest      :: String               -- ^One of "request", "response", or "event"
  , StackTraceRequest -> String
commandStackTraceRequest   :: String               -- ^The command to execute
  , StackTraceRequest -> StackTraceRequestArguments
argumentsStackTraceRequest :: StackTraceRequestArguments  -- ^Arguments for "stackTrace" request.
  } deriving (Int -> StackTraceRequest -> ShowS
[StackTraceRequest] -> ShowS
StackTraceRequest -> String
(Int -> StackTraceRequest -> ShowS)
-> (StackTraceRequest -> String)
-> ([StackTraceRequest] -> ShowS)
-> Show StackTraceRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackTraceRequest] -> ShowS
$cshowList :: [StackTraceRequest] -> ShowS
show :: StackTraceRequest -> String
$cshow :: StackTraceRequest -> String
showsPrec :: Int -> StackTraceRequest -> ShowS
$cshowsPrec :: Int -> StackTraceRequest -> ShowS
Show, ReadPrec [StackTraceRequest]
ReadPrec StackTraceRequest
Int -> ReadS StackTraceRequest
ReadS [StackTraceRequest]
(Int -> ReadS StackTraceRequest)
-> ReadS [StackTraceRequest]
-> ReadPrec StackTraceRequest
-> ReadPrec [StackTraceRequest]
-> Read StackTraceRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StackTraceRequest]
$creadListPrec :: ReadPrec [StackTraceRequest]
readPrec :: ReadPrec StackTraceRequest
$creadPrec :: ReadPrec StackTraceRequest
readList :: ReadS [StackTraceRequest]
$creadList :: ReadS [StackTraceRequest]
readsPrec :: Int -> ReadS StackTraceRequest
$creadsPrec :: Int -> ReadS StackTraceRequest
Read, StackTraceRequest -> StackTraceRequest -> Bool
(StackTraceRequest -> StackTraceRequest -> Bool)
-> (StackTraceRequest -> StackTraceRequest -> Bool)
-> Eq StackTraceRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackTraceRequest -> StackTraceRequest -> Bool
$c/= :: StackTraceRequest -> StackTraceRequest -> Bool
== :: StackTraceRequest -> StackTraceRequest -> Bool
$c== :: StackTraceRequest -> StackTraceRequest -> Bool
Eq)


-- |
--  Arguments for 'stackTrace' request.
--
data StackTraceRequestArguments =
  StackTraceRequestArguments {
    StackTraceRequestArguments -> Int
threadIdStackTraceRequestArguments   :: Int        -- ^Retrieve the stacktrace for this thread.
  , StackTraceRequestArguments -> Maybe Int
startFrameStackTraceRequestArguments :: Maybe Int  -- ^The index of the first frame to return; if omitted frames start at 0.
  , StackTraceRequestArguments -> Maybe Int
levelsStackTraceRequestArguments     :: Maybe Int  -- ^The maximum number of frames to return. If levels is not specified or 0, all frames are returned.
  } deriving (Int -> StackTraceRequestArguments -> ShowS
[StackTraceRequestArguments] -> ShowS
StackTraceRequestArguments -> String
(Int -> StackTraceRequestArguments -> ShowS)
-> (StackTraceRequestArguments -> String)
-> ([StackTraceRequestArguments] -> ShowS)
-> Show StackTraceRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackTraceRequestArguments] -> ShowS
$cshowList :: [StackTraceRequestArguments] -> ShowS
show :: StackTraceRequestArguments -> String
$cshow :: StackTraceRequestArguments -> String
showsPrec :: Int -> StackTraceRequestArguments -> ShowS
$cshowsPrec :: Int -> StackTraceRequestArguments -> ShowS
Show, ReadPrec [StackTraceRequestArguments]
ReadPrec StackTraceRequestArguments
Int -> ReadS StackTraceRequestArguments
ReadS [StackTraceRequestArguments]
(Int -> ReadS StackTraceRequestArguments)
-> ReadS [StackTraceRequestArguments]
-> ReadPrec StackTraceRequestArguments
-> ReadPrec [StackTraceRequestArguments]
-> Read StackTraceRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StackTraceRequestArguments]
$creadListPrec :: ReadPrec [StackTraceRequestArguments]
readPrec :: ReadPrec StackTraceRequestArguments
$creadPrec :: ReadPrec StackTraceRequestArguments
readList :: ReadS [StackTraceRequestArguments]
$creadList :: ReadS [StackTraceRequestArguments]
readsPrec :: Int -> ReadS StackTraceRequestArguments
$creadsPrec :: Int -> ReadS StackTraceRequestArguments
Read, StackTraceRequestArguments -> StackTraceRequestArguments -> Bool
(StackTraceRequestArguments -> StackTraceRequestArguments -> Bool)
-> (StackTraceRequestArguments
    -> StackTraceRequestArguments -> Bool)
-> Eq StackTraceRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackTraceRequestArguments -> StackTraceRequestArguments -> Bool
$c/= :: StackTraceRequestArguments -> StackTraceRequestArguments -> Bool
== :: StackTraceRequestArguments -> StackTraceRequestArguments -> Bool
$c== :: StackTraceRequestArguments -> StackTraceRequestArguments -> Bool
Eq)


-- |
--   A Stackframe contains the source location.
--
data StackFrame =
  StackFrame {
    StackFrame -> Int
idStackFrame        :: Int     -- ^An identifier for the stack frame. It must be unique across all threads. This id can be used to retrieve the scopes of the frame with the 'scopesRequest' or to restart the execution of a stackframe.
  , StackFrame -> String
nameStackFrame      :: String  -- ^The name of the stack frame, typically a method name.
  , StackFrame -> Source
sourceStackFrame    :: Source  -- ^The optional source of the frame.
  , StackFrame -> Int
lineStackFrame      :: Int     -- ^The line within the file of the frame. If source is null or doesn't exist, line is 0 and must be ignored.
  , StackFrame -> Int
columnStackFrame    :: Int     -- ^The column within the line. If source is null or doesn't exist, column is 0 and must be ignored.
  , StackFrame -> Int
endLineStackFrame   :: Int     -- ^An optional end line of the range covered by the stack frame.
  , StackFrame -> Int
endColumnStackFrame :: Int     -- ^An optional end column of the range covered by the stack frame.
  } deriving (Int -> StackFrame -> ShowS
[StackFrame] -> ShowS
StackFrame -> String
(Int -> StackFrame -> ShowS)
-> (StackFrame -> String)
-> ([StackFrame] -> ShowS)
-> Show StackFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackFrame] -> ShowS
$cshowList :: [StackFrame] -> ShowS
show :: StackFrame -> String
$cshow :: StackFrame -> String
showsPrec :: Int -> StackFrame -> ShowS
$cshowsPrec :: Int -> StackFrame -> ShowS
Show, ReadPrec [StackFrame]
ReadPrec StackFrame
Int -> ReadS StackFrame
ReadS [StackFrame]
(Int -> ReadS StackFrame)
-> ReadS [StackFrame]
-> ReadPrec StackFrame
-> ReadPrec [StackFrame]
-> Read StackFrame
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StackFrame]
$creadListPrec :: ReadPrec [StackFrame]
readPrec :: ReadPrec StackFrame
$creadPrec :: ReadPrec StackFrame
readList :: ReadS [StackFrame]
$creadList :: ReadS [StackFrame]
readsPrec :: Int -> ReadS StackFrame
$creadsPrec :: Int -> ReadS StackFrame
Read, StackFrame -> StackFrame -> Bool
(StackFrame -> StackFrame -> Bool)
-> (StackFrame -> StackFrame -> Bool) -> Eq StackFrame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackFrame -> StackFrame -> Bool
$c/= :: StackFrame -> StackFrame -> Bool
== :: StackFrame -> StackFrame -> Bool
$c== :: StackFrame -> StackFrame -> Bool
Eq)


-- |
--
defaultStackFrame :: StackFrame
defaultStackFrame :: StackFrame
defaultStackFrame = StackFrame :: Int -> String -> Source -> Int -> Int -> Int -> Int -> StackFrame
StackFrame {
    idStackFrame :: Int
idStackFrame = Int
0
  , nameStackFrame :: String
nameStackFrame = String
""
  , sourceStackFrame :: Source
sourceStackFrame = Source
defaultSource
  , lineStackFrame :: Int
lineStackFrame = Int
0
  , columnStackFrame :: Int
columnStackFrame = Int
0
  , endLineStackFrame :: Int
endLineStackFrame = Int
0
  , endColumnStackFrame :: Int
endColumnStackFrame = Int
0
}

-- |
--  Response to "stackTrace" request.
--
data StackTraceResponse =
  StackTraceResponse {
    StackTraceResponse -> Int
seqStackTraceResponse         :: Int     -- ^Sequence number
  , StackTraceResponse -> String
typeStackTraceResponse        :: String  -- ^One of "request", "response", or "event"
  , StackTraceResponse -> Int
request_seqStackTraceResponse :: Int     -- ^Sequence number of the corresponding request
  , StackTraceResponse -> Bool
successStackTraceResponse     :: Bool    -- ^Outcome of the request
  , StackTraceResponse -> String
commandStackTraceResponse     :: String  -- ^The command requested
  , StackTraceResponse -> String
messageStackTraceResponse     :: String  -- ^Contains error message if success == false.
  , StackTraceResponse -> StackTraceResponseBody
bodyStackTraceResponse        :: StackTraceResponseBody  -- ^The body of StackTraceResponse
  } deriving (Int -> StackTraceResponse -> ShowS
[StackTraceResponse] -> ShowS
StackTraceResponse -> String
(Int -> StackTraceResponse -> ShowS)
-> (StackTraceResponse -> String)
-> ([StackTraceResponse] -> ShowS)
-> Show StackTraceResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackTraceResponse] -> ShowS
$cshowList :: [StackTraceResponse] -> ShowS
show :: StackTraceResponse -> String
$cshow :: StackTraceResponse -> String
showsPrec :: Int -> StackTraceResponse -> ShowS
$cshowsPrec :: Int -> StackTraceResponse -> ShowS
Show, ReadPrec [StackTraceResponse]
ReadPrec StackTraceResponse
Int -> ReadS StackTraceResponse
ReadS [StackTraceResponse]
(Int -> ReadS StackTraceResponse)
-> ReadS [StackTraceResponse]
-> ReadPrec StackTraceResponse
-> ReadPrec [StackTraceResponse]
-> Read StackTraceResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StackTraceResponse]
$creadListPrec :: ReadPrec [StackTraceResponse]
readPrec :: ReadPrec StackTraceResponse
$creadPrec :: ReadPrec StackTraceResponse
readList :: ReadS [StackTraceResponse]
$creadList :: ReadS [StackTraceResponse]
readsPrec :: Int -> ReadS StackTraceResponse
$creadsPrec :: Int -> ReadS StackTraceResponse
Read, StackTraceResponse -> StackTraceResponse -> Bool
(StackTraceResponse -> StackTraceResponse -> Bool)
-> (StackTraceResponse -> StackTraceResponse -> Bool)
-> Eq StackTraceResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackTraceResponse -> StackTraceResponse -> Bool
$c/= :: StackTraceResponse -> StackTraceResponse -> Bool
== :: StackTraceResponse -> StackTraceResponse -> Bool
$c== :: StackTraceResponse -> StackTraceResponse -> Bool
Eq)

defaultStackTraceResponse :: StackTraceResponse
defaultStackTraceResponse :: StackTraceResponse
defaultStackTraceResponse = StackTraceResponse :: Int
-> String
-> Int
-> Bool
-> String
-> String
-> StackTraceResponseBody
-> StackTraceResponse
StackTraceResponse {
    seqStackTraceResponse :: Int
seqStackTraceResponse         = Int
0
  , typeStackTraceResponse :: String
typeStackTraceResponse        = String
"response"
  , request_seqStackTraceResponse :: Int
request_seqStackTraceResponse = Int
0
  , successStackTraceResponse :: Bool
successStackTraceResponse     = Bool
False
  , commandStackTraceResponse :: String
commandStackTraceResponse     = String
"stackTrace"
  , messageStackTraceResponse :: String
messageStackTraceResponse     = String
""
  , bodyStackTraceResponse :: StackTraceResponseBody
bodyStackTraceResponse        = StackTraceResponseBody
defaultStackTraceResponseBody
  }


-- |
--   Response to 'stackTrace' request.
--
data StackTraceResponseBody =
  StackTraceResponseBody {
    StackTraceResponseBody -> [StackFrame]
stackFramesStackTraceResponseBody :: [StackFrame]  -- ^The frames of the stackframe. If the array has length zero, there are no stackframes available. This means that there is no location information available.
  , StackTraceResponseBody -> Int
totalFramesStackTraceResponseBody :: Int           -- ^The total number of frames available.
  } deriving (Int -> StackTraceResponseBody -> ShowS
[StackTraceResponseBody] -> ShowS
StackTraceResponseBody -> String
(Int -> StackTraceResponseBody -> ShowS)
-> (StackTraceResponseBody -> String)
-> ([StackTraceResponseBody] -> ShowS)
-> Show StackTraceResponseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackTraceResponseBody] -> ShowS
$cshowList :: [StackTraceResponseBody] -> ShowS
show :: StackTraceResponseBody -> String
$cshow :: StackTraceResponseBody -> String
showsPrec :: Int -> StackTraceResponseBody -> ShowS
$cshowsPrec :: Int -> StackTraceResponseBody -> ShowS
Show, ReadPrec [StackTraceResponseBody]
ReadPrec StackTraceResponseBody
Int -> ReadS StackTraceResponseBody
ReadS [StackTraceResponseBody]
(Int -> ReadS StackTraceResponseBody)
-> ReadS [StackTraceResponseBody]
-> ReadPrec StackTraceResponseBody
-> ReadPrec [StackTraceResponseBody]
-> Read StackTraceResponseBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StackTraceResponseBody]
$creadListPrec :: ReadPrec [StackTraceResponseBody]
readPrec :: ReadPrec StackTraceResponseBody
$creadPrec :: ReadPrec StackTraceResponseBody
readList :: ReadS [StackTraceResponseBody]
$creadList :: ReadS [StackTraceResponseBody]
readsPrec :: Int -> ReadS StackTraceResponseBody
$creadsPrec :: Int -> ReadS StackTraceResponseBody
Read, StackTraceResponseBody -> StackTraceResponseBody -> Bool
(StackTraceResponseBody -> StackTraceResponseBody -> Bool)
-> (StackTraceResponseBody -> StackTraceResponseBody -> Bool)
-> Eq StackTraceResponseBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackTraceResponseBody -> StackTraceResponseBody -> Bool
$c/= :: StackTraceResponseBody -> StackTraceResponseBody -> Bool
== :: StackTraceResponseBody -> StackTraceResponseBody -> Bool
$c== :: StackTraceResponseBody -> StackTraceResponseBody -> Bool
Eq)

-- |
--
defaultStackTraceResponseBody :: StackTraceResponseBody
defaultStackTraceResponseBody :: StackTraceResponseBody
defaultStackTraceResponseBody = StackTraceResponseBody :: [StackFrame] -> Int -> StackTraceResponseBody
StackTraceResponseBody {
    stackFramesStackTraceResponseBody :: [StackFrame]
stackFramesStackTraceResponseBody = []
  , totalFramesStackTraceResponseBody :: Int
totalFramesStackTraceResponseBody = Int
0
  }

----------------------------------------------------------------------------
--  Scopes
----------------------------------------------------------------------------


-- |
--   Scopes request; value of command field is "scopes".
--
--   The request returns the variable scopes for a given stackframe ID.
--
data ScopesRequest =
  ScopesRequest {
    ScopesRequest -> Int
seqScopesRequest       :: Int              -- ^Sequence number
  , ScopesRequest -> String
typeScopesRequest      :: String           -- ^One of "request", "response", or "event"
  , ScopesRequest -> String
commandScopesRequest   :: String           -- ^The command to execute
  , ScopesRequest -> ScopesRequestArguments
argumentsScopesRequest :: ScopesRequestArguments  -- ^Arguments for "scopes" request.
  } deriving (Int -> ScopesRequest -> ShowS
[ScopesRequest] -> ShowS
ScopesRequest -> String
(Int -> ScopesRequest -> ShowS)
-> (ScopesRequest -> String)
-> ([ScopesRequest] -> ShowS)
-> Show ScopesRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScopesRequest] -> ShowS
$cshowList :: [ScopesRequest] -> ShowS
show :: ScopesRequest -> String
$cshow :: ScopesRequest -> String
showsPrec :: Int -> ScopesRequest -> ShowS
$cshowsPrec :: Int -> ScopesRequest -> ShowS
Show, ReadPrec [ScopesRequest]
ReadPrec ScopesRequest
Int -> ReadS ScopesRequest
ReadS [ScopesRequest]
(Int -> ReadS ScopesRequest)
-> ReadS [ScopesRequest]
-> ReadPrec ScopesRequest
-> ReadPrec [ScopesRequest]
-> Read ScopesRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScopesRequest]
$creadListPrec :: ReadPrec [ScopesRequest]
readPrec :: ReadPrec ScopesRequest
$creadPrec :: ReadPrec ScopesRequest
readList :: ReadS [ScopesRequest]
$creadList :: ReadS [ScopesRequest]
readsPrec :: Int -> ReadS ScopesRequest
$creadsPrec :: Int -> ReadS ScopesRequest
Read, ScopesRequest -> ScopesRequest -> Bool
(ScopesRequest -> ScopesRequest -> Bool)
-> (ScopesRequest -> ScopesRequest -> Bool) -> Eq ScopesRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScopesRequest -> ScopesRequest -> Bool
$c/= :: ScopesRequest -> ScopesRequest -> Bool
== :: ScopesRequest -> ScopesRequest -> Bool
$c== :: ScopesRequest -> ScopesRequest -> Bool
Eq)


-- |
--   Arguments for "scopes" request.
--
data ScopesRequestArguments =
  ScopesRequestArguments {
    ScopesRequestArguments -> Int
frameIdScopesRequestArguments :: Int  -- ^Retrieve the scopes for this stackframe.
  } deriving (Int -> ScopesRequestArguments -> ShowS
[ScopesRequestArguments] -> ShowS
ScopesRequestArguments -> String
(Int -> ScopesRequestArguments -> ShowS)
-> (ScopesRequestArguments -> String)
-> ([ScopesRequestArguments] -> ShowS)
-> Show ScopesRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScopesRequestArguments] -> ShowS
$cshowList :: [ScopesRequestArguments] -> ShowS
show :: ScopesRequestArguments -> String
$cshow :: ScopesRequestArguments -> String
showsPrec :: Int -> ScopesRequestArguments -> ShowS
$cshowsPrec :: Int -> ScopesRequestArguments -> ShowS
Show, ReadPrec [ScopesRequestArguments]
ReadPrec ScopesRequestArguments
Int -> ReadS ScopesRequestArguments
ReadS [ScopesRequestArguments]
(Int -> ReadS ScopesRequestArguments)
-> ReadS [ScopesRequestArguments]
-> ReadPrec ScopesRequestArguments
-> ReadPrec [ScopesRequestArguments]
-> Read ScopesRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScopesRequestArguments]
$creadListPrec :: ReadPrec [ScopesRequestArguments]
readPrec :: ReadPrec ScopesRequestArguments
$creadPrec :: ReadPrec ScopesRequestArguments
readList :: ReadS [ScopesRequestArguments]
$creadList :: ReadS [ScopesRequestArguments]
readsPrec :: Int -> ReadS ScopesRequestArguments
$creadsPrec :: Int -> ReadS ScopesRequestArguments
Read, ScopesRequestArguments -> ScopesRequestArguments -> Bool
(ScopesRequestArguments -> ScopesRequestArguments -> Bool)
-> (ScopesRequestArguments -> ScopesRequestArguments -> Bool)
-> Eq ScopesRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScopesRequestArguments -> ScopesRequestArguments -> Bool
$c/= :: ScopesRequestArguments -> ScopesRequestArguments -> Bool
== :: ScopesRequestArguments -> ScopesRequestArguments -> Bool
$c== :: ScopesRequestArguments -> ScopesRequestArguments -> Bool
Eq)


-- |
--  Response to "scopes" request.
--
data ScopesResponse =
  ScopesResponse {
    ScopesResponse -> Int
seqScopesResponse         :: Int     -- ^Sequence number
  , ScopesResponse -> String
typeScopesResponse        :: String  -- ^One of "request", "response", or "event"
  , ScopesResponse -> Int
request_seqScopesResponse :: Int     -- ^Sequence number of the corresponding request
  , ScopesResponse -> Bool
successScopesResponse     :: Bool    -- ^Outcome of the request
  , ScopesResponse -> String
commandScopesResponse     :: String  -- ^The command requested
  , ScopesResponse -> String
messageScopesResponse     :: String  -- ^Contains error message if success == false.
  , ScopesResponse -> ScopesResponseBody
bodyScopesResponse        :: ScopesResponseBody  -- ^The body of ScopesResponse.
  } deriving (Int -> ScopesResponse -> ShowS
[ScopesResponse] -> ShowS
ScopesResponse -> String
(Int -> ScopesResponse -> ShowS)
-> (ScopesResponse -> String)
-> ([ScopesResponse] -> ShowS)
-> Show ScopesResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScopesResponse] -> ShowS
$cshowList :: [ScopesResponse] -> ShowS
show :: ScopesResponse -> String
$cshow :: ScopesResponse -> String
showsPrec :: Int -> ScopesResponse -> ShowS
$cshowsPrec :: Int -> ScopesResponse -> ShowS
Show, ReadPrec [ScopesResponse]
ReadPrec ScopesResponse
Int -> ReadS ScopesResponse
ReadS [ScopesResponse]
(Int -> ReadS ScopesResponse)
-> ReadS [ScopesResponse]
-> ReadPrec ScopesResponse
-> ReadPrec [ScopesResponse]
-> Read ScopesResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScopesResponse]
$creadListPrec :: ReadPrec [ScopesResponse]
readPrec :: ReadPrec ScopesResponse
$creadPrec :: ReadPrec ScopesResponse
readList :: ReadS [ScopesResponse]
$creadList :: ReadS [ScopesResponse]
readsPrec :: Int -> ReadS ScopesResponse
$creadsPrec :: Int -> ReadS ScopesResponse
Read, ScopesResponse -> ScopesResponse -> Bool
(ScopesResponse -> ScopesResponse -> Bool)
-> (ScopesResponse -> ScopesResponse -> Bool) -> Eq ScopesResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScopesResponse -> ScopesResponse -> Bool
$c/= :: ScopesResponse -> ScopesResponse -> Bool
== :: ScopesResponse -> ScopesResponse -> Bool
$c== :: ScopesResponse -> ScopesResponse -> Bool
Eq)

-- |
--
defaultScopesResponse :: ScopesResponse
defaultScopesResponse :: ScopesResponse
defaultScopesResponse = ScopesResponse :: Int
-> String
-> Int
-> Bool
-> String
-> String
-> ScopesResponseBody
-> ScopesResponse
ScopesResponse {
    seqScopesResponse :: Int
seqScopesResponse         = Int
0
  , typeScopesResponse :: String
typeScopesResponse        = String
"response"
  , request_seqScopesResponse :: Int
request_seqScopesResponse = Int
0
  , successScopesResponse :: Bool
successScopesResponse     = Bool
False
  , commandScopesResponse :: String
commandScopesResponse     = String
"scopes"
  , messageScopesResponse :: String
messageScopesResponse     = String
""
  , bodyScopesResponse :: ScopesResponseBody
bodyScopesResponse        = ScopesResponseBody
defaultScopesResponseBody
  }

-- |
--   Response to 'scopes' request.
--
data ScopesResponseBody =
  ScopesResponseBody {
    ScopesResponseBody -> [Scope]
scopesScopesResponseBody :: [Scope]  -- ^The scopes of the stackframe. If the array has length zero, there are no scopes available.
  } deriving (Int -> ScopesResponseBody -> ShowS
[ScopesResponseBody] -> ShowS
ScopesResponseBody -> String
(Int -> ScopesResponseBody -> ShowS)
-> (ScopesResponseBody -> String)
-> ([ScopesResponseBody] -> ShowS)
-> Show ScopesResponseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScopesResponseBody] -> ShowS
$cshowList :: [ScopesResponseBody] -> ShowS
show :: ScopesResponseBody -> String
$cshow :: ScopesResponseBody -> String
showsPrec :: Int -> ScopesResponseBody -> ShowS
$cshowsPrec :: Int -> ScopesResponseBody -> ShowS
Show, ReadPrec [ScopesResponseBody]
ReadPrec ScopesResponseBody
Int -> ReadS ScopesResponseBody
ReadS [ScopesResponseBody]
(Int -> ReadS ScopesResponseBody)
-> ReadS [ScopesResponseBody]
-> ReadPrec ScopesResponseBody
-> ReadPrec [ScopesResponseBody]
-> Read ScopesResponseBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScopesResponseBody]
$creadListPrec :: ReadPrec [ScopesResponseBody]
readPrec :: ReadPrec ScopesResponseBody
$creadPrec :: ReadPrec ScopesResponseBody
readList :: ReadS [ScopesResponseBody]
$creadList :: ReadS [ScopesResponseBody]
readsPrec :: Int -> ReadS ScopesResponseBody
$creadsPrec :: Int -> ReadS ScopesResponseBody
Read, ScopesResponseBody -> ScopesResponseBody -> Bool
(ScopesResponseBody -> ScopesResponseBody -> Bool)
-> (ScopesResponseBody -> ScopesResponseBody -> Bool)
-> Eq ScopesResponseBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScopesResponseBody -> ScopesResponseBody -> Bool
$c/= :: ScopesResponseBody -> ScopesResponseBody -> Bool
== :: ScopesResponseBody -> ScopesResponseBody -> Bool
$c== :: ScopesResponseBody -> ScopesResponseBody -> Bool
Eq)


-- |
--
defaultScopesResponseBody :: ScopesResponseBody
defaultScopesResponseBody :: ScopesResponseBody
defaultScopesResponseBody = ScopesResponseBody :: [Scope] -> ScopesResponseBody
ScopesResponseBody {
    scopesScopesResponseBody :: [Scope]
scopesScopesResponseBody = []
  }

-- |
--   A Scope is a named container for variables. Optionally a scope can map to a source or a range within a source.
--
data Scope =
  Scope {
    Scope -> String
nameScope               :: String     -- ^Name of the scope such as 'Arguments', 'Locals'.
  , Scope -> Int
variablesReferenceScope :: Int        -- ^The variables of this scope can be retrieved by passing the value of variablesReference to the VariablesRequest.
  , Scope -> Maybe Int
namedVariablesScope     :: Maybe Int  -- ^The number of named variables in this scope. The client can use this optional information to present the variables in a paged UI and fetch them in chunks.
  , Scope -> Maybe Int
indexedVariablesScope   :: Maybe Int  -- ^The number of indexed variables in this scope. The client can use this optional information to present the variables in a paged UI and fetch them in chunks.
  , Scope -> Bool
expensiveScope          :: Bool       -- ^If true, the number of variables in this scope is large or expensive to retrieve.
  } deriving (Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
(Int -> Scope -> ShowS)
-> (Scope -> String) -> ([Scope] -> ShowS) -> Show Scope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> String
$cshow :: Scope -> String
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
Show, ReadPrec [Scope]
ReadPrec Scope
Int -> ReadS Scope
ReadS [Scope]
(Int -> ReadS Scope)
-> ReadS [Scope]
-> ReadPrec Scope
-> ReadPrec [Scope]
-> Read Scope
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Scope]
$creadListPrec :: ReadPrec [Scope]
readPrec :: ReadPrec Scope
$creadPrec :: ReadPrec Scope
readList :: ReadS [Scope]
$creadList :: ReadS [Scope]
readsPrec :: Int -> ReadS Scope
$creadsPrec :: Int -> ReadS Scope
Read, Scope -> Scope -> Bool
(Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c== :: Scope -> Scope -> Bool
Eq)

-- |
--
defaultScope :: Scope
defaultScope :: Scope
defaultScope = Scope :: String -> Int -> Maybe Int -> Maybe Int -> Bool -> Scope
Scope {
    nameScope :: String
nameScope = String
""
  , variablesReferenceScope :: Int
variablesReferenceScope = Int
0
  , namedVariablesScope :: Maybe Int
namedVariablesScope = Maybe Int
forall a. Maybe a
Nothing
  , indexedVariablesScope :: Maybe Int
indexedVariablesScope = Maybe Int
forall a. Maybe a
Nothing
  , expensiveScope :: Bool
expensiveScope = Bool
False
  }


----------------------------------------------------------------------------
--  Variables
----------------------------------------------------------------------------

-- |
--   Variables request; value of command field is "variables".
--
--   Retrieves all children for the given variable reference.
--
data VariablesRequest =
  VariablesRequest {
    VariablesRequest -> Int
seqVariablesRequest       :: Int                 -- ^Sequence number
  , VariablesRequest -> String
typeVariablesRequest      :: String              -- ^One of "request", "response", or "event"
  , VariablesRequest -> String
commandVariablesRequest   :: String              -- ^The command to execute
  , VariablesRequest -> VariablesRequestArguments
argumentsVariablesRequest :: VariablesRequestArguments  -- ^Arguments for "variables" request.
  } deriving (Int -> VariablesRequest -> ShowS
[VariablesRequest] -> ShowS
VariablesRequest -> String
(Int -> VariablesRequest -> ShowS)
-> (VariablesRequest -> String)
-> ([VariablesRequest] -> ShowS)
-> Show VariablesRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariablesRequest] -> ShowS
$cshowList :: [VariablesRequest] -> ShowS
show :: VariablesRequest -> String
$cshow :: VariablesRequest -> String
showsPrec :: Int -> VariablesRequest -> ShowS
$cshowsPrec :: Int -> VariablesRequest -> ShowS
Show, ReadPrec [VariablesRequest]
ReadPrec VariablesRequest
Int -> ReadS VariablesRequest
ReadS [VariablesRequest]
(Int -> ReadS VariablesRequest)
-> ReadS [VariablesRequest]
-> ReadPrec VariablesRequest
-> ReadPrec [VariablesRequest]
-> Read VariablesRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VariablesRequest]
$creadListPrec :: ReadPrec [VariablesRequest]
readPrec :: ReadPrec VariablesRequest
$creadPrec :: ReadPrec VariablesRequest
readList :: ReadS [VariablesRequest]
$creadList :: ReadS [VariablesRequest]
readsPrec :: Int -> ReadS VariablesRequest
$creadsPrec :: Int -> ReadS VariablesRequest
Read, VariablesRequest -> VariablesRequest -> Bool
(VariablesRequest -> VariablesRequest -> Bool)
-> (VariablesRequest -> VariablesRequest -> Bool)
-> Eq VariablesRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariablesRequest -> VariablesRequest -> Bool
$c/= :: VariablesRequest -> VariablesRequest -> Bool
== :: VariablesRequest -> VariablesRequest -> Bool
$c== :: VariablesRequest -> VariablesRequest -> Bool
Eq)


-- |
--  Response to "variables" request.
--
data VariablesResponse =
  VariablesResponse {
    VariablesResponse -> Int
seqVariablesResponse         :: Int     -- ^Sequence number
  , VariablesResponse -> String
typeVariablesResponse        :: String  -- ^One of "request", "response", or "event"
  , VariablesResponse -> Int
request_seqVariablesResponse :: Int     -- ^Sequence number of the corresponding request
  , VariablesResponse -> Bool
successVariablesResponse     :: Bool    -- ^Outcome of the request
  , VariablesResponse -> String
commandVariablesResponse     :: String  -- ^The command requested
  , VariablesResponse -> String
messageVariablesResponse     :: String  -- ^Contains error message if success == false.
  , VariablesResponse -> VariablesResponseBody
bodyVariablesResponse        :: VariablesResponseBody  -- ^The body of VariablesResponse
  } deriving (Int -> VariablesResponse -> ShowS
[VariablesResponse] -> ShowS
VariablesResponse -> String
(Int -> VariablesResponse -> ShowS)
-> (VariablesResponse -> String)
-> ([VariablesResponse] -> ShowS)
-> Show VariablesResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariablesResponse] -> ShowS
$cshowList :: [VariablesResponse] -> ShowS
show :: VariablesResponse -> String
$cshow :: VariablesResponse -> String
showsPrec :: Int -> VariablesResponse -> ShowS
$cshowsPrec :: Int -> VariablesResponse -> ShowS
Show, ReadPrec [VariablesResponse]
ReadPrec VariablesResponse
Int -> ReadS VariablesResponse
ReadS [VariablesResponse]
(Int -> ReadS VariablesResponse)
-> ReadS [VariablesResponse]
-> ReadPrec VariablesResponse
-> ReadPrec [VariablesResponse]
-> Read VariablesResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VariablesResponse]
$creadListPrec :: ReadPrec [VariablesResponse]
readPrec :: ReadPrec VariablesResponse
$creadPrec :: ReadPrec VariablesResponse
readList :: ReadS [VariablesResponse]
$creadList :: ReadS [VariablesResponse]
readsPrec :: Int -> ReadS VariablesResponse
$creadsPrec :: Int -> ReadS VariablesResponse
Read, VariablesResponse -> VariablesResponse -> Bool
(VariablesResponse -> VariablesResponse -> Bool)
-> (VariablesResponse -> VariablesResponse -> Bool)
-> Eq VariablesResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariablesResponse -> VariablesResponse -> Bool
$c/= :: VariablesResponse -> VariablesResponse -> Bool
== :: VariablesResponse -> VariablesResponse -> Bool
$c== :: VariablesResponse -> VariablesResponse -> Bool
Eq)


-- |
--
defaultVariablesResponse :: VariablesResponse
defaultVariablesResponse :: VariablesResponse
defaultVariablesResponse = VariablesResponse :: Int
-> String
-> Int
-> Bool
-> String
-> String
-> VariablesResponseBody
-> VariablesResponse
VariablesResponse {
    seqVariablesResponse :: Int
seqVariablesResponse         = Int
0
  , typeVariablesResponse :: String
typeVariablesResponse        = String
"response"
  , request_seqVariablesResponse :: Int
request_seqVariablesResponse = Int
0
  , successVariablesResponse :: Bool
successVariablesResponse     = Bool
False
  , commandVariablesResponse :: String
commandVariablesResponse     = String
"variables"
  , messageVariablesResponse :: String
messageVariablesResponse     = String
""
  , bodyVariablesResponse :: VariablesResponseBody
bodyVariablesResponse        = VariablesResponseBody
defaultVariablesResponseBody
  }


-- |
--   Arguments for 'variables' request.
--
data VariablesRequestArguments =
  VariablesRequestArguments {
    VariablesRequestArguments -> Int
variablesReferenceVariablesRequestArguments :: Int  -- ^The Variable reference.
  } deriving (Int -> VariablesRequestArguments -> ShowS
[VariablesRequestArguments] -> ShowS
VariablesRequestArguments -> String
(Int -> VariablesRequestArguments -> ShowS)
-> (VariablesRequestArguments -> String)
-> ([VariablesRequestArguments] -> ShowS)
-> Show VariablesRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariablesRequestArguments] -> ShowS
$cshowList :: [VariablesRequestArguments] -> ShowS
show :: VariablesRequestArguments -> String
$cshow :: VariablesRequestArguments -> String
showsPrec :: Int -> VariablesRequestArguments -> ShowS
$cshowsPrec :: Int -> VariablesRequestArguments -> ShowS
Show, ReadPrec [VariablesRequestArguments]
ReadPrec VariablesRequestArguments
Int -> ReadS VariablesRequestArguments
ReadS [VariablesRequestArguments]
(Int -> ReadS VariablesRequestArguments)
-> ReadS [VariablesRequestArguments]
-> ReadPrec VariablesRequestArguments
-> ReadPrec [VariablesRequestArguments]
-> Read VariablesRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VariablesRequestArguments]
$creadListPrec :: ReadPrec [VariablesRequestArguments]
readPrec :: ReadPrec VariablesRequestArguments
$creadPrec :: ReadPrec VariablesRequestArguments
readList :: ReadS [VariablesRequestArguments]
$creadList :: ReadS [VariablesRequestArguments]
readsPrec :: Int -> ReadS VariablesRequestArguments
$creadsPrec :: Int -> ReadS VariablesRequestArguments
Read, VariablesRequestArguments -> VariablesRequestArguments -> Bool
(VariablesRequestArguments -> VariablesRequestArguments -> Bool)
-> (VariablesRequestArguments -> VariablesRequestArguments -> Bool)
-> Eq VariablesRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariablesRequestArguments -> VariablesRequestArguments -> Bool
$c/= :: VariablesRequestArguments -> VariablesRequestArguments -> Bool
== :: VariablesRequestArguments -> VariablesRequestArguments -> Bool
$c== :: VariablesRequestArguments -> VariablesRequestArguments -> Bool
Eq)


-- |
--    Response to "variables" request.
--
data VariablesResponseBody =
  VariablesResponseBody {
    VariablesResponseBody -> [Variable]
variablesVariablesResponseBody :: [Variable]  -- ^All (or a range) of variables for the given variable reference.
  } deriving (Int -> VariablesResponseBody -> ShowS
[VariablesResponseBody] -> ShowS
VariablesResponseBody -> String
(Int -> VariablesResponseBody -> ShowS)
-> (VariablesResponseBody -> String)
-> ([VariablesResponseBody] -> ShowS)
-> Show VariablesResponseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariablesResponseBody] -> ShowS
$cshowList :: [VariablesResponseBody] -> ShowS
show :: VariablesResponseBody -> String
$cshow :: VariablesResponseBody -> String
showsPrec :: Int -> VariablesResponseBody -> ShowS
$cshowsPrec :: Int -> VariablesResponseBody -> ShowS
Show, ReadPrec [VariablesResponseBody]
ReadPrec VariablesResponseBody
Int -> ReadS VariablesResponseBody
ReadS [VariablesResponseBody]
(Int -> ReadS VariablesResponseBody)
-> ReadS [VariablesResponseBody]
-> ReadPrec VariablesResponseBody
-> ReadPrec [VariablesResponseBody]
-> Read VariablesResponseBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VariablesResponseBody]
$creadListPrec :: ReadPrec [VariablesResponseBody]
readPrec :: ReadPrec VariablesResponseBody
$creadPrec :: ReadPrec VariablesResponseBody
readList :: ReadS [VariablesResponseBody]
$creadList :: ReadS [VariablesResponseBody]
readsPrec :: Int -> ReadS VariablesResponseBody
$creadsPrec :: Int -> ReadS VariablesResponseBody
Read, VariablesResponseBody -> VariablesResponseBody -> Bool
(VariablesResponseBody -> VariablesResponseBody -> Bool)
-> (VariablesResponseBody -> VariablesResponseBody -> Bool)
-> Eq VariablesResponseBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariablesResponseBody -> VariablesResponseBody -> Bool
$c/= :: VariablesResponseBody -> VariablesResponseBody -> Bool
== :: VariablesResponseBody -> VariablesResponseBody -> Bool
$c== :: VariablesResponseBody -> VariablesResponseBody -> Bool
Eq)


-- |
--
defaultVariablesResponseBody :: VariablesResponseBody
defaultVariablesResponseBody :: VariablesResponseBody
defaultVariablesResponseBody = [Variable] -> VariablesResponseBody
VariablesResponseBody []


-- |
--   A Variable is a name/value pair.
--
--   If the value is structured (has children), a handle is provided to retrieve the children with the VariablesRequest.
--
data Variable =
  Variable {
    Variable -> String
nameVariable               :: String  -- ^The variable's name.
  , Variable -> String
valueVariable              :: String  -- ^The variable's value. This can be a multi-line text, e.g. for a function the body of a function.
  , Variable -> String
typeVariable               :: String  -- ^The type of the variable's value. Typically shown in the UI when hovering over the value.
  , Variable -> Maybe VariablePresentationHint
presentationHintVariable   :: Maybe VariablePresentationHint -- ^Properties of a variable that can be used to determine how to render the variable in the UI.
  , Variable -> Maybe String
evaluateNameVariable       :: Maybe String  -- ^Optional evaluatable name of this variable which can be passed to the 'EvaluateRequest' to fetch the variable's value.
  , Variable -> Int
variablesReferenceVariable :: Int           -- ^If variablesReference is > 0, the variable is structured and its children can be retrieved by passing variablesReference to the VariablesRequest.
  , Variable -> Maybe Int
namedVariablesVariable     :: Maybe Int     -- ^The number of named child variables.
  , Variable -> Maybe Int
indexedVariablesVariable   :: Maybe Int     -- ^The number of indexed child variables. The client can use this optional information to present the children in a paged UI and fetch them in chunks.
  } deriving (Int -> Variable -> ShowS
[Variable] -> ShowS
Variable -> String
(Int -> Variable -> ShowS)
-> (Variable -> String) -> ([Variable] -> ShowS) -> Show Variable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Variable] -> ShowS
$cshowList :: [Variable] -> ShowS
show :: Variable -> String
$cshow :: Variable -> String
showsPrec :: Int -> Variable -> ShowS
$cshowsPrec :: Int -> Variable -> ShowS
Show, ReadPrec [Variable]
ReadPrec Variable
Int -> ReadS Variable
ReadS [Variable]
(Int -> ReadS Variable)
-> ReadS [Variable]
-> ReadPrec Variable
-> ReadPrec [Variable]
-> Read Variable
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Variable]
$creadListPrec :: ReadPrec [Variable]
readPrec :: ReadPrec Variable
$creadPrec :: ReadPrec Variable
readList :: ReadS [Variable]
$creadList :: ReadS [Variable]
readsPrec :: Int -> ReadS Variable
$creadsPrec :: Int -> ReadS Variable
Read, Variable -> Variable -> Bool
(Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool) -> Eq Variable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Variable -> Variable -> Bool
$c/= :: Variable -> Variable -> Bool
== :: Variable -> Variable -> Bool
$c== :: Variable -> Variable -> Bool
Eq)

-- |
--
defaultVariable :: Variable
defaultVariable :: Variable
defaultVariable = Variable :: String
-> String
-> String
-> Maybe VariablePresentationHint
-> Maybe String
-> Int
-> Maybe Int
-> Maybe Int
-> Variable
Variable {
    nameVariable :: String
nameVariable = String
""
  , valueVariable :: String
valueVariable = String
""
  , typeVariable :: String
typeVariable = String
""
  , presentationHintVariable :: Maybe VariablePresentationHint
presentationHintVariable = Maybe VariablePresentationHint
forall a. Maybe a
Nothing
  , evaluateNameVariable :: Maybe String
evaluateNameVariable = Maybe String
forall a. Maybe a
Nothing
  , variablesReferenceVariable :: Int
variablesReferenceVariable = Int
0
  , namedVariablesVariable :: Maybe Int
namedVariablesVariable = Maybe Int
forall a. Maybe a
Nothing
  , indexedVariablesVariable :: Maybe Int
indexedVariablesVariable = Maybe Int
forall a. Maybe a
Nothing
  }

-- |
--   Optional properties of a variable that can be used to determine how to render the variable in the UI.
--
data VariablePresentationHint =
  VariablePresentationHint {
    {-|
      The kind of variable. Before introducing additional values, try to use the listed values.

      Values:

      'property': Indicates that the object is a property.

      'method': Indicates that the object is a method.

			'class': Indicates that the object is a class.

      'data': Indicates that the object is data.

      'event': Indicates that the object is an event.

      'baseClass': Indicates that the object is a base class.

      'innerClass': Indicates that the object is an inner class.

      'interface': Indicates that the object is an interface.

      'mostDerivedClass': Indicates that the object is the most derived class.

      'virtual': Indicates that the object is virtual, that means it is a synthetic object introduced by the adapter for rendering purposes, e.g. an index range for large arrays.
    -}
    VariablePresentationHint -> String
kindVariablePresentationHint       :: String
    {-|
		  Set of attributes represented as an array of strings. Before introducing additional values, try to use the listed values.
			Values:

      'static': Indicates that the object is static.

      'constant': Indicates that the object is a constant.

      'readOnly': Indicates that the object is read only.

      'rawString': Indicates that the object is a raw string.

      'hasObjectId': Indicates that the object can have an Object ID created for it.

      'canHaveObjectId': Indicates that the object has an Object ID associated with it.

      'hasSideEffects': Indicates that the evaluation had side effects.
    -}
  , VariablePresentationHint -> [String]
attributesVariablePresentationHint :: [String]
    {-|
		  Visibility of variable. Before introducing additional values, try to use the listed values.

			Values: 'public', 'private', 'protected', 'internal', 'final', etc.
    -}
  , VariablePresentationHint -> String
visibilityVariablePresentationHint :: String
  } deriving (Int -> VariablePresentationHint -> ShowS
[VariablePresentationHint] -> ShowS
VariablePresentationHint -> String
(Int -> VariablePresentationHint -> ShowS)
-> (VariablePresentationHint -> String)
-> ([VariablePresentationHint] -> ShowS)
-> Show VariablePresentationHint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariablePresentationHint] -> ShowS
$cshowList :: [VariablePresentationHint] -> ShowS
show :: VariablePresentationHint -> String
$cshow :: VariablePresentationHint -> String
showsPrec :: Int -> VariablePresentationHint -> ShowS
$cshowsPrec :: Int -> VariablePresentationHint -> ShowS
Show, ReadPrec [VariablePresentationHint]
ReadPrec VariablePresentationHint
Int -> ReadS VariablePresentationHint
ReadS [VariablePresentationHint]
(Int -> ReadS VariablePresentationHint)
-> ReadS [VariablePresentationHint]
-> ReadPrec VariablePresentationHint
-> ReadPrec [VariablePresentationHint]
-> Read VariablePresentationHint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VariablePresentationHint]
$creadListPrec :: ReadPrec [VariablePresentationHint]
readPrec :: ReadPrec VariablePresentationHint
$creadPrec :: ReadPrec VariablePresentationHint
readList :: ReadS [VariablePresentationHint]
$creadList :: ReadS [VariablePresentationHint]
readsPrec :: Int -> ReadS VariablePresentationHint
$creadsPrec :: Int -> ReadS VariablePresentationHint
Read, VariablePresentationHint -> VariablePresentationHint -> Bool
(VariablePresentationHint -> VariablePresentationHint -> Bool)
-> (VariablePresentationHint -> VariablePresentationHint -> Bool)
-> Eq VariablePresentationHint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariablePresentationHint -> VariablePresentationHint -> Bool
$c/= :: VariablePresentationHint -> VariablePresentationHint -> Bool
== :: VariablePresentationHint -> VariablePresentationHint -> Bool
$c== :: VariablePresentationHint -> VariablePresentationHint -> Bool
Eq)



----------------------------------------------------------------------------
--  Continue
----------------------------------------------------------------------------

-- |
--   Continue request; value of command field is "continue".
--
--   The request starts the debuggee to run again.
--
data ContinueRequest =
  ContinueRequest {
    ContinueRequest -> Int
seqContinueRequest       :: Int               -- ^Sequence number
  , ContinueRequest -> String
typeContinueRequest      :: String            -- ^One of "request", "response", or "event"
  , ContinueRequest -> String
commandContinueRequest   :: String            -- ^The command to execute
  , ContinueRequest -> ContinueRequestArguments
argumentsContinueRequest :: ContinueRequestArguments -- ^Arguments for "continue" request.
  } deriving (Int -> ContinueRequest -> ShowS
[ContinueRequest] -> ShowS
ContinueRequest -> String
(Int -> ContinueRequest -> ShowS)
-> (ContinueRequest -> String)
-> ([ContinueRequest] -> ShowS)
-> Show ContinueRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContinueRequest] -> ShowS
$cshowList :: [ContinueRequest] -> ShowS
show :: ContinueRequest -> String
$cshow :: ContinueRequest -> String
showsPrec :: Int -> ContinueRequest -> ShowS
$cshowsPrec :: Int -> ContinueRequest -> ShowS
Show, ReadPrec [ContinueRequest]
ReadPrec ContinueRequest
Int -> ReadS ContinueRequest
ReadS [ContinueRequest]
(Int -> ReadS ContinueRequest)
-> ReadS [ContinueRequest]
-> ReadPrec ContinueRequest
-> ReadPrec [ContinueRequest]
-> Read ContinueRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContinueRequest]
$creadListPrec :: ReadPrec [ContinueRequest]
readPrec :: ReadPrec ContinueRequest
$creadPrec :: ReadPrec ContinueRequest
readList :: ReadS [ContinueRequest]
$creadList :: ReadS [ContinueRequest]
readsPrec :: Int -> ReadS ContinueRequest
$creadsPrec :: Int -> ReadS ContinueRequest
Read, ContinueRequest -> ContinueRequest -> Bool
(ContinueRequest -> ContinueRequest -> Bool)
-> (ContinueRequest -> ContinueRequest -> Bool)
-> Eq ContinueRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContinueRequest -> ContinueRequest -> Bool
$c/= :: ContinueRequest -> ContinueRequest -> Bool
== :: ContinueRequest -> ContinueRequest -> Bool
$c== :: ContinueRequest -> ContinueRequest -> Bool
Eq)



-- |
--   Arguments for 'continue' request.
--
data ContinueRequestArguments =
  ContinueRequestArguments {
    ContinueRequestArguments -> Int
threadIdContinueRequestArguments :: Int          -- ^Continue execution for the specified thread (if possible). If the backend cannot continue on a single thread but will continue on all threads, it should set the allThreadsContinued attribute in the response to true.
  , ContinueRequestArguments -> Maybe String
exprContinueRequestArguments     :: Maybe String -- ^ADD: haskell-dap
  } deriving (Int -> ContinueRequestArguments -> ShowS
[ContinueRequestArguments] -> ShowS
ContinueRequestArguments -> String
(Int -> ContinueRequestArguments -> ShowS)
-> (ContinueRequestArguments -> String)
-> ([ContinueRequestArguments] -> ShowS)
-> Show ContinueRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContinueRequestArguments] -> ShowS
$cshowList :: [ContinueRequestArguments] -> ShowS
show :: ContinueRequestArguments -> String
$cshow :: ContinueRequestArguments -> String
showsPrec :: Int -> ContinueRequestArguments -> ShowS
$cshowsPrec :: Int -> ContinueRequestArguments -> ShowS
Show, ReadPrec [ContinueRequestArguments]
ReadPrec ContinueRequestArguments
Int -> ReadS ContinueRequestArguments
ReadS [ContinueRequestArguments]
(Int -> ReadS ContinueRequestArguments)
-> ReadS [ContinueRequestArguments]
-> ReadPrec ContinueRequestArguments
-> ReadPrec [ContinueRequestArguments]
-> Read ContinueRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContinueRequestArguments]
$creadListPrec :: ReadPrec [ContinueRequestArguments]
readPrec :: ReadPrec ContinueRequestArguments
$creadPrec :: ReadPrec ContinueRequestArguments
readList :: ReadS [ContinueRequestArguments]
$creadList :: ReadS [ContinueRequestArguments]
readsPrec :: Int -> ReadS ContinueRequestArguments
$creadsPrec :: Int -> ReadS ContinueRequestArguments
Read, ContinueRequestArguments -> ContinueRequestArguments -> Bool
(ContinueRequestArguments -> ContinueRequestArguments -> Bool)
-> (ContinueRequestArguments -> ContinueRequestArguments -> Bool)
-> Eq ContinueRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContinueRequestArguments -> ContinueRequestArguments -> Bool
$c/= :: ContinueRequestArguments -> ContinueRequestArguments -> Bool
== :: ContinueRequestArguments -> ContinueRequestArguments -> Bool
$c== :: ContinueRequestArguments -> ContinueRequestArguments -> Bool
Eq)


-- |
--
defaultContinueRequestArguments :: ContinueRequestArguments
defaultContinueRequestArguments :: ContinueRequestArguments
defaultContinueRequestArguments = ContinueRequestArguments :: Int -> Maybe String -> ContinueRequestArguments
ContinueRequestArguments {
    threadIdContinueRequestArguments :: Int
threadIdContinueRequestArguments = Int
_THREAD_ID
  , exprContinueRequestArguments :: Maybe String
exprContinueRequestArguments = Maybe String
forall a. Maybe a
Nothing
  }


-- |
--   Response to "continue" request. This is just an acknowledgement, so no body field is required.
--
data ContinueResponse =
  ContinueResponse {
    ContinueResponse -> Int
seqContinueResponse         :: Int     -- ^Sequence number
  , ContinueResponse -> String
typeContinueResponse        :: String  -- ^One of "request", "response", or "event"
  , ContinueResponse -> Int
request_seqContinueResponse :: Int     -- ^Sequence number of the corresponding request
  , ContinueResponse -> Bool
successContinueResponse     :: Bool    -- ^Outcome of the request
  , ContinueResponse -> String
commandContinueResponse     :: String  -- ^The command requested
  , ContinueResponse -> String
messageContinueResponse     :: String  -- ^Contains error message if success == false.
  } deriving (Int -> ContinueResponse -> ShowS
[ContinueResponse] -> ShowS
ContinueResponse -> String
(Int -> ContinueResponse -> ShowS)
-> (ContinueResponse -> String)
-> ([ContinueResponse] -> ShowS)
-> Show ContinueResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContinueResponse] -> ShowS
$cshowList :: [ContinueResponse] -> ShowS
show :: ContinueResponse -> String
$cshow :: ContinueResponse -> String
showsPrec :: Int -> ContinueResponse -> ShowS
$cshowsPrec :: Int -> ContinueResponse -> ShowS
Show, ReadPrec [ContinueResponse]
ReadPrec ContinueResponse
Int -> ReadS ContinueResponse
ReadS [ContinueResponse]
(Int -> ReadS ContinueResponse)
-> ReadS [ContinueResponse]
-> ReadPrec ContinueResponse
-> ReadPrec [ContinueResponse]
-> Read ContinueResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContinueResponse]
$creadListPrec :: ReadPrec [ContinueResponse]
readPrec :: ReadPrec ContinueResponse
$creadPrec :: ReadPrec ContinueResponse
readList :: ReadS [ContinueResponse]
$creadList :: ReadS [ContinueResponse]
readsPrec :: Int -> ReadS ContinueResponse
$creadsPrec :: Int -> ReadS ContinueResponse
Read, ContinueResponse -> ContinueResponse -> Bool
(ContinueResponse -> ContinueResponse -> Bool)
-> (ContinueResponse -> ContinueResponse -> Bool)
-> Eq ContinueResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContinueResponse -> ContinueResponse -> Bool
$c/= :: ContinueResponse -> ContinueResponse -> Bool
== :: ContinueResponse -> ContinueResponse -> Bool
$c== :: ContinueResponse -> ContinueResponse -> Bool
Eq)


-- |
--
defaultContinueResponse :: ContinueResponse
defaultContinueResponse :: ContinueResponse
defaultContinueResponse = ContinueResponse :: Int
-> String -> Int -> Bool -> String -> String -> ContinueResponse
ContinueResponse {
    seqContinueResponse :: Int
seqContinueResponse         = Int
0
  , typeContinueResponse :: String
typeContinueResponse        = String
"response"
  , request_seqContinueResponse :: Int
request_seqContinueResponse = Int
0
  , successContinueResponse :: Bool
successContinueResponse     = Bool
False
  , commandContinueResponse :: String
commandContinueResponse     = String
"continue"
  , messageContinueResponse :: String
messageContinueResponse     = String
""
  }


----------------------------------------------------------------------------
--  Next
----------------------------------------------------------------------------

-- |
--   Next request; value of command field is "next".
--
--   The request starts the debuggee to run again for one step.
--
--   penDebug will respond with a StoppedEvent (event type 'step') after running the step.
--
data NextRequest =
  NextRequest {
    NextRequest -> Int
seqNextRequest       :: Int            -- ^Sequence number
  , NextRequest -> String
typeNextRequest      :: String         -- ^One of "request", "response", or "event"
  , NextRequest -> String
commandNextRequest   :: String         -- ^The command to execute
  , NextRequest -> NextRequestArguments
argumentsNextRequest :: NextRequestArguments  -- ^Arguments for "disconnect" request.
  } deriving (Int -> NextRequest -> ShowS
[NextRequest] -> ShowS
NextRequest -> String
(Int -> NextRequest -> ShowS)
-> (NextRequest -> String)
-> ([NextRequest] -> ShowS)
-> Show NextRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NextRequest] -> ShowS
$cshowList :: [NextRequest] -> ShowS
show :: NextRequest -> String
$cshow :: NextRequest -> String
showsPrec :: Int -> NextRequest -> ShowS
$cshowsPrec :: Int -> NextRequest -> ShowS
Show, ReadPrec [NextRequest]
ReadPrec NextRequest
Int -> ReadS NextRequest
ReadS [NextRequest]
(Int -> ReadS NextRequest)
-> ReadS [NextRequest]
-> ReadPrec NextRequest
-> ReadPrec [NextRequest]
-> Read NextRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NextRequest]
$creadListPrec :: ReadPrec [NextRequest]
readPrec :: ReadPrec NextRequest
$creadPrec :: ReadPrec NextRequest
readList :: ReadS [NextRequest]
$creadList :: ReadS [NextRequest]
readsPrec :: Int -> ReadS NextRequest
$creadsPrec :: Int -> ReadS NextRequest
Read, NextRequest -> NextRequest -> Bool
(NextRequest -> NextRequest -> Bool)
-> (NextRequest -> NextRequest -> Bool) -> Eq NextRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NextRequest -> NextRequest -> Bool
$c/= :: NextRequest -> NextRequest -> Bool
== :: NextRequest -> NextRequest -> Bool
$c== :: NextRequest -> NextRequest -> Bool
Eq)


-- |
--   Arguments for 'next' request.
--
data NextRequestArguments =
  NextRequestArguments {
    NextRequestArguments -> Int
threadIdNextRequestArguments :: Int -- ^Execute 'next' for this thread.
  } deriving (Int -> NextRequestArguments -> ShowS
[NextRequestArguments] -> ShowS
NextRequestArguments -> String
(Int -> NextRequestArguments -> ShowS)
-> (NextRequestArguments -> String)
-> ([NextRequestArguments] -> ShowS)
-> Show NextRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NextRequestArguments] -> ShowS
$cshowList :: [NextRequestArguments] -> ShowS
show :: NextRequestArguments -> String
$cshow :: NextRequestArguments -> String
showsPrec :: Int -> NextRequestArguments -> ShowS
$cshowsPrec :: Int -> NextRequestArguments -> ShowS
Show, ReadPrec [NextRequestArguments]
ReadPrec NextRequestArguments
Int -> ReadS NextRequestArguments
ReadS [NextRequestArguments]
(Int -> ReadS NextRequestArguments)
-> ReadS [NextRequestArguments]
-> ReadPrec NextRequestArguments
-> ReadPrec [NextRequestArguments]
-> Read NextRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NextRequestArguments]
$creadListPrec :: ReadPrec [NextRequestArguments]
readPrec :: ReadPrec NextRequestArguments
$creadPrec :: ReadPrec NextRequestArguments
readList :: ReadS [NextRequestArguments]
$creadList :: ReadS [NextRequestArguments]
readsPrec :: Int -> ReadS NextRequestArguments
$creadsPrec :: Int -> ReadS NextRequestArguments
Read, NextRequestArguments -> NextRequestArguments -> Bool
(NextRequestArguments -> NextRequestArguments -> Bool)
-> (NextRequestArguments -> NextRequestArguments -> Bool)
-> Eq NextRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NextRequestArguments -> NextRequestArguments -> Bool
$c/= :: NextRequestArguments -> NextRequestArguments -> Bool
== :: NextRequestArguments -> NextRequestArguments -> Bool
$c== :: NextRequestArguments -> NextRequestArguments -> Bool
Eq)


-- |
--   Response to "next" request. This is just an acknowledgement, so no body field is required.
--
data NextResponse =
  NextResponse {
    NextResponse -> Int
seqNextResponse         :: Int     -- ^Sequence number
  , NextResponse -> String
typeNextResponse        :: String  -- ^One of "request", "response", or "event"
  , NextResponse -> Int
request_seqNextResponse :: Int     -- ^Sequence number of the corresponding request
  , NextResponse -> Bool
successNextResponse     :: Bool    -- ^Outcome of the request
  , NextResponse -> String
commandNextResponse     :: String  -- ^The command requested
  , NextResponse -> String
messageNextResponse     :: String  -- ^Contains error message if success == false.
  } deriving (Int -> NextResponse -> ShowS
[NextResponse] -> ShowS
NextResponse -> String
(Int -> NextResponse -> ShowS)
-> (NextResponse -> String)
-> ([NextResponse] -> ShowS)
-> Show NextResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NextResponse] -> ShowS
$cshowList :: [NextResponse] -> ShowS
show :: NextResponse -> String
$cshow :: NextResponse -> String
showsPrec :: Int -> NextResponse -> ShowS
$cshowsPrec :: Int -> NextResponse -> ShowS
Show, ReadPrec [NextResponse]
ReadPrec NextResponse
Int -> ReadS NextResponse
ReadS [NextResponse]
(Int -> ReadS NextResponse)
-> ReadS [NextResponse]
-> ReadPrec NextResponse
-> ReadPrec [NextResponse]
-> Read NextResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NextResponse]
$creadListPrec :: ReadPrec [NextResponse]
readPrec :: ReadPrec NextResponse
$creadPrec :: ReadPrec NextResponse
readList :: ReadS [NextResponse]
$creadList :: ReadS [NextResponse]
readsPrec :: Int -> ReadS NextResponse
$creadsPrec :: Int -> ReadS NextResponse
Read, NextResponse -> NextResponse -> Bool
(NextResponse -> NextResponse -> Bool)
-> (NextResponse -> NextResponse -> Bool) -> Eq NextResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NextResponse -> NextResponse -> Bool
$c/= :: NextResponse -> NextResponse -> Bool
== :: NextResponse -> NextResponse -> Bool
$c== :: NextResponse -> NextResponse -> Bool
Eq)


-- |
--
defaultNextResponse :: NextResponse
defaultNextResponse :: NextResponse
defaultNextResponse = NextResponse :: Int -> String -> Int -> Bool -> String -> String -> NextResponse
NextResponse {
    seqNextResponse :: Int
seqNextResponse         = Int
0
  , typeNextResponse :: String
typeNextResponse        = String
"response"
  , request_seqNextResponse :: Int
request_seqNextResponse = Int
0
  , successNextResponse :: Bool
successNextResponse     = Bool
False
  , commandNextResponse :: String
commandNextResponse     = String
"next"
  , messageNextResponse :: String
messageNextResponse     = String
""
  }


----------------------------------------------------------------------------
--  StepIn
----------------------------------------------------------------------------

-- |
--   StepIn request; value of command field is "stepIn".
--
--   The request starts the debuggee to run again for one step.
--
--   The debug adapter will respond with a StoppedEvent (event type 'step') after running the step.
--
data StepInRequest =
  StepInRequest {
    StepInRequest -> Int
seqStepInRequest       :: Int              -- ^Sequence number
  , StepInRequest -> String
typeStepInRequest      :: String           -- ^One of "request", "response", or "event"
  , StepInRequest -> String
commandStepInRequest   :: String           -- ^The command to execute
  , StepInRequest -> StepInRequestArguments
argumentsStepInRequest :: StepInRequestArguments  -- ^Arguments for "stepIn" request.
  } deriving (Int -> StepInRequest -> ShowS
[StepInRequest] -> ShowS
StepInRequest -> String
(Int -> StepInRequest -> ShowS)
-> (StepInRequest -> String)
-> ([StepInRequest] -> ShowS)
-> Show StepInRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StepInRequest] -> ShowS
$cshowList :: [StepInRequest] -> ShowS
show :: StepInRequest -> String
$cshow :: StepInRequest -> String
showsPrec :: Int -> StepInRequest -> ShowS
$cshowsPrec :: Int -> StepInRequest -> ShowS
Show, ReadPrec [StepInRequest]
ReadPrec StepInRequest
Int -> ReadS StepInRequest
ReadS [StepInRequest]
(Int -> ReadS StepInRequest)
-> ReadS [StepInRequest]
-> ReadPrec StepInRequest
-> ReadPrec [StepInRequest]
-> Read StepInRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StepInRequest]
$creadListPrec :: ReadPrec [StepInRequest]
readPrec :: ReadPrec StepInRequest
$creadPrec :: ReadPrec StepInRequest
readList :: ReadS [StepInRequest]
$creadList :: ReadS [StepInRequest]
readsPrec :: Int -> ReadS StepInRequest
$creadsPrec :: Int -> ReadS StepInRequest
Read, StepInRequest -> StepInRequest -> Bool
(StepInRequest -> StepInRequest -> Bool)
-> (StepInRequest -> StepInRequest -> Bool) -> Eq StepInRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StepInRequest -> StepInRequest -> Bool
$c/= :: StepInRequest -> StepInRequest -> Bool
== :: StepInRequest -> StepInRequest -> Bool
$c== :: StepInRequest -> StepInRequest -> Bool
Eq)


-- |
--   Arguments for 'stepIn' request.
--
data StepInRequestArguments =
  StepInRequestArguments {
    StepInRequestArguments -> Int
threadIdStepInRequestArguments :: Int -- ^Execute 'stepIn' for this thread.
  } deriving (Int -> StepInRequestArguments -> ShowS
[StepInRequestArguments] -> ShowS
StepInRequestArguments -> String
(Int -> StepInRequestArguments -> ShowS)
-> (StepInRequestArguments -> String)
-> ([StepInRequestArguments] -> ShowS)
-> Show StepInRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StepInRequestArguments] -> ShowS
$cshowList :: [StepInRequestArguments] -> ShowS
show :: StepInRequestArguments -> String
$cshow :: StepInRequestArguments -> String
showsPrec :: Int -> StepInRequestArguments -> ShowS
$cshowsPrec :: Int -> StepInRequestArguments -> ShowS
Show, ReadPrec [StepInRequestArguments]
ReadPrec StepInRequestArguments
Int -> ReadS StepInRequestArguments
ReadS [StepInRequestArguments]
(Int -> ReadS StepInRequestArguments)
-> ReadS [StepInRequestArguments]
-> ReadPrec StepInRequestArguments
-> ReadPrec [StepInRequestArguments]
-> Read StepInRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StepInRequestArguments]
$creadListPrec :: ReadPrec [StepInRequestArguments]
readPrec :: ReadPrec StepInRequestArguments
$creadPrec :: ReadPrec StepInRequestArguments
readList :: ReadS [StepInRequestArguments]
$creadList :: ReadS [StepInRequestArguments]
readsPrec :: Int -> ReadS StepInRequestArguments
$creadsPrec :: Int -> ReadS StepInRequestArguments
Read, StepInRequestArguments -> StepInRequestArguments -> Bool
(StepInRequestArguments -> StepInRequestArguments -> Bool)
-> (StepInRequestArguments -> StepInRequestArguments -> Bool)
-> Eq StepInRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StepInRequestArguments -> StepInRequestArguments -> Bool
$c/= :: StepInRequestArguments -> StepInRequestArguments -> Bool
== :: StepInRequestArguments -> StepInRequestArguments -> Bool
$c== :: StepInRequestArguments -> StepInRequestArguments -> Bool
Eq)


-- |
--  Response to "stepIn" request. This is just an acknowledgement, so no body field is required.
--
data StepInResponse =
  StepInResponse {
    StepInResponse -> Int
seqStepInResponse         :: Int     -- ^Sequence number
  , StepInResponse -> String
typeStepInResponse        :: String  -- ^One of "request", "response", or "event"
  , StepInResponse -> Int
request_seqStepInResponse :: Int     -- ^Sequence number of the corresponding request
  , StepInResponse -> Bool
successStepInResponse     :: Bool    -- ^Outcome of the request
  , StepInResponse -> String
commandStepInResponse     :: String  -- ^The command requested
  , StepInResponse -> String
messageStepInResponse     :: String  -- ^Contains error message if success == false.
  } deriving (Int -> StepInResponse -> ShowS
[StepInResponse] -> ShowS
StepInResponse -> String
(Int -> StepInResponse -> ShowS)
-> (StepInResponse -> String)
-> ([StepInResponse] -> ShowS)
-> Show StepInResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StepInResponse] -> ShowS
$cshowList :: [StepInResponse] -> ShowS
show :: StepInResponse -> String
$cshow :: StepInResponse -> String
showsPrec :: Int -> StepInResponse -> ShowS
$cshowsPrec :: Int -> StepInResponse -> ShowS
Show, ReadPrec [StepInResponse]
ReadPrec StepInResponse
Int -> ReadS StepInResponse
ReadS [StepInResponse]
(Int -> ReadS StepInResponse)
-> ReadS [StepInResponse]
-> ReadPrec StepInResponse
-> ReadPrec [StepInResponse]
-> Read StepInResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StepInResponse]
$creadListPrec :: ReadPrec [StepInResponse]
readPrec :: ReadPrec StepInResponse
$creadPrec :: ReadPrec StepInResponse
readList :: ReadS [StepInResponse]
$creadList :: ReadS [StepInResponse]
readsPrec :: Int -> ReadS StepInResponse
$creadsPrec :: Int -> ReadS StepInResponse
Read, StepInResponse -> StepInResponse -> Bool
(StepInResponse -> StepInResponse -> Bool)
-> (StepInResponse -> StepInResponse -> Bool) -> Eq StepInResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StepInResponse -> StepInResponse -> Bool
$c/= :: StepInResponse -> StepInResponse -> Bool
== :: StepInResponse -> StepInResponse -> Bool
$c== :: StepInResponse -> StepInResponse -> Bool
Eq)


-- |
--
defaultStepInResponse :: StepInResponse
defaultStepInResponse :: StepInResponse
defaultStepInResponse = StepInResponse :: Int -> String -> Int -> Bool -> String -> String -> StepInResponse
StepInResponse {
    seqStepInResponse :: Int
seqStepInResponse         = Int
0
  , typeStepInResponse :: String
typeStepInResponse        = String
"response"
  , request_seqStepInResponse :: Int
request_seqStepInResponse = Int
0
  , successStepInResponse :: Bool
successStepInResponse     = Bool
False
  , commandStepInResponse :: String
commandStepInResponse     = String
"stepIn"
  , messageStepInResponse :: String
messageStepInResponse     = String
""
  }


----------------------------------------------------------------------------
--  Evaluate
----------------------------------------------------------------------------

-- |
--   Evaluate request; value of command field is "evaluate".
--
--   Evaluates the given expression in the context of the top most stack frame.
--
--   The expression has access to any variables and arguments that are in scope.
--
data EvaluateRequest =
  EvaluateRequest {
    EvaluateRequest -> Int
seqEvaluateRequest       :: Int                -- ^Sequence number
  , EvaluateRequest -> String
typeEvaluateRequest      :: String             -- ^One of "request", "response", or "event"
  , EvaluateRequest -> String
commandEvaluateRequest   :: String             -- ^The command to execute
  , EvaluateRequest -> EvaluateRequestArguments
argumentsEvaluateRequest :: EvaluateRequestArguments  -- ^Arguments for "evaluate" request.
  } deriving (Int -> EvaluateRequest -> ShowS
[EvaluateRequest] -> ShowS
EvaluateRequest -> String
(Int -> EvaluateRequest -> ShowS)
-> (EvaluateRequest -> String)
-> ([EvaluateRequest] -> ShowS)
-> Show EvaluateRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluateRequest] -> ShowS
$cshowList :: [EvaluateRequest] -> ShowS
show :: EvaluateRequest -> String
$cshow :: EvaluateRequest -> String
showsPrec :: Int -> EvaluateRequest -> ShowS
$cshowsPrec :: Int -> EvaluateRequest -> ShowS
Show, ReadPrec [EvaluateRequest]
ReadPrec EvaluateRequest
Int -> ReadS EvaluateRequest
ReadS [EvaluateRequest]
(Int -> ReadS EvaluateRequest)
-> ReadS [EvaluateRequest]
-> ReadPrec EvaluateRequest
-> ReadPrec [EvaluateRequest]
-> Read EvaluateRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EvaluateRequest]
$creadListPrec :: ReadPrec [EvaluateRequest]
readPrec :: ReadPrec EvaluateRequest
$creadPrec :: ReadPrec EvaluateRequest
readList :: ReadS [EvaluateRequest]
$creadList :: ReadS [EvaluateRequest]
readsPrec :: Int -> ReadS EvaluateRequest
$creadsPrec :: Int -> ReadS EvaluateRequest
Read, EvaluateRequest -> EvaluateRequest -> Bool
(EvaluateRequest -> EvaluateRequest -> Bool)
-> (EvaluateRequest -> EvaluateRequest -> Bool)
-> Eq EvaluateRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvaluateRequest -> EvaluateRequest -> Bool
$c/= :: EvaluateRequest -> EvaluateRequest -> Bool
== :: EvaluateRequest -> EvaluateRequest -> Bool
$c== :: EvaluateRequest -> EvaluateRequest -> Bool
Eq)


-- |
--
defaultEvaluateResponse :: EvaluateResponse
defaultEvaluateResponse :: EvaluateResponse
defaultEvaluateResponse = EvaluateResponse :: Int
-> String
-> Int
-> Bool
-> String
-> String
-> EvaluateResponseBody
-> EvaluateResponse
EvaluateResponse {
    seqEvaluateResponse :: Int
seqEvaluateResponse         = Int
0
  , typeEvaluateResponse :: String
typeEvaluateResponse        = String
"response"
  , request_seqEvaluateResponse :: Int
request_seqEvaluateResponse = Int
0
  , successEvaluateResponse :: Bool
successEvaluateResponse     = Bool
False
  , commandEvaluateResponse :: String
commandEvaluateResponse     = String
"evaluate"
  , messageEvaluateResponse :: String
messageEvaluateResponse     = String
""
  , bodyEvaluateResponse :: EvaluateResponseBody
bodyEvaluateResponse        = EvaluateResponseBody
defaultEvaluateResponseBody
  }


-- |
--   rguments for 'evaluate' request.
--
data EvaluateRequestArguments =
  EvaluateRequestArguments {
    EvaluateRequestArguments -> String
expressionEvaluateRequestArguments :: String     -- ^The expression to evaluate.
  , EvaluateRequestArguments -> Maybe Int
frameIdEvaluateRequestArguments    :: Maybe Int  -- ^Evaluate the expression in the scope of this stack frame. If not specified, the expression is evaluated in the global scope.

  {-|
    The context in which the evaluate request is run.
    Values:
    'watch': evaluate is run in a watch.

    'repl': evaluate is run from REPL console.

    'hover': evaluate is run from a data hover.

    etc.
  -}
  , EvaluateRequestArguments -> Maybe String
contextEvaluateRequestArguments    :: Maybe String
    } deriving (Int -> EvaluateRequestArguments -> ShowS
[EvaluateRequestArguments] -> ShowS
EvaluateRequestArguments -> String
(Int -> EvaluateRequestArguments -> ShowS)
-> (EvaluateRequestArguments -> String)
-> ([EvaluateRequestArguments] -> ShowS)
-> Show EvaluateRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluateRequestArguments] -> ShowS
$cshowList :: [EvaluateRequestArguments] -> ShowS
show :: EvaluateRequestArguments -> String
$cshow :: EvaluateRequestArguments -> String
showsPrec :: Int -> EvaluateRequestArguments -> ShowS
$cshowsPrec :: Int -> EvaluateRequestArguments -> ShowS
Show, ReadPrec [EvaluateRequestArguments]
ReadPrec EvaluateRequestArguments
Int -> ReadS EvaluateRequestArguments
ReadS [EvaluateRequestArguments]
(Int -> ReadS EvaluateRequestArguments)
-> ReadS [EvaluateRequestArguments]
-> ReadPrec EvaluateRequestArguments
-> ReadPrec [EvaluateRequestArguments]
-> Read EvaluateRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EvaluateRequestArguments]
$creadListPrec :: ReadPrec [EvaluateRequestArguments]
readPrec :: ReadPrec EvaluateRequestArguments
$creadPrec :: ReadPrec EvaluateRequestArguments
readList :: ReadS [EvaluateRequestArguments]
$creadList :: ReadS [EvaluateRequestArguments]
readsPrec :: Int -> ReadS EvaluateRequestArguments
$creadsPrec :: Int -> ReadS EvaluateRequestArguments
Read, EvaluateRequestArguments -> EvaluateRequestArguments -> Bool
(EvaluateRequestArguments -> EvaluateRequestArguments -> Bool)
-> (EvaluateRequestArguments -> EvaluateRequestArguments -> Bool)
-> Eq EvaluateRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvaluateRequestArguments -> EvaluateRequestArguments -> Bool
$c/= :: EvaluateRequestArguments -> EvaluateRequestArguments -> Bool
== :: EvaluateRequestArguments -> EvaluateRequestArguments -> Bool
$c== :: EvaluateRequestArguments -> EvaluateRequestArguments -> Bool
Eq)


-- |
--  Response to "evaluate" request.
--
data EvaluateResponse =
  EvaluateResponse {
    EvaluateResponse -> Int
seqEvaluateResponse         :: Int     -- ^Sequence number
  , EvaluateResponse -> String
typeEvaluateResponse        :: String  -- ^One of "request", "response", or "event"
  , EvaluateResponse -> Int
request_seqEvaluateResponse :: Int     -- ^Sequence number of the corresponding request
  , EvaluateResponse -> Bool
successEvaluateResponse     :: Bool    -- ^Outcome of the request
  , EvaluateResponse -> String
commandEvaluateResponse     :: String  -- ^The command requested
  , EvaluateResponse -> String
messageEvaluateResponse     :: String  -- ^Contains error message if success == false.
  , EvaluateResponse -> EvaluateResponseBody
bodyEvaluateResponse        :: EvaluateResponseBody  -- The body of EvaluateResponse
  } deriving (Int -> EvaluateResponse -> ShowS
[EvaluateResponse] -> ShowS
EvaluateResponse -> String
(Int -> EvaluateResponse -> ShowS)
-> (EvaluateResponse -> String)
-> ([EvaluateResponse] -> ShowS)
-> Show EvaluateResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluateResponse] -> ShowS
$cshowList :: [EvaluateResponse] -> ShowS
show :: EvaluateResponse -> String
$cshow :: EvaluateResponse -> String
showsPrec :: Int -> EvaluateResponse -> ShowS
$cshowsPrec :: Int -> EvaluateResponse -> ShowS
Show, ReadPrec [EvaluateResponse]
ReadPrec EvaluateResponse
Int -> ReadS EvaluateResponse
ReadS [EvaluateResponse]
(Int -> ReadS EvaluateResponse)
-> ReadS [EvaluateResponse]
-> ReadPrec EvaluateResponse
-> ReadPrec [EvaluateResponse]
-> Read EvaluateResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EvaluateResponse]
$creadListPrec :: ReadPrec [EvaluateResponse]
readPrec :: ReadPrec EvaluateResponse
$creadPrec :: ReadPrec EvaluateResponse
readList :: ReadS [EvaluateResponse]
$creadList :: ReadS [EvaluateResponse]
readsPrec :: Int -> ReadS EvaluateResponse
$creadsPrec :: Int -> ReadS EvaluateResponse
Read, EvaluateResponse -> EvaluateResponse -> Bool
(EvaluateResponse -> EvaluateResponse -> Bool)
-> (EvaluateResponse -> EvaluateResponse -> Bool)
-> Eq EvaluateResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvaluateResponse -> EvaluateResponse -> Bool
$c/= :: EvaluateResponse -> EvaluateResponse -> Bool
== :: EvaluateResponse -> EvaluateResponse -> Bool
$c== :: EvaluateResponse -> EvaluateResponse -> Bool
Eq)


-- |
--    Response to "evaluate" request.
--
data EvaluateResponseBody =
  EvaluateResponseBody {
    EvaluateResponseBody -> String
resultEvaluateResponseBody             :: String -- ^The result of the evaluate.
  , EvaluateResponseBody -> String
typeEvaluateResponseBody               :: String -- ^The optional type of the evaluate result.
  , EvaluateResponseBody -> Maybe VariablePresentationHint
presentationHintEvaluateResponseBody   :: Maybe VariablePresentationHint -- ^Properties of a evaluate result that can be used to determine how to render the result in the UI.
  , EvaluateResponseBody -> Int
variablesReferenceEvaluateResponseBody :: Int       -- ^If variablesReference is > 0, the evaluate result is structured and its children can be retrieved by passing variablesReference to the VariablesRequest.
  , EvaluateResponseBody -> Maybe Int
namedVariablesEvaluateResponseBody     :: Maybe Int -- ^The number of named child variables. The client can use this optional information to present the variables in a paged UI and fetch them in chunks.
  , EvaluateResponseBody -> Maybe Int
indexedVariablesEvaluateResponseBody   :: Maybe Int -- ^The number of indexed child variables. The client can use this optional information to present the variables in a paged UI and fetch them in chunks.
  } deriving (Int -> EvaluateResponseBody -> ShowS
[EvaluateResponseBody] -> ShowS
EvaluateResponseBody -> String
(Int -> EvaluateResponseBody -> ShowS)
-> (EvaluateResponseBody -> String)
-> ([EvaluateResponseBody] -> ShowS)
-> Show EvaluateResponseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluateResponseBody] -> ShowS
$cshowList :: [EvaluateResponseBody] -> ShowS
show :: EvaluateResponseBody -> String
$cshow :: EvaluateResponseBody -> String
showsPrec :: Int -> EvaluateResponseBody -> ShowS
$cshowsPrec :: Int -> EvaluateResponseBody -> ShowS
Show, ReadPrec [EvaluateResponseBody]
ReadPrec EvaluateResponseBody
Int -> ReadS EvaluateResponseBody
ReadS [EvaluateResponseBody]
(Int -> ReadS EvaluateResponseBody)
-> ReadS [EvaluateResponseBody]
-> ReadPrec EvaluateResponseBody
-> ReadPrec [EvaluateResponseBody]
-> Read EvaluateResponseBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EvaluateResponseBody]
$creadListPrec :: ReadPrec [EvaluateResponseBody]
readPrec :: ReadPrec EvaluateResponseBody
$creadPrec :: ReadPrec EvaluateResponseBody
readList :: ReadS [EvaluateResponseBody]
$creadList :: ReadS [EvaluateResponseBody]
readsPrec :: Int -> ReadS EvaluateResponseBody
$creadsPrec :: Int -> ReadS EvaluateResponseBody
Read, EvaluateResponseBody -> EvaluateResponseBody -> Bool
(EvaluateResponseBody -> EvaluateResponseBody -> Bool)
-> (EvaluateResponseBody -> EvaluateResponseBody -> Bool)
-> Eq EvaluateResponseBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvaluateResponseBody -> EvaluateResponseBody -> Bool
$c/= :: EvaluateResponseBody -> EvaluateResponseBody -> Bool
== :: EvaluateResponseBody -> EvaluateResponseBody -> Bool
$c== :: EvaluateResponseBody -> EvaluateResponseBody -> Bool
Eq)

-- |
--
defaultEvaluateResponseBody :: EvaluateResponseBody
defaultEvaluateResponseBody :: EvaluateResponseBody
defaultEvaluateResponseBody = EvaluateResponseBody :: String
-> String
-> Maybe VariablePresentationHint
-> Int
-> Maybe Int
-> Maybe Int
-> EvaluateResponseBody
EvaluateResponseBody {
    resultEvaluateResponseBody :: String
resultEvaluateResponseBody = String
""
  , typeEvaluateResponseBody :: String
typeEvaluateResponseBody   = String
""
  , presentationHintEvaluateResponseBody :: Maybe VariablePresentationHint
presentationHintEvaluateResponseBody   = Maybe VariablePresentationHint
forall a. Maybe a
Nothing
  , variablesReferenceEvaluateResponseBody :: Int
variablesReferenceEvaluateResponseBody = Int
0
  , namedVariablesEvaluateResponseBody :: Maybe Int
namedVariablesEvaluateResponseBody     = Maybe Int
forall a. Maybe a
Nothing
  , indexedVariablesEvaluateResponseBody :: Maybe Int
indexedVariablesEvaluateResponseBody   = Maybe Int
forall a. Maybe a
Nothing
  }


----------------------------------------------------------------------------
--  CompletionsRequest
----------------------------------------------------------------------------

-- |
--   CompletionsRequest request; value of command field is 'completions'.
--
--   Returns a list of possible completions for a given caret position and text.
--
--   The CompletionsRequest may only be called if the 'supportsCompletionsRequest' capability exists and is true.
--
data CompletionsRequest =
  CompletionsRequest {
    CompletionsRequest -> Int
seqCompletionsRequest       :: Int                   -- ^Sequence number
  , CompletionsRequest -> String
typeCompletionsRequest      :: String                -- ^One of "request", "response", or "event"
  , CompletionsRequest -> String
commandCompletionsRequest   :: String                -- ^The command to execute
  , CompletionsRequest -> CompletionsRequestArguments
argumentsCompletionsRequest :: CompletionsRequestArguments  -- ^Arguments for "completions" request.
  } deriving (Int -> CompletionsRequest -> ShowS
[CompletionsRequest] -> ShowS
CompletionsRequest -> String
(Int -> CompletionsRequest -> ShowS)
-> (CompletionsRequest -> String)
-> ([CompletionsRequest] -> ShowS)
-> Show CompletionsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionsRequest] -> ShowS
$cshowList :: [CompletionsRequest] -> ShowS
show :: CompletionsRequest -> String
$cshow :: CompletionsRequest -> String
showsPrec :: Int -> CompletionsRequest -> ShowS
$cshowsPrec :: Int -> CompletionsRequest -> ShowS
Show, ReadPrec [CompletionsRequest]
ReadPrec CompletionsRequest
Int -> ReadS CompletionsRequest
ReadS [CompletionsRequest]
(Int -> ReadS CompletionsRequest)
-> ReadS [CompletionsRequest]
-> ReadPrec CompletionsRequest
-> ReadPrec [CompletionsRequest]
-> Read CompletionsRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompletionsRequest]
$creadListPrec :: ReadPrec [CompletionsRequest]
readPrec :: ReadPrec CompletionsRequest
$creadPrec :: ReadPrec CompletionsRequest
readList :: ReadS [CompletionsRequest]
$creadList :: ReadS [CompletionsRequest]
readsPrec :: Int -> ReadS CompletionsRequest
$creadsPrec :: Int -> ReadS CompletionsRequest
Read, CompletionsRequest -> CompletionsRequest -> Bool
(CompletionsRequest -> CompletionsRequest -> Bool)
-> (CompletionsRequest -> CompletionsRequest -> Bool)
-> Eq CompletionsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionsRequest -> CompletionsRequest -> Bool
$c/= :: CompletionsRequest -> CompletionsRequest -> Bool
== :: CompletionsRequest -> CompletionsRequest -> Bool
$c== :: CompletionsRequest -> CompletionsRequest -> Bool
Eq)


-- |
--   Arguments for 'completions' request.
--
data CompletionsRequestArguments =
  CompletionsRequestArguments {
    CompletionsRequestArguments -> Maybe Int
frameIdCompletionsRequestArguments :: Maybe Int  -- ^Returns completions in the scope of this stack frame. If not specified, the completions are returned for the global scope.
  , CompletionsRequestArguments -> String
textCompletionsRequestArguments :: String        -- ^One or more source lines. Typically this is the text a user has typed into the debug console before he asked for completion.
  , CompletionsRequestArguments -> Int
columnCompletionsRequestArguments :: Int         -- ^The character position for which to determine the completion proposals.
  , CompletionsRequestArguments -> Maybe Int
lineCompletionsRequestArguments :: Maybe Int     -- ^An optional line for which to determine the completion proposals. If missing the first line of the text is assumed.
  } deriving (Int -> CompletionsRequestArguments -> ShowS
[CompletionsRequestArguments] -> ShowS
CompletionsRequestArguments -> String
(Int -> CompletionsRequestArguments -> ShowS)
-> (CompletionsRequestArguments -> String)
-> ([CompletionsRequestArguments] -> ShowS)
-> Show CompletionsRequestArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionsRequestArguments] -> ShowS
$cshowList :: [CompletionsRequestArguments] -> ShowS
show :: CompletionsRequestArguments -> String
$cshow :: CompletionsRequestArguments -> String
showsPrec :: Int -> CompletionsRequestArguments -> ShowS
$cshowsPrec :: Int -> CompletionsRequestArguments -> ShowS
Show, ReadPrec [CompletionsRequestArguments]
ReadPrec CompletionsRequestArguments
Int -> ReadS CompletionsRequestArguments
ReadS [CompletionsRequestArguments]
(Int -> ReadS CompletionsRequestArguments)
-> ReadS [CompletionsRequestArguments]
-> ReadPrec CompletionsRequestArguments
-> ReadPrec [CompletionsRequestArguments]
-> Read CompletionsRequestArguments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompletionsRequestArguments]
$creadListPrec :: ReadPrec [CompletionsRequestArguments]
readPrec :: ReadPrec CompletionsRequestArguments
$creadPrec :: ReadPrec CompletionsRequestArguments
readList :: ReadS [CompletionsRequestArguments]
$creadList :: ReadS [CompletionsRequestArguments]
readsPrec :: Int -> ReadS CompletionsRequestArguments
$creadsPrec :: Int -> ReadS CompletionsRequestArguments
Read, CompletionsRequestArguments -> CompletionsRequestArguments -> Bool
(CompletionsRequestArguments
 -> CompletionsRequestArguments -> Bool)
-> (CompletionsRequestArguments
    -> CompletionsRequestArguments -> Bool)
-> Eq CompletionsRequestArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionsRequestArguments -> CompletionsRequestArguments -> Bool
$c/= :: CompletionsRequestArguments -> CompletionsRequestArguments -> Bool
== :: CompletionsRequestArguments -> CompletionsRequestArguments -> Bool
$c== :: CompletionsRequestArguments -> CompletionsRequestArguments -> Bool
Eq)


-- |
--  Response to 'completions' request.
--
data CompletionsResponse =
  CompletionsResponse {
    CompletionsResponse -> Int
seqCompletionsResponse         :: Int     -- ^Sequence number
  , CompletionsResponse -> String
typeCompletionsResponse        :: String  -- ^One of "request", "response", or "event"
  , CompletionsResponse -> Int
request_seqCompletionsResponse :: Int     -- ^Sequence number of the corresponding request
  , CompletionsResponse -> Bool
successCompletionsResponse     :: Bool    -- ^Outcome of the request
  , CompletionsResponse -> String
commandCompletionsResponse     :: String  -- ^The command requested
  , CompletionsResponse -> String
messageCompletionsResponse     :: String  -- ^Contains error message if success == false.
  , CompletionsResponse -> CompletionsResponseBody
bodyCompletionsResponse        :: CompletionsResponseBody  -- ^The body of CompletionsResponse
  } deriving (Int -> CompletionsResponse -> ShowS
[CompletionsResponse] -> ShowS
CompletionsResponse -> String
(Int -> CompletionsResponse -> ShowS)
-> (CompletionsResponse -> String)
-> ([CompletionsResponse] -> ShowS)
-> Show CompletionsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionsResponse] -> ShowS
$cshowList :: [CompletionsResponse] -> ShowS
show :: CompletionsResponse -> String
$cshow :: CompletionsResponse -> String
showsPrec :: Int -> CompletionsResponse -> ShowS
$cshowsPrec :: Int -> CompletionsResponse -> ShowS
Show, ReadPrec [CompletionsResponse]
ReadPrec CompletionsResponse
Int -> ReadS CompletionsResponse
ReadS [CompletionsResponse]
(Int -> ReadS CompletionsResponse)
-> ReadS [CompletionsResponse]
-> ReadPrec CompletionsResponse
-> ReadPrec [CompletionsResponse]
-> Read CompletionsResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompletionsResponse]
$creadListPrec :: ReadPrec [CompletionsResponse]
readPrec :: ReadPrec CompletionsResponse
$creadPrec :: ReadPrec CompletionsResponse
readList :: ReadS [CompletionsResponse]
$creadList :: ReadS [CompletionsResponse]
readsPrec :: Int -> ReadS CompletionsResponse
$creadsPrec :: Int -> ReadS CompletionsResponse
Read, CompletionsResponse -> CompletionsResponse -> Bool
(CompletionsResponse -> CompletionsResponse -> Bool)
-> (CompletionsResponse -> CompletionsResponse -> Bool)
-> Eq CompletionsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionsResponse -> CompletionsResponse -> Bool
$c/= :: CompletionsResponse -> CompletionsResponse -> Bool
== :: CompletionsResponse -> CompletionsResponse -> Bool
$c== :: CompletionsResponse -> CompletionsResponse -> Bool
Eq)


-- |
--
defaultCompletionsResponse :: CompletionsResponse
defaultCompletionsResponse :: CompletionsResponse
defaultCompletionsResponse = CompletionsResponse :: Int
-> String
-> Int
-> Bool
-> String
-> String
-> CompletionsResponseBody
-> CompletionsResponse
CompletionsResponse {
    seqCompletionsResponse :: Int
seqCompletionsResponse         = Int
0
  , typeCompletionsResponse :: String
typeCompletionsResponse        = String
"response"
  , request_seqCompletionsResponse :: Int
request_seqCompletionsResponse = Int
0
  , successCompletionsResponse :: Bool
successCompletionsResponse     = Bool
False
  , commandCompletionsResponse :: String
commandCompletionsResponse     = String
"completions"
  , messageCompletionsResponse :: String
messageCompletionsResponse     = String
""
  , bodyCompletionsResponse :: CompletionsResponseBody
bodyCompletionsResponse        = CompletionsResponseBody
defaultCompletionsResponseBody
  }

-- |
--    Response to 'completions' request.
--
data CompletionsResponseBody =
  CompletionsResponseBody {
    CompletionsResponseBody -> [CompletionsItem]
targetsCompletionsResponseBody :: [CompletionsItem]  -- ^The possible completions for .
  } deriving (Int -> CompletionsResponseBody -> ShowS
[CompletionsResponseBody] -> ShowS
CompletionsResponseBody -> String
(Int -> CompletionsResponseBody -> ShowS)
-> (CompletionsResponseBody -> String)
-> ([CompletionsResponseBody] -> ShowS)
-> Show CompletionsResponseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionsResponseBody] -> ShowS
$cshowList :: [CompletionsResponseBody] -> ShowS
show :: CompletionsResponseBody -> String
$cshow :: CompletionsResponseBody -> String
showsPrec :: Int -> CompletionsResponseBody -> ShowS
$cshowsPrec :: Int -> CompletionsResponseBody -> ShowS
Show, ReadPrec [CompletionsResponseBody]
ReadPrec CompletionsResponseBody
Int -> ReadS CompletionsResponseBody
ReadS [CompletionsResponseBody]
(Int -> ReadS CompletionsResponseBody)
-> ReadS [CompletionsResponseBody]
-> ReadPrec CompletionsResponseBody
-> ReadPrec [CompletionsResponseBody]
-> Read CompletionsResponseBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompletionsResponseBody]
$creadListPrec :: ReadPrec [CompletionsResponseBody]
readPrec :: ReadPrec CompletionsResponseBody
$creadPrec :: ReadPrec CompletionsResponseBody
readList :: ReadS [CompletionsResponseBody]
$creadList :: ReadS [CompletionsResponseBody]
readsPrec :: Int -> ReadS CompletionsResponseBody
$creadsPrec :: Int -> ReadS CompletionsResponseBody
Read, CompletionsResponseBody -> CompletionsResponseBody -> Bool
(CompletionsResponseBody -> CompletionsResponseBody -> Bool)
-> (CompletionsResponseBody -> CompletionsResponseBody -> Bool)
-> Eq CompletionsResponseBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionsResponseBody -> CompletionsResponseBody -> Bool
$c/= :: CompletionsResponseBody -> CompletionsResponseBody -> Bool
== :: CompletionsResponseBody -> CompletionsResponseBody -> Bool
$c== :: CompletionsResponseBody -> CompletionsResponseBody -> Bool
Eq)


-- |
--
defaultCompletionsResponseBody :: CompletionsResponseBody
defaultCompletionsResponseBody :: CompletionsResponseBody
defaultCompletionsResponseBody = [CompletionsItem] -> CompletionsResponseBody
CompletionsResponseBody []

-- |
--   CompletionItems are the suggestions returned from the CompletionsRequest.
--
data CompletionsItem =
  CompletionsItem {
    CompletionsItem -> String
labelCompletionsItem  :: String  -- ^The label of this completion item. By default this is also the text that is inserted when selecting this completion.
  {-
  , textCompletionsItem :: String   -- If text is not falsy then it is inserted instead of the label.
  , typeCompletionsItem :: CompletionItemType  -- The item's type. Typically the client uses this information to render the item in the UI with an icon.
  , startCompletionsItem  :: Int     -- When a completion is selected it replaces 'length' characters starting at 'start' in the text passed to the CompletionsRequest.
  , lengthCompletionsItem :: Int    --If missing the frontend will try to determine these values heuristically.
  -}
  } deriving (Int -> CompletionsItem -> ShowS
[CompletionsItem] -> ShowS
CompletionsItem -> String
(Int -> CompletionsItem -> ShowS)
-> (CompletionsItem -> String)
-> ([CompletionsItem] -> ShowS)
-> Show CompletionsItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionsItem] -> ShowS
$cshowList :: [CompletionsItem] -> ShowS
show :: CompletionsItem -> String
$cshow :: CompletionsItem -> String
showsPrec :: Int -> CompletionsItem -> ShowS
$cshowsPrec :: Int -> CompletionsItem -> ShowS
Show, ReadPrec [CompletionsItem]
ReadPrec CompletionsItem
Int -> ReadS CompletionsItem
ReadS [CompletionsItem]
(Int -> ReadS CompletionsItem)
-> ReadS [CompletionsItem]
-> ReadPrec CompletionsItem
-> ReadPrec [CompletionsItem]
-> Read CompletionsItem
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompletionsItem]
$creadListPrec :: ReadPrec [CompletionsItem]
readPrec :: ReadPrec CompletionsItem
$creadPrec :: ReadPrec CompletionsItem
readList :: ReadS [CompletionsItem]
$creadList :: ReadS [CompletionsItem]
readsPrec :: Int -> ReadS CompletionsItem
$creadsPrec :: Int -> ReadS CompletionsItem
Read, CompletionsItem -> CompletionsItem -> Bool
(CompletionsItem -> CompletionsItem -> Bool)
-> (CompletionsItem -> CompletionsItem -> Bool)
-> Eq CompletionsItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionsItem -> CompletionsItem -> Bool
$c/= :: CompletionsItem -> CompletionsItem -> Bool
== :: CompletionsItem -> CompletionsItem -> Bool
$c== :: CompletionsItem -> CompletionsItem -> Bool
Eq)


----------------------------------------------------------------------------
--  Event
----------------------------------------------------------------------------

-- |
--   Event message for "output" event type. The event indicates that the target has produced output.
--
data OutputEvent =
  OutputEvent {
    OutputEvent -> Int
seqOutputEvent   :: Int     -- ^Sequence number
  , OutputEvent -> String
typeOutputEvent  :: String  -- ^One of "request", "response", or "event"
  , OutputEvent -> String
eventOutputEvent :: String  -- ^Type of event
  , OutputEvent -> OutputEventBody
bodyOutputEvent  :: OutputEventBody -- ^The body of OutputEvent
  } deriving (Int -> OutputEvent -> ShowS
[OutputEvent] -> ShowS
OutputEvent -> String
(Int -> OutputEvent -> ShowS)
-> (OutputEvent -> String)
-> ([OutputEvent] -> ShowS)
-> Show OutputEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputEvent] -> ShowS
$cshowList :: [OutputEvent] -> ShowS
show :: OutputEvent -> String
$cshow :: OutputEvent -> String
showsPrec :: Int -> OutputEvent -> ShowS
$cshowsPrec :: Int -> OutputEvent -> ShowS
Show, ReadPrec [OutputEvent]
ReadPrec OutputEvent
Int -> ReadS OutputEvent
ReadS [OutputEvent]
(Int -> ReadS OutputEvent)
-> ReadS [OutputEvent]
-> ReadPrec OutputEvent
-> ReadPrec [OutputEvent]
-> Read OutputEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OutputEvent]
$creadListPrec :: ReadPrec [OutputEvent]
readPrec :: ReadPrec OutputEvent
$creadPrec :: ReadPrec OutputEvent
readList :: ReadS [OutputEvent]
$creadList :: ReadS [OutputEvent]
readsPrec :: Int -> ReadS OutputEvent
$creadsPrec :: Int -> ReadS OutputEvent
Read, OutputEvent -> OutputEvent -> Bool
(OutputEvent -> OutputEvent -> Bool)
-> (OutputEvent -> OutputEvent -> Bool) -> Eq OutputEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputEvent -> OutputEvent -> Bool
$c/= :: OutputEvent -> OutputEvent -> Bool
== :: OutputEvent -> OutputEvent -> Bool
$c== :: OutputEvent -> OutputEvent -> Bool
Eq)

-- |
--
defaultOutputEvent :: OutputEvent
defaultOutputEvent :: OutputEvent
defaultOutputEvent = Int -> String -> String -> OutputEventBody -> OutputEvent
OutputEvent Int
0 String
"event" String
"output" OutputEventBody
defaultOutputEventBody


-- |
--   Event message for "output" event type. The event indicates that the target has produced output.
--
data OutputEventBody =
  OutputEventBody {
    OutputEventBody -> String
categoryOutputEventBody :: String        -- ^The category of output (such as: 'console', 'stdout', 'stderr', 'telemetry'). If not specified, 'console' is assumed.
  , OutputEventBody -> String
outputOutputEventBody   :: String        -- ^The output to report.
  , OutputEventBody -> Maybe String
dataOutputEventBody     :: Maybe String  -- ^Optional data to report. For the 'telemetry' category the data will be sent to telemetry, for the other categories the data is shown in JSON format.
  } deriving (Int -> OutputEventBody -> ShowS
[OutputEventBody] -> ShowS
OutputEventBody -> String
(Int -> OutputEventBody -> ShowS)
-> (OutputEventBody -> String)
-> ([OutputEventBody] -> ShowS)
-> Show OutputEventBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputEventBody] -> ShowS
$cshowList :: [OutputEventBody] -> ShowS
show :: OutputEventBody -> String
$cshow :: OutputEventBody -> String
showsPrec :: Int -> OutputEventBody -> ShowS
$cshowsPrec :: Int -> OutputEventBody -> ShowS
Show, ReadPrec [OutputEventBody]
ReadPrec OutputEventBody
Int -> ReadS OutputEventBody
ReadS [OutputEventBody]
(Int -> ReadS OutputEventBody)
-> ReadS [OutputEventBody]
-> ReadPrec OutputEventBody
-> ReadPrec [OutputEventBody]
-> Read OutputEventBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OutputEventBody]
$creadListPrec :: ReadPrec [OutputEventBody]
readPrec :: ReadPrec OutputEventBody
$creadPrec :: ReadPrec OutputEventBody
readList :: ReadS [OutputEventBody]
$creadList :: ReadS [OutputEventBody]
readsPrec :: Int -> ReadS OutputEventBody
$creadsPrec :: Int -> ReadS OutputEventBody
Read, OutputEventBody -> OutputEventBody -> Bool
(OutputEventBody -> OutputEventBody -> Bool)
-> (OutputEventBody -> OutputEventBody -> Bool)
-> Eq OutputEventBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputEventBody -> OutputEventBody -> Bool
$c/= :: OutputEventBody -> OutputEventBody -> Bool
== :: OutputEventBody -> OutputEventBody -> Bool
$c== :: OutputEventBody -> OutputEventBody -> Bool
Eq)

-- |
--
defaultOutputEventBody :: OutputEventBody
defaultOutputEventBody :: OutputEventBody
defaultOutputEventBody = String -> String -> Maybe String -> OutputEventBody
OutputEventBody String
"console" String
"" Maybe String
forall a. Maybe a
Nothing


-- |
--   Server-initiated response to client request
--
data InitializedEvent =
  InitializedEvent {
    InitializedEvent -> Int
seqInitializedEvent   :: Int     -- ^Sequence number
  , InitializedEvent -> String
typeInitializedEvent  :: String  -- ^One of "request", "response", or "event"
  , InitializedEvent -> String
eventInitializedEvent :: String  -- ^Type of event
  } deriving (Int -> InitializedEvent -> ShowS
[InitializedEvent] -> ShowS
InitializedEvent -> String
(Int -> InitializedEvent -> ShowS)
-> (InitializedEvent -> String)
-> ([InitializedEvent] -> ShowS)
-> Show InitializedEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitializedEvent] -> ShowS
$cshowList :: [InitializedEvent] -> ShowS
show :: InitializedEvent -> String
$cshow :: InitializedEvent -> String
showsPrec :: Int -> InitializedEvent -> ShowS
$cshowsPrec :: Int -> InitializedEvent -> ShowS
Show, ReadPrec [InitializedEvent]
ReadPrec InitializedEvent
Int -> ReadS InitializedEvent
ReadS [InitializedEvent]
(Int -> ReadS InitializedEvent)
-> ReadS [InitializedEvent]
-> ReadPrec InitializedEvent
-> ReadPrec [InitializedEvent]
-> Read InitializedEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitializedEvent]
$creadListPrec :: ReadPrec [InitializedEvent]
readPrec :: ReadPrec InitializedEvent
$creadPrec :: ReadPrec InitializedEvent
readList :: ReadS [InitializedEvent]
$creadList :: ReadS [InitializedEvent]
readsPrec :: Int -> ReadS InitializedEvent
$creadsPrec :: Int -> ReadS InitializedEvent
Read, InitializedEvent -> InitializedEvent -> Bool
(InitializedEvent -> InitializedEvent -> Bool)
-> (InitializedEvent -> InitializedEvent -> Bool)
-> Eq InitializedEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitializedEvent -> InitializedEvent -> Bool
$c/= :: InitializedEvent -> InitializedEvent -> Bool
== :: InitializedEvent -> InitializedEvent -> Bool
$c== :: InitializedEvent -> InitializedEvent -> Bool
Eq)

-- |
--
defaultInitializedEvent :: InitializedEvent
defaultInitializedEvent :: InitializedEvent
defaultInitializedEvent = Int -> String -> String -> InitializedEvent
InitializedEvent Int
0 String
"event" String
"initialized"


-- |
--   Event message for "terminated" event types.
--
--   The event indicates that debugging of the debuggee has terminated.
--
data TerminatedEvent =
  TerminatedEvent {
    TerminatedEvent -> Int
seqTerminatedEvent   :: Int     -- ^Sequence number
  , TerminatedEvent -> String
typeTerminatedEvent  :: String  -- ^One of "request", "response", or "event"
  , TerminatedEvent -> String
eventTerminatedEvent :: String  -- ^Type of event
  , TerminatedEvent -> TerminatedEventBody
bodyTerminatedEvent  :: TerminatedEventBody  -- ^The body of TerminatedEvent
  } deriving (Int -> TerminatedEvent -> ShowS
[TerminatedEvent] -> ShowS
TerminatedEvent -> String
(Int -> TerminatedEvent -> ShowS)
-> (TerminatedEvent -> String)
-> ([TerminatedEvent] -> ShowS)
-> Show TerminatedEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TerminatedEvent] -> ShowS
$cshowList :: [TerminatedEvent] -> ShowS
show :: TerminatedEvent -> String
$cshow :: TerminatedEvent -> String
showsPrec :: Int -> TerminatedEvent -> ShowS
$cshowsPrec :: Int -> TerminatedEvent -> ShowS
Show, ReadPrec [TerminatedEvent]
ReadPrec TerminatedEvent
Int -> ReadS TerminatedEvent
ReadS [TerminatedEvent]
(Int -> ReadS TerminatedEvent)
-> ReadS [TerminatedEvent]
-> ReadPrec TerminatedEvent
-> ReadPrec [TerminatedEvent]
-> Read TerminatedEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TerminatedEvent]
$creadListPrec :: ReadPrec [TerminatedEvent]
readPrec :: ReadPrec TerminatedEvent
$creadPrec :: ReadPrec TerminatedEvent
readList :: ReadS [TerminatedEvent]
$creadList :: ReadS [TerminatedEvent]
readsPrec :: Int -> ReadS TerminatedEvent
$creadsPrec :: Int -> ReadS TerminatedEvent
Read, TerminatedEvent -> TerminatedEvent -> Bool
(TerminatedEvent -> TerminatedEvent -> Bool)
-> (TerminatedEvent -> TerminatedEvent -> Bool)
-> Eq TerminatedEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TerminatedEvent -> TerminatedEvent -> Bool
$c/= :: TerminatedEvent -> TerminatedEvent -> Bool
== :: TerminatedEvent -> TerminatedEvent -> Bool
$c== :: TerminatedEvent -> TerminatedEvent -> Bool
Eq)


-- |
--
defaultTerminatedEvent :: TerminatedEvent
defaultTerminatedEvent :: TerminatedEvent
defaultTerminatedEvent = TerminatedEvent :: Int -> String -> String -> TerminatedEventBody -> TerminatedEvent
TerminatedEvent {
    seqTerminatedEvent :: Int
seqTerminatedEvent = Int
0
  , typeTerminatedEvent :: String
typeTerminatedEvent = String
"event"
  , eventTerminatedEvent :: String
eventTerminatedEvent = String
"terminated"
  , bodyTerminatedEvent :: TerminatedEventBody
bodyTerminatedEvent = TerminatedEventBody
defaultTerminatedEventBody
  }

-- |
--   Event message for "terminated" event types.
--
-- The event indicates that debugging of the debuggee has terminated.
--
data TerminatedEventBody =
  TerminatedEventBody {
    TerminatedEventBody -> Bool
restartTerminatedEventBody :: Bool  -- ^A debug adapter may set 'restart' to true to request that the front end restarts the session.
  } deriving (Int -> TerminatedEventBody -> ShowS
[TerminatedEventBody] -> ShowS
TerminatedEventBody -> String
(Int -> TerminatedEventBody -> ShowS)
-> (TerminatedEventBody -> String)
-> ([TerminatedEventBody] -> ShowS)
-> Show TerminatedEventBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TerminatedEventBody] -> ShowS
$cshowList :: [TerminatedEventBody] -> ShowS
show :: TerminatedEventBody -> String
$cshow :: TerminatedEventBody -> String
showsPrec :: Int -> TerminatedEventBody -> ShowS
$cshowsPrec :: Int -> TerminatedEventBody -> ShowS
Show, ReadPrec [TerminatedEventBody]
ReadPrec TerminatedEventBody
Int -> ReadS TerminatedEventBody
ReadS [TerminatedEventBody]
(Int -> ReadS TerminatedEventBody)
-> ReadS [TerminatedEventBody]
-> ReadPrec TerminatedEventBody
-> ReadPrec [TerminatedEventBody]
-> Read TerminatedEventBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TerminatedEventBody]
$creadListPrec :: ReadPrec [TerminatedEventBody]
readPrec :: ReadPrec TerminatedEventBody
$creadPrec :: ReadPrec TerminatedEventBody
readList :: ReadS [TerminatedEventBody]
$creadList :: ReadS [TerminatedEventBody]
readsPrec :: Int -> ReadS TerminatedEventBody
$creadsPrec :: Int -> ReadS TerminatedEventBody
Read, TerminatedEventBody -> TerminatedEventBody -> Bool
(TerminatedEventBody -> TerminatedEventBody -> Bool)
-> (TerminatedEventBody -> TerminatedEventBody -> Bool)
-> Eq TerminatedEventBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TerminatedEventBody -> TerminatedEventBody -> Bool
$c/= :: TerminatedEventBody -> TerminatedEventBody -> Bool
== :: TerminatedEventBody -> TerminatedEventBody -> Bool
$c== :: TerminatedEventBody -> TerminatedEventBody -> Bool
Eq)


-- |
--
defaultTerminatedEventBody :: TerminatedEventBody
defaultTerminatedEventBody :: TerminatedEventBody
defaultTerminatedEventBody = TerminatedEventBody :: Bool -> TerminatedEventBody
TerminatedEventBody {
    restartTerminatedEventBody :: Bool
restartTerminatedEventBody = Bool
False
  }


-- |
--   Event message for "exited" event types.
--
data ExitedEvent =
  ExitedEvent {
    ExitedEvent -> Int
seqExitedEvent   :: Int     -- ^Sequence number
  , ExitedEvent -> String
typeExitedEvent  :: String  -- ^One of "request", "response", or "event"
  , ExitedEvent -> String
eventExitedEvent :: String  -- ^Type of event
  , ExitedEvent -> ExitedEventBody
bodyExitedEvent  :: ExitedEventBody  -- ^The body of TerminatedEvent
  } deriving (Int -> ExitedEvent -> ShowS
[ExitedEvent] -> ShowS
ExitedEvent -> String
(Int -> ExitedEvent -> ShowS)
-> (ExitedEvent -> String)
-> ([ExitedEvent] -> ShowS)
-> Show ExitedEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExitedEvent] -> ShowS
$cshowList :: [ExitedEvent] -> ShowS
show :: ExitedEvent -> String
$cshow :: ExitedEvent -> String
showsPrec :: Int -> ExitedEvent -> ShowS
$cshowsPrec :: Int -> ExitedEvent -> ShowS
Show, ReadPrec [ExitedEvent]
ReadPrec ExitedEvent
Int -> ReadS ExitedEvent
ReadS [ExitedEvent]
(Int -> ReadS ExitedEvent)
-> ReadS [ExitedEvent]
-> ReadPrec ExitedEvent
-> ReadPrec [ExitedEvent]
-> Read ExitedEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExitedEvent]
$creadListPrec :: ReadPrec [ExitedEvent]
readPrec :: ReadPrec ExitedEvent
$creadPrec :: ReadPrec ExitedEvent
readList :: ReadS [ExitedEvent]
$creadList :: ReadS [ExitedEvent]
readsPrec :: Int -> ReadS ExitedEvent
$creadsPrec :: Int -> ReadS ExitedEvent
Read, ExitedEvent -> ExitedEvent -> Bool
(ExitedEvent -> ExitedEvent -> Bool)
-> (ExitedEvent -> ExitedEvent -> Bool) -> Eq ExitedEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExitedEvent -> ExitedEvent -> Bool
$c/= :: ExitedEvent -> ExitedEvent -> Bool
== :: ExitedEvent -> ExitedEvent -> Bool
$c== :: ExitedEvent -> ExitedEvent -> Bool
Eq)


-- |
--
defaultExitedEvent :: ExitedEvent
defaultExitedEvent :: ExitedEvent
defaultExitedEvent = ExitedEvent :: Int -> String -> String -> ExitedEventBody -> ExitedEvent
ExitedEvent {
    seqExitedEvent :: Int
seqExitedEvent = Int
0
  , typeExitedEvent :: String
typeExitedEvent = String
"event"
  , eventExitedEvent :: String
eventExitedEvent = String
"exited"
  , bodyExitedEvent :: ExitedEventBody
bodyExitedEvent = ExitedEventBody
defaultExitedEventBody
  }

-- |
--   Event message for "exited" event types.
--
--   The exit code returned from the debuggee.
--
data ExitedEventBody =
  ExitedEventBody {
    ExitedEventBody -> Int
exitCodeExitedEventBody :: Int
  } deriving (Int -> ExitedEventBody -> ShowS
[ExitedEventBody] -> ShowS
ExitedEventBody -> String
(Int -> ExitedEventBody -> ShowS)
-> (ExitedEventBody -> String)
-> ([ExitedEventBody] -> ShowS)
-> Show ExitedEventBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExitedEventBody] -> ShowS
$cshowList :: [ExitedEventBody] -> ShowS
show :: ExitedEventBody -> String
$cshow :: ExitedEventBody -> String
showsPrec :: Int -> ExitedEventBody -> ShowS
$cshowsPrec :: Int -> ExitedEventBody -> ShowS
Show, ReadPrec [ExitedEventBody]
ReadPrec ExitedEventBody
Int -> ReadS ExitedEventBody
ReadS [ExitedEventBody]
(Int -> ReadS ExitedEventBody)
-> ReadS [ExitedEventBody]
-> ReadPrec ExitedEventBody
-> ReadPrec [ExitedEventBody]
-> Read ExitedEventBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExitedEventBody]
$creadListPrec :: ReadPrec [ExitedEventBody]
readPrec :: ReadPrec ExitedEventBody
$creadPrec :: ReadPrec ExitedEventBody
readList :: ReadS [ExitedEventBody]
$creadList :: ReadS [ExitedEventBody]
readsPrec :: Int -> ReadS ExitedEventBody
$creadsPrec :: Int -> ReadS ExitedEventBody
Read, ExitedEventBody -> ExitedEventBody -> Bool
(ExitedEventBody -> ExitedEventBody -> Bool)
-> (ExitedEventBody -> ExitedEventBody -> Bool)
-> Eq ExitedEventBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExitedEventBody -> ExitedEventBody -> Bool
$c/= :: ExitedEventBody -> ExitedEventBody -> Bool
== :: ExitedEventBody -> ExitedEventBody -> Bool
$c== :: ExitedEventBody -> ExitedEventBody -> Bool
Eq)


-- |
--
defaultExitedEventBody :: ExitedEventBody
defaultExitedEventBody :: ExitedEventBody
defaultExitedEventBody = ExitedEventBody :: Int -> ExitedEventBody
ExitedEventBody {
    exitCodeExitedEventBody :: Int
exitCodeExitedEventBody = -Int
1
  }



-- |
--   Event message for 'continued' event type.
--
--		The event indicates that the execution of the debuggee has continued.
--
--		Please note: a debug adapter is not expected to send this event in response to a request that implies that execution continues, e.g. 'launch' or 'continue'.
--
--		It is only necessary to send a 'continued' event if there was no previous request that implied this.
--
data ContinuedEvent =
  ContinuedEvent {
    ContinuedEvent -> Int
seqContinuedEvent   :: Int     -- ^Sequence number
  , ContinuedEvent -> String
typeContinuedEvent  :: String  -- ^One of "request", "response", or "event"
  , ContinuedEvent -> String
eventContinuedEvent :: String  -- ^Type of event
  , ContinuedEvent -> ContinuedEventBody
bodyContinuedEvent  :: ContinuedEventBody -- ^The body of ContinuedEvent
  } deriving (Int -> ContinuedEvent -> ShowS
[ContinuedEvent] -> ShowS
ContinuedEvent -> String
(Int -> ContinuedEvent -> ShowS)
-> (ContinuedEvent -> String)
-> ([ContinuedEvent] -> ShowS)
-> Show ContinuedEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContinuedEvent] -> ShowS
$cshowList :: [ContinuedEvent] -> ShowS
show :: ContinuedEvent -> String
$cshow :: ContinuedEvent -> String
showsPrec :: Int -> ContinuedEvent -> ShowS
$cshowsPrec :: Int -> ContinuedEvent -> ShowS
Show, ReadPrec [ContinuedEvent]
ReadPrec ContinuedEvent
Int -> ReadS ContinuedEvent
ReadS [ContinuedEvent]
(Int -> ReadS ContinuedEvent)
-> ReadS [ContinuedEvent]
-> ReadPrec ContinuedEvent
-> ReadPrec [ContinuedEvent]
-> Read ContinuedEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContinuedEvent]
$creadListPrec :: ReadPrec [ContinuedEvent]
readPrec :: ReadPrec ContinuedEvent
$creadPrec :: ReadPrec ContinuedEvent
readList :: ReadS [ContinuedEvent]
$creadList :: ReadS [ContinuedEvent]
readsPrec :: Int -> ReadS ContinuedEvent
$creadsPrec :: Int -> ReadS ContinuedEvent
Read, ContinuedEvent -> ContinuedEvent -> Bool
(ContinuedEvent -> ContinuedEvent -> Bool)
-> (ContinuedEvent -> ContinuedEvent -> Bool) -> Eq ContinuedEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContinuedEvent -> ContinuedEvent -> Bool
$c/= :: ContinuedEvent -> ContinuedEvent -> Bool
== :: ContinuedEvent -> ContinuedEvent -> Bool
$c== :: ContinuedEvent -> ContinuedEvent -> Bool
Eq)


-- |
--
defaultContinuedEvent :: ContinuedEvent
defaultContinuedEvent :: ContinuedEvent
defaultContinuedEvent = ContinuedEvent :: Int -> String -> String -> ContinuedEventBody -> ContinuedEvent
ContinuedEvent {
    seqContinuedEvent :: Int
seqContinuedEvent = Int
0
  , typeContinuedEvent :: String
typeContinuedEvent = String
"event"
  , eventContinuedEvent :: String
eventContinuedEvent = String
"continued"
  , bodyContinuedEvent :: ContinuedEventBody
bodyContinuedEvent = ContinuedEventBody
defaultContinuedEventBody
  }

-- |
--   Body of ContinuedEvent
--
data ContinuedEventBody =
  ContinuedEventBody {
    ContinuedEventBody -> Int
threadIdContinuedEventBody :: Int              -- ^The thread which was continued.
  , ContinuedEventBody -> Bool
allThreadsContinuedContinuedEventBody :: Bool  -- ^If 'allThreadsContinued' is true, a debug adapter can announce that all threads have continued.
  } deriving (Int -> ContinuedEventBody -> ShowS
[ContinuedEventBody] -> ShowS
ContinuedEventBody -> String
(Int -> ContinuedEventBody -> ShowS)
-> (ContinuedEventBody -> String)
-> ([ContinuedEventBody] -> ShowS)
-> Show ContinuedEventBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContinuedEventBody] -> ShowS
$cshowList :: [ContinuedEventBody] -> ShowS
show :: ContinuedEventBody -> String
$cshow :: ContinuedEventBody -> String
showsPrec :: Int -> ContinuedEventBody -> ShowS
$cshowsPrec :: Int -> ContinuedEventBody -> ShowS
Show, ReadPrec [ContinuedEventBody]
ReadPrec ContinuedEventBody
Int -> ReadS ContinuedEventBody
ReadS [ContinuedEventBody]
(Int -> ReadS ContinuedEventBody)
-> ReadS [ContinuedEventBody]
-> ReadPrec ContinuedEventBody
-> ReadPrec [ContinuedEventBody]
-> Read ContinuedEventBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContinuedEventBody]
$creadListPrec :: ReadPrec [ContinuedEventBody]
readPrec :: ReadPrec ContinuedEventBody
$creadPrec :: ReadPrec ContinuedEventBody
readList :: ReadS [ContinuedEventBody]
$creadList :: ReadS [ContinuedEventBody]
readsPrec :: Int -> ReadS ContinuedEventBody
$creadsPrec :: Int -> ReadS ContinuedEventBody
Read, ContinuedEventBody -> ContinuedEventBody -> Bool
(ContinuedEventBody -> ContinuedEventBody -> Bool)
-> (ContinuedEventBody -> ContinuedEventBody -> Bool)
-> Eq ContinuedEventBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContinuedEventBody -> ContinuedEventBody -> Bool
$c/= :: ContinuedEventBody -> ContinuedEventBody -> Bool
== :: ContinuedEventBody -> ContinuedEventBody -> Bool
$c== :: ContinuedEventBody -> ContinuedEventBody -> Bool
Eq)


-- |
--
defaultContinuedEventBody :: ContinuedEventBody
defaultContinuedEventBody :: ContinuedEventBody
defaultContinuedEventBody = ContinuedEventBody :: Int -> Bool -> ContinuedEventBody
ContinuedEventBody {
    threadIdContinuedEventBody :: Int
threadIdContinuedEventBody = Int
0
  , allThreadsContinuedContinuedEventBody :: Bool
allThreadsContinuedContinuedEventBody = Bool
True
  }



-- |
--   Event message for "stopped" event type.
--
--   The event indicates that the execution of the debuggee has stopped due to some condition.
--
--   This can be caused by a break point previously set, a stepping action has completed, by executing a debugger statement etc.
--
data StoppedEvent =
  StoppedEvent {
    StoppedEvent -> Int
seqStoppedEvent   :: Int     -- ^Sequence number
  , StoppedEvent -> String
typeStoppedEvent  :: String  -- ^One of "request", "response", or "event"
  , StoppedEvent -> String
eventStoppedEvent :: String  -- ^Type of event
  , StoppedEvent -> StoppedEventBody
bodyStoppedEvent  :: StoppedEventBody -- ^The body of StoppedEvent
  } deriving (Int -> StoppedEvent -> ShowS
[StoppedEvent] -> ShowS
StoppedEvent -> String
(Int -> StoppedEvent -> ShowS)
-> (StoppedEvent -> String)
-> ([StoppedEvent] -> ShowS)
-> Show StoppedEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StoppedEvent] -> ShowS
$cshowList :: [StoppedEvent] -> ShowS
show :: StoppedEvent -> String
$cshow :: StoppedEvent -> String
showsPrec :: Int -> StoppedEvent -> ShowS
$cshowsPrec :: Int -> StoppedEvent -> ShowS
Show, ReadPrec [StoppedEvent]
ReadPrec StoppedEvent
Int -> ReadS StoppedEvent
ReadS [StoppedEvent]
(Int -> ReadS StoppedEvent)
-> ReadS [StoppedEvent]
-> ReadPrec StoppedEvent
-> ReadPrec [StoppedEvent]
-> Read StoppedEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StoppedEvent]
$creadListPrec :: ReadPrec [StoppedEvent]
readPrec :: ReadPrec StoppedEvent
$creadPrec :: ReadPrec StoppedEvent
readList :: ReadS [StoppedEvent]
$creadList :: ReadS [StoppedEvent]
readsPrec :: Int -> ReadS StoppedEvent
$creadsPrec :: Int -> ReadS StoppedEvent
Read, StoppedEvent -> StoppedEvent -> Bool
(StoppedEvent -> StoppedEvent -> Bool)
-> (StoppedEvent -> StoppedEvent -> Bool) -> Eq StoppedEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StoppedEvent -> StoppedEvent -> Bool
$c/= :: StoppedEvent -> StoppedEvent -> Bool
== :: StoppedEvent -> StoppedEvent -> Bool
$c== :: StoppedEvent -> StoppedEvent -> Bool
Eq)


-- |
--
defaultStoppedEvent :: StoppedEvent
defaultStoppedEvent :: StoppedEvent
defaultStoppedEvent = StoppedEvent :: Int -> String -> String -> StoppedEventBody -> StoppedEvent
StoppedEvent {
    seqStoppedEvent :: Int
seqStoppedEvent = Int
0
  , typeStoppedEvent :: String
typeStoppedEvent = String
"event"
  , eventStoppedEvent :: String
eventStoppedEvent = String
"stopped"
  , bodyStoppedEvent :: StoppedEventBody
bodyStoppedEvent = StoppedEventBody
defaultStoppedEventBody
  }


-- |
--   Event message for 'stopped' event type.
--
--   The event indicates that the execution of the debuggee has stopped due to some condition.
--
--   This can be caused by a break point previously set, a stepping action has completed, by executing a debugger statement etc.
--
data StoppedEventBody =
  StoppedEventBody {
    StoppedEventBody -> String
reasonStoppedEventBody            :: String  -- ^The reason for the event.For backward compatibility this string is shown in the UI if the 'description' attribute is missing (but it must not be translated).Values: 'step', 'breakpoint', 'exception', 'pause', 'entry', etc.
  , StoppedEventBody -> String
descriptionStoppedEventBody       :: String  -- ^The full reason for the event, e.g. 'Paused on exception'. This string is shown in the UI as is.
  , StoppedEventBody -> Int
threadIdStoppedEventBody          :: Int     -- ^The thread which was stopped.
  , StoppedEventBody -> String
textStoppedEventBody              :: String  -- ^Additional information. E.g. if reason is 'exception', text contains the exception name. This string is shown in the UI.

  {-|
     If allThreadsStopped is true, a debug adapter can announce that all threads have stopped.
     The client should use this information to enable that all threads can be expanded to access their stacktraces.
     If the attribute is missing or false, only the thread with the given threadId can be expanded.
  -}
  , StoppedEventBody -> Bool
allThreadsStoppedStoppedEventBody :: Bool
  } deriving (Int -> StoppedEventBody -> ShowS
[StoppedEventBody] -> ShowS
StoppedEventBody -> String
(Int -> StoppedEventBody -> ShowS)
-> (StoppedEventBody -> String)
-> ([StoppedEventBody] -> ShowS)
-> Show StoppedEventBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StoppedEventBody] -> ShowS
$cshowList :: [StoppedEventBody] -> ShowS
show :: StoppedEventBody -> String
$cshow :: StoppedEventBody -> String
showsPrec :: Int -> StoppedEventBody -> ShowS
$cshowsPrec :: Int -> StoppedEventBody -> ShowS
Show, ReadPrec [StoppedEventBody]
ReadPrec StoppedEventBody
Int -> ReadS StoppedEventBody
ReadS [StoppedEventBody]
(Int -> ReadS StoppedEventBody)
-> ReadS [StoppedEventBody]
-> ReadPrec StoppedEventBody
-> ReadPrec [StoppedEventBody]
-> Read StoppedEventBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StoppedEventBody]
$creadListPrec :: ReadPrec [StoppedEventBody]
readPrec :: ReadPrec StoppedEventBody
$creadPrec :: ReadPrec StoppedEventBody
readList :: ReadS [StoppedEventBody]
$creadList :: ReadS [StoppedEventBody]
readsPrec :: Int -> ReadS StoppedEventBody
$creadsPrec :: Int -> ReadS StoppedEventBody
Read, StoppedEventBody -> StoppedEventBody -> Bool
(StoppedEventBody -> StoppedEventBody -> Bool)
-> (StoppedEventBody -> StoppedEventBody -> Bool)
-> Eq StoppedEventBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StoppedEventBody -> StoppedEventBody -> Bool
$c/= :: StoppedEventBody -> StoppedEventBody -> Bool
== :: StoppedEventBody -> StoppedEventBody -> Bool
$c== :: StoppedEventBody -> StoppedEventBody -> Bool
Eq)

-- |
--
defaultStoppedEventBody :: StoppedEventBody
defaultStoppedEventBody :: StoppedEventBody
defaultStoppedEventBody = StoppedEventBody :: String -> String -> Int -> String -> Bool -> StoppedEventBody
StoppedEventBody {
    reasonStoppedEventBody :: String
reasonStoppedEventBody = String
"breakpoint"
  , descriptionStoppedEventBody :: String
descriptionStoppedEventBody = String
""
  , threadIdStoppedEventBody :: Int
threadIdStoppedEventBody = Int
0
  , textStoppedEventBody :: String
textStoppedEventBody = String
""
  , allThreadsStoppedStoppedEventBody :: Bool
allThreadsStoppedStoppedEventBody = Bool
True
  }