{-# LANGUAGE OverloadedStrings, RecordWildCards, TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}


{- |
= Debugger

Debugger domain exposes JavaScript debugging capabilities. It allows setting and removing
breakpoints, stepping through execution, exploring stack traces, etc.
-}


module CDP.Domains.Debugger (module CDP.Domains.Debugger) where

import           Control.Applicative  ((<$>))
import           Control.Monad
import           Control.Monad.Loops
import           Control.Monad.Trans  (liftIO)
import qualified Data.Map             as M
import           Data.Maybe          
import Data.Functor.Identity
import Data.String
import qualified Data.Text as T
import qualified Data.List as List
import qualified Data.Text.IO         as TI
import qualified Data.Vector          as V
import Data.Aeson.Types (Parser(..))
import           Data.Aeson           (FromJSON (..), ToJSON (..), (.:), (.:?), (.=), (.!=), (.:!))
import qualified Data.Aeson           as A
import qualified Network.HTTP.Simple as Http
import qualified Network.URI          as Uri
import qualified Network.WebSockets as WS
import Control.Concurrent
import qualified Data.ByteString.Lazy as BS
import qualified Data.Map as Map
import Data.Proxy
import System.Random
import GHC.Generics
import Data.Char
import Data.Default

import CDP.Internal.Utils


import CDP.Domains.Runtime as Runtime


-- | Type 'Debugger.BreakpointId'.
--   Breakpoint identifier.
type DebuggerBreakpointId = T.Text

-- | Type 'Debugger.CallFrameId'.
--   Call frame identifier.
type DebuggerCallFrameId = T.Text

-- | Type 'Debugger.Location'.
--   Location in the source code.
data DebuggerLocation = DebuggerLocation
  {
    -- | Script identifier as reported in the `Debugger.scriptParsed`.
    DebuggerLocation -> RuntimeScriptId
debuggerLocationScriptId :: Runtime.RuntimeScriptId,
    -- | Line number in the script (0-based).
    DebuggerLocation -> Int
debuggerLocationLineNumber :: Int,
    -- | Column number in the script (0-based).
    DebuggerLocation -> Maybe Int
debuggerLocationColumnNumber :: Maybe Int
  }
  deriving (DebuggerLocation -> DebuggerLocation -> Bool
(DebuggerLocation -> DebuggerLocation -> Bool)
-> (DebuggerLocation -> DebuggerLocation -> Bool)
-> Eq DebuggerLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerLocation -> DebuggerLocation -> Bool
$c/= :: DebuggerLocation -> DebuggerLocation -> Bool
== :: DebuggerLocation -> DebuggerLocation -> Bool
$c== :: DebuggerLocation -> DebuggerLocation -> Bool
Eq, Int -> DebuggerLocation -> ShowS
[DebuggerLocation] -> ShowS
DebuggerLocation -> String
(Int -> DebuggerLocation -> ShowS)
-> (DebuggerLocation -> String)
-> ([DebuggerLocation] -> ShowS)
-> Show DebuggerLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerLocation] -> ShowS
$cshowList :: [DebuggerLocation] -> ShowS
show :: DebuggerLocation -> String
$cshow :: DebuggerLocation -> String
showsPrec :: Int -> DebuggerLocation -> ShowS
$cshowsPrec :: Int -> DebuggerLocation -> ShowS
Show)
instance FromJSON DebuggerLocation where
  parseJSON :: Value -> Parser DebuggerLocation
parseJSON = String
-> (Object -> Parser DebuggerLocation)
-> Value
-> Parser DebuggerLocation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerLocation" ((Object -> Parser DebuggerLocation)
 -> Value -> Parser DebuggerLocation)
-> (Object -> Parser DebuggerLocation)
-> Value
-> Parser DebuggerLocation
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeScriptId -> Int -> Maybe Int -> DebuggerLocation
DebuggerLocation
    (RuntimeScriptId -> Int -> Maybe Int -> DebuggerLocation)
-> Parser RuntimeScriptId
-> Parser (Int -> Maybe Int -> DebuggerLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"scriptId"
    Parser (Int -> Maybe Int -> DebuggerLocation)
-> Parser Int -> Parser (Maybe Int -> DebuggerLocation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"lineNumber"
    Parser (Maybe Int -> DebuggerLocation)
-> Parser (Maybe Int) -> Parser DebuggerLocation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe Int)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"columnNumber"
instance ToJSON DebuggerLocation where
  toJSON :: DebuggerLocation -> Value
toJSON DebuggerLocation
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"scriptId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (DebuggerLocation -> RuntimeScriptId
debuggerLocationScriptId DebuggerLocation
p),
    (RuntimeScriptId
"lineNumber" RuntimeScriptId -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DebuggerLocation -> Int
debuggerLocationLineNumber DebuggerLocation
p),
    (RuntimeScriptId
"columnNumber" RuntimeScriptId -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DebuggerLocation -> Maybe Int
debuggerLocationColumnNumber DebuggerLocation
p)
    ]

-- | Type 'Debugger.ScriptPosition'.
--   Location in the source code.
data DebuggerScriptPosition = DebuggerScriptPosition
  {
    DebuggerScriptPosition -> Int
debuggerScriptPositionLineNumber :: Int,
    DebuggerScriptPosition -> Int
debuggerScriptPositionColumnNumber :: Int
  }
  deriving (DebuggerScriptPosition -> DebuggerScriptPosition -> Bool
(DebuggerScriptPosition -> DebuggerScriptPosition -> Bool)
-> (DebuggerScriptPosition -> DebuggerScriptPosition -> Bool)
-> Eq DebuggerScriptPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerScriptPosition -> DebuggerScriptPosition -> Bool
$c/= :: DebuggerScriptPosition -> DebuggerScriptPosition -> Bool
== :: DebuggerScriptPosition -> DebuggerScriptPosition -> Bool
$c== :: DebuggerScriptPosition -> DebuggerScriptPosition -> Bool
Eq, Int -> DebuggerScriptPosition -> ShowS
[DebuggerScriptPosition] -> ShowS
DebuggerScriptPosition -> String
(Int -> DebuggerScriptPosition -> ShowS)
-> (DebuggerScriptPosition -> String)
-> ([DebuggerScriptPosition] -> ShowS)
-> Show DebuggerScriptPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerScriptPosition] -> ShowS
$cshowList :: [DebuggerScriptPosition] -> ShowS
show :: DebuggerScriptPosition -> String
$cshow :: DebuggerScriptPosition -> String
showsPrec :: Int -> DebuggerScriptPosition -> ShowS
$cshowsPrec :: Int -> DebuggerScriptPosition -> ShowS
Show)
instance FromJSON DebuggerScriptPosition where
  parseJSON :: Value -> Parser DebuggerScriptPosition
parseJSON = String
-> (Object -> Parser DebuggerScriptPosition)
-> Value
-> Parser DebuggerScriptPosition
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerScriptPosition" ((Object -> Parser DebuggerScriptPosition)
 -> Value -> Parser DebuggerScriptPosition)
-> (Object -> Parser DebuggerScriptPosition)
-> Value
-> Parser DebuggerScriptPosition
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Int -> DebuggerScriptPosition
DebuggerScriptPosition
    (Int -> Int -> DebuggerScriptPosition)
-> Parser Int -> Parser (Int -> DebuggerScriptPosition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"lineNumber"
    Parser (Int -> DebuggerScriptPosition)
-> Parser Int -> Parser DebuggerScriptPosition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"columnNumber"
instance ToJSON DebuggerScriptPosition where
  toJSON :: DebuggerScriptPosition -> Value
toJSON DebuggerScriptPosition
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"lineNumber" RuntimeScriptId -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DebuggerScriptPosition -> Int
debuggerScriptPositionLineNumber DebuggerScriptPosition
p),
    (RuntimeScriptId
"columnNumber" RuntimeScriptId -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DebuggerScriptPosition -> Int
debuggerScriptPositionColumnNumber DebuggerScriptPosition
p)
    ]

-- | Type 'Debugger.LocationRange'.
--   Location range within one script.
data DebuggerLocationRange = DebuggerLocationRange
  {
    DebuggerLocationRange -> RuntimeScriptId
debuggerLocationRangeScriptId :: Runtime.RuntimeScriptId,
    DebuggerLocationRange -> DebuggerScriptPosition
debuggerLocationRangeStart :: DebuggerScriptPosition,
    DebuggerLocationRange -> DebuggerScriptPosition
debuggerLocationRangeEnd :: DebuggerScriptPosition
  }
  deriving (DebuggerLocationRange -> DebuggerLocationRange -> Bool
(DebuggerLocationRange -> DebuggerLocationRange -> Bool)
-> (DebuggerLocationRange -> DebuggerLocationRange -> Bool)
-> Eq DebuggerLocationRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerLocationRange -> DebuggerLocationRange -> Bool
$c/= :: DebuggerLocationRange -> DebuggerLocationRange -> Bool
== :: DebuggerLocationRange -> DebuggerLocationRange -> Bool
$c== :: DebuggerLocationRange -> DebuggerLocationRange -> Bool
Eq, Int -> DebuggerLocationRange -> ShowS
[DebuggerLocationRange] -> ShowS
DebuggerLocationRange -> String
(Int -> DebuggerLocationRange -> ShowS)
-> (DebuggerLocationRange -> String)
-> ([DebuggerLocationRange] -> ShowS)
-> Show DebuggerLocationRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerLocationRange] -> ShowS
$cshowList :: [DebuggerLocationRange] -> ShowS
show :: DebuggerLocationRange -> String
$cshow :: DebuggerLocationRange -> String
showsPrec :: Int -> DebuggerLocationRange -> ShowS
$cshowsPrec :: Int -> DebuggerLocationRange -> ShowS
Show)
instance FromJSON DebuggerLocationRange where
  parseJSON :: Value -> Parser DebuggerLocationRange
parseJSON = String
-> (Object -> Parser DebuggerLocationRange)
-> Value
-> Parser DebuggerLocationRange
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerLocationRange" ((Object -> Parser DebuggerLocationRange)
 -> Value -> Parser DebuggerLocationRange)
-> (Object -> Parser DebuggerLocationRange)
-> Value
-> Parser DebuggerLocationRange
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeScriptId
-> DebuggerScriptPosition
-> DebuggerScriptPosition
-> DebuggerLocationRange
DebuggerLocationRange
    (RuntimeScriptId
 -> DebuggerScriptPosition
 -> DebuggerScriptPosition
 -> DebuggerLocationRange)
-> Parser RuntimeScriptId
-> Parser
     (DebuggerScriptPosition
      -> DebuggerScriptPosition -> DebuggerLocationRange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"scriptId"
    Parser
  (DebuggerScriptPosition
   -> DebuggerScriptPosition -> DebuggerLocationRange)
-> Parser DebuggerScriptPosition
-> Parser (DebuggerScriptPosition -> DebuggerLocationRange)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser DebuggerScriptPosition
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"start"
    Parser (DebuggerScriptPosition -> DebuggerLocationRange)
-> Parser DebuggerScriptPosition -> Parser DebuggerLocationRange
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser DebuggerScriptPosition
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"end"
instance ToJSON DebuggerLocationRange where
  toJSON :: DebuggerLocationRange -> Value
toJSON DebuggerLocationRange
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"scriptId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (DebuggerLocationRange -> RuntimeScriptId
debuggerLocationRangeScriptId DebuggerLocationRange
p),
    (RuntimeScriptId
"start" RuntimeScriptId -> DebuggerScriptPosition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (DebuggerScriptPosition -> Pair)
-> Maybe DebuggerScriptPosition -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DebuggerScriptPosition -> Maybe DebuggerScriptPosition
forall a. a -> Maybe a
Just (DebuggerLocationRange -> DebuggerScriptPosition
debuggerLocationRangeStart DebuggerLocationRange
p),
    (RuntimeScriptId
"end" RuntimeScriptId -> DebuggerScriptPosition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (DebuggerScriptPosition -> Pair)
-> Maybe DebuggerScriptPosition -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DebuggerScriptPosition -> Maybe DebuggerScriptPosition
forall a. a -> Maybe a
Just (DebuggerLocationRange -> DebuggerScriptPosition
debuggerLocationRangeEnd DebuggerLocationRange
p)
    ]

-- | Type 'Debugger.CallFrame'.
--   JavaScript call frame. Array of call frames form the call stack.
data DebuggerCallFrame = DebuggerCallFrame
  {
    -- | Call frame identifier. This identifier is only valid while the virtual machine is paused.
    DebuggerCallFrame -> RuntimeScriptId
debuggerCallFrameCallFrameId :: DebuggerCallFrameId,
    -- | Name of the JavaScript function called on this call frame.
    DebuggerCallFrame -> RuntimeScriptId
debuggerCallFrameFunctionName :: T.Text,
    -- | Location in the source code.
    DebuggerCallFrame -> Maybe DebuggerLocation
debuggerCallFrameFunctionLocation :: Maybe DebuggerLocation,
    -- | Location in the source code.
    DebuggerCallFrame -> DebuggerLocation
debuggerCallFrameLocation :: DebuggerLocation,
    -- | Scope chain for this call frame.
    DebuggerCallFrame -> [DebuggerScope]
debuggerCallFrameScopeChain :: [DebuggerScope],
    -- | `this` object for this call frame.
    DebuggerCallFrame -> RuntimeRemoteObject
debuggerCallFrameThis :: Runtime.RuntimeRemoteObject,
    -- | The value being returned, if the function is at return point.
    DebuggerCallFrame -> Maybe RuntimeRemoteObject
debuggerCallFrameReturnValue :: Maybe Runtime.RuntimeRemoteObject,
    -- | Valid only while the VM is paused and indicates whether this frame
    --   can be restarted or not. Note that a `true` value here does not
    --   guarantee that Debugger#restartFrame with this CallFrameId will be
    --   successful, but it is very likely.
    DebuggerCallFrame -> Maybe Bool
debuggerCallFrameCanBeRestarted :: Maybe Bool
  }
  deriving (DebuggerCallFrame -> DebuggerCallFrame -> Bool
(DebuggerCallFrame -> DebuggerCallFrame -> Bool)
-> (DebuggerCallFrame -> DebuggerCallFrame -> Bool)
-> Eq DebuggerCallFrame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerCallFrame -> DebuggerCallFrame -> Bool
$c/= :: DebuggerCallFrame -> DebuggerCallFrame -> Bool
== :: DebuggerCallFrame -> DebuggerCallFrame -> Bool
$c== :: DebuggerCallFrame -> DebuggerCallFrame -> Bool
Eq, Int -> DebuggerCallFrame -> ShowS
[DebuggerCallFrame] -> ShowS
DebuggerCallFrame -> String
(Int -> DebuggerCallFrame -> ShowS)
-> (DebuggerCallFrame -> String)
-> ([DebuggerCallFrame] -> ShowS)
-> Show DebuggerCallFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerCallFrame] -> ShowS
$cshowList :: [DebuggerCallFrame] -> ShowS
show :: DebuggerCallFrame -> String
$cshow :: DebuggerCallFrame -> String
showsPrec :: Int -> DebuggerCallFrame -> ShowS
$cshowsPrec :: Int -> DebuggerCallFrame -> ShowS
Show)
instance FromJSON DebuggerCallFrame where
  parseJSON :: Value -> Parser DebuggerCallFrame
parseJSON = String
-> (Object -> Parser DebuggerCallFrame)
-> Value
-> Parser DebuggerCallFrame
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerCallFrame" ((Object -> Parser DebuggerCallFrame)
 -> Value -> Parser DebuggerCallFrame)
-> (Object -> Parser DebuggerCallFrame)
-> Value
-> Parser DebuggerCallFrame
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeScriptId
-> RuntimeScriptId
-> Maybe DebuggerLocation
-> DebuggerLocation
-> [DebuggerScope]
-> RuntimeRemoteObject
-> Maybe RuntimeRemoteObject
-> Maybe Bool
-> DebuggerCallFrame
DebuggerCallFrame
    (RuntimeScriptId
 -> RuntimeScriptId
 -> Maybe DebuggerLocation
 -> DebuggerLocation
 -> [DebuggerScope]
 -> RuntimeRemoteObject
 -> Maybe RuntimeRemoteObject
 -> Maybe Bool
 -> DebuggerCallFrame)
-> Parser RuntimeScriptId
-> Parser
     (RuntimeScriptId
      -> Maybe DebuggerLocation
      -> DebuggerLocation
      -> [DebuggerScope]
      -> RuntimeRemoteObject
      -> Maybe RuntimeRemoteObject
      -> Maybe Bool
      -> DebuggerCallFrame)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"callFrameId"
    Parser
  (RuntimeScriptId
   -> Maybe DebuggerLocation
   -> DebuggerLocation
   -> [DebuggerScope]
   -> RuntimeRemoteObject
   -> Maybe RuntimeRemoteObject
   -> Maybe Bool
   -> DebuggerCallFrame)
-> Parser RuntimeScriptId
-> Parser
     (Maybe DebuggerLocation
      -> DebuggerLocation
      -> [DebuggerScope]
      -> RuntimeRemoteObject
      -> Maybe RuntimeRemoteObject
      -> Maybe Bool
      -> DebuggerCallFrame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"functionName"
    Parser
  (Maybe DebuggerLocation
   -> DebuggerLocation
   -> [DebuggerScope]
   -> RuntimeRemoteObject
   -> Maybe RuntimeRemoteObject
   -> Maybe Bool
   -> DebuggerCallFrame)
-> Parser (Maybe DebuggerLocation)
-> Parser
     (DebuggerLocation
      -> [DebuggerScope]
      -> RuntimeRemoteObject
      -> Maybe RuntimeRemoteObject
      -> Maybe Bool
      -> DebuggerCallFrame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe DebuggerLocation)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"functionLocation"
    Parser
  (DebuggerLocation
   -> [DebuggerScope]
   -> RuntimeRemoteObject
   -> Maybe RuntimeRemoteObject
   -> Maybe Bool
   -> DebuggerCallFrame)
-> Parser DebuggerLocation
-> Parser
     ([DebuggerScope]
      -> RuntimeRemoteObject
      -> Maybe RuntimeRemoteObject
      -> Maybe Bool
      -> DebuggerCallFrame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser DebuggerLocation
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"location"
    Parser
  ([DebuggerScope]
   -> RuntimeRemoteObject
   -> Maybe RuntimeRemoteObject
   -> Maybe Bool
   -> DebuggerCallFrame)
-> Parser [DebuggerScope]
-> Parser
     (RuntimeRemoteObject
      -> Maybe RuntimeRemoteObject -> Maybe Bool -> DebuggerCallFrame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser [DebuggerScope]
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"scopeChain"
    Parser
  (RuntimeRemoteObject
   -> Maybe RuntimeRemoteObject -> Maybe Bool -> DebuggerCallFrame)
-> Parser RuntimeRemoteObject
-> Parser
     (Maybe RuntimeRemoteObject -> Maybe Bool -> DebuggerCallFrame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser RuntimeRemoteObject
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"this"
    Parser
  (Maybe RuntimeRemoteObject -> Maybe Bool -> DebuggerCallFrame)
-> Parser (Maybe RuntimeRemoteObject)
-> Parser (Maybe Bool -> DebuggerCallFrame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeRemoteObject)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"returnValue"
    Parser (Maybe Bool -> DebuggerCallFrame)
-> Parser (Maybe Bool) -> Parser DebuggerCallFrame
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe Bool)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"canBeRestarted"
instance ToJSON DebuggerCallFrame where
  toJSON :: DebuggerCallFrame -> Value
toJSON DebuggerCallFrame
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"callFrameId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (DebuggerCallFrame -> RuntimeScriptId
debuggerCallFrameCallFrameId DebuggerCallFrame
p),
    (RuntimeScriptId
"functionName" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (DebuggerCallFrame -> RuntimeScriptId
debuggerCallFrameFunctionName DebuggerCallFrame
p),
    (RuntimeScriptId
"functionLocation" RuntimeScriptId -> DebuggerLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (DebuggerLocation -> Pair) -> Maybe DebuggerLocation -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DebuggerCallFrame -> Maybe DebuggerLocation
debuggerCallFrameFunctionLocation DebuggerCallFrame
p),
    (RuntimeScriptId
"location" RuntimeScriptId -> DebuggerLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (DebuggerLocation -> Pair) -> Maybe DebuggerLocation -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DebuggerLocation -> Maybe DebuggerLocation
forall a. a -> Maybe a
Just (DebuggerCallFrame -> DebuggerLocation
debuggerCallFrameLocation DebuggerCallFrame
p),
    (RuntimeScriptId
"scopeChain" RuntimeScriptId -> [DebuggerScope] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) ([DebuggerScope] -> Pair) -> Maybe [DebuggerScope] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DebuggerScope] -> Maybe [DebuggerScope]
forall a. a -> Maybe a
Just (DebuggerCallFrame -> [DebuggerScope]
debuggerCallFrameScopeChain DebuggerCallFrame
p),
    (RuntimeScriptId
"this" RuntimeScriptId -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeRemoteObject -> Maybe RuntimeRemoteObject
forall a. a -> Maybe a
Just (DebuggerCallFrame -> RuntimeRemoteObject
debuggerCallFrameThis DebuggerCallFrame
p),
    (RuntimeScriptId
"returnValue" RuntimeScriptId -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DebuggerCallFrame -> Maybe RuntimeRemoteObject
debuggerCallFrameReturnValue DebuggerCallFrame
p),
    (RuntimeScriptId
"canBeRestarted" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DebuggerCallFrame -> Maybe Bool
debuggerCallFrameCanBeRestarted DebuggerCallFrame
p)
    ]

-- | Type 'Debugger.Scope'.
--   Scope description.
data DebuggerScopeType = DebuggerScopeTypeGlobal | DebuggerScopeTypeLocal | DebuggerScopeTypeWith | DebuggerScopeTypeClosure | DebuggerScopeTypeCatch | DebuggerScopeTypeBlock | DebuggerScopeTypeScript | DebuggerScopeTypeEval | DebuggerScopeTypeModule | DebuggerScopeTypeWasmExpressionStack
  deriving (Eq DebuggerScopeType
Eq DebuggerScopeType
-> (DebuggerScopeType -> DebuggerScopeType -> Ordering)
-> (DebuggerScopeType -> DebuggerScopeType -> Bool)
-> (DebuggerScopeType -> DebuggerScopeType -> Bool)
-> (DebuggerScopeType -> DebuggerScopeType -> Bool)
-> (DebuggerScopeType -> DebuggerScopeType -> Bool)
-> (DebuggerScopeType -> DebuggerScopeType -> DebuggerScopeType)
-> (DebuggerScopeType -> DebuggerScopeType -> DebuggerScopeType)
-> Ord DebuggerScopeType
DebuggerScopeType -> DebuggerScopeType -> Bool
DebuggerScopeType -> DebuggerScopeType -> Ordering
DebuggerScopeType -> DebuggerScopeType -> DebuggerScopeType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DebuggerScopeType -> DebuggerScopeType -> DebuggerScopeType
$cmin :: DebuggerScopeType -> DebuggerScopeType -> DebuggerScopeType
max :: DebuggerScopeType -> DebuggerScopeType -> DebuggerScopeType
$cmax :: DebuggerScopeType -> DebuggerScopeType -> DebuggerScopeType
>= :: DebuggerScopeType -> DebuggerScopeType -> Bool
$c>= :: DebuggerScopeType -> DebuggerScopeType -> Bool
> :: DebuggerScopeType -> DebuggerScopeType -> Bool
$c> :: DebuggerScopeType -> DebuggerScopeType -> Bool
<= :: DebuggerScopeType -> DebuggerScopeType -> Bool
$c<= :: DebuggerScopeType -> DebuggerScopeType -> Bool
< :: DebuggerScopeType -> DebuggerScopeType -> Bool
$c< :: DebuggerScopeType -> DebuggerScopeType -> Bool
compare :: DebuggerScopeType -> DebuggerScopeType -> Ordering
$ccompare :: DebuggerScopeType -> DebuggerScopeType -> Ordering
$cp1Ord :: Eq DebuggerScopeType
Ord, DebuggerScopeType -> DebuggerScopeType -> Bool
(DebuggerScopeType -> DebuggerScopeType -> Bool)
-> (DebuggerScopeType -> DebuggerScopeType -> Bool)
-> Eq DebuggerScopeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerScopeType -> DebuggerScopeType -> Bool
$c/= :: DebuggerScopeType -> DebuggerScopeType -> Bool
== :: DebuggerScopeType -> DebuggerScopeType -> Bool
$c== :: DebuggerScopeType -> DebuggerScopeType -> Bool
Eq, Int -> DebuggerScopeType -> ShowS
[DebuggerScopeType] -> ShowS
DebuggerScopeType -> String
(Int -> DebuggerScopeType -> ShowS)
-> (DebuggerScopeType -> String)
-> ([DebuggerScopeType] -> ShowS)
-> Show DebuggerScopeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerScopeType] -> ShowS
$cshowList :: [DebuggerScopeType] -> ShowS
show :: DebuggerScopeType -> String
$cshow :: DebuggerScopeType -> String
showsPrec :: Int -> DebuggerScopeType -> ShowS
$cshowsPrec :: Int -> DebuggerScopeType -> ShowS
Show, ReadPrec [DebuggerScopeType]
ReadPrec DebuggerScopeType
Int -> ReadS DebuggerScopeType
ReadS [DebuggerScopeType]
(Int -> ReadS DebuggerScopeType)
-> ReadS [DebuggerScopeType]
-> ReadPrec DebuggerScopeType
-> ReadPrec [DebuggerScopeType]
-> Read DebuggerScopeType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DebuggerScopeType]
$creadListPrec :: ReadPrec [DebuggerScopeType]
readPrec :: ReadPrec DebuggerScopeType
$creadPrec :: ReadPrec DebuggerScopeType
readList :: ReadS [DebuggerScopeType]
$creadList :: ReadS [DebuggerScopeType]
readsPrec :: Int -> ReadS DebuggerScopeType
$creadsPrec :: Int -> ReadS DebuggerScopeType
Read)
instance FromJSON DebuggerScopeType where
  parseJSON :: Value -> Parser DebuggerScopeType
parseJSON = String
-> (RuntimeScriptId -> Parser DebuggerScopeType)
-> Value
-> Parser DebuggerScopeType
forall a.
String -> (RuntimeScriptId -> Parser a) -> Value -> Parser a
A.withText String
"DebuggerScopeType" ((RuntimeScriptId -> Parser DebuggerScopeType)
 -> Value -> Parser DebuggerScopeType)
-> (RuntimeScriptId -> Parser DebuggerScopeType)
-> Value
-> Parser DebuggerScopeType
forall a b. (a -> b) -> a -> b
$ \RuntimeScriptId
v -> case RuntimeScriptId
v of
    RuntimeScriptId
"global" -> DebuggerScopeType -> Parser DebuggerScopeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerScopeType
DebuggerScopeTypeGlobal
    RuntimeScriptId
"local" -> DebuggerScopeType -> Parser DebuggerScopeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerScopeType
DebuggerScopeTypeLocal
    RuntimeScriptId
"with" -> DebuggerScopeType -> Parser DebuggerScopeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerScopeType
DebuggerScopeTypeWith
    RuntimeScriptId
"closure" -> DebuggerScopeType -> Parser DebuggerScopeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerScopeType
DebuggerScopeTypeClosure
    RuntimeScriptId
"catch" -> DebuggerScopeType -> Parser DebuggerScopeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerScopeType
DebuggerScopeTypeCatch
    RuntimeScriptId
"block" -> DebuggerScopeType -> Parser DebuggerScopeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerScopeType
DebuggerScopeTypeBlock
    RuntimeScriptId
"script" -> DebuggerScopeType -> Parser DebuggerScopeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerScopeType
DebuggerScopeTypeScript
    RuntimeScriptId
"eval" -> DebuggerScopeType -> Parser DebuggerScopeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerScopeType
DebuggerScopeTypeEval
    RuntimeScriptId
"module" -> DebuggerScopeType -> Parser DebuggerScopeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerScopeType
DebuggerScopeTypeModule
    RuntimeScriptId
"wasm-expression-stack" -> DebuggerScopeType -> Parser DebuggerScopeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerScopeType
DebuggerScopeTypeWasmExpressionStack
    RuntimeScriptId
"_" -> String -> Parser DebuggerScopeType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse DebuggerScopeType"
instance ToJSON DebuggerScopeType where
  toJSON :: DebuggerScopeType -> Value
toJSON DebuggerScopeType
v = RuntimeScriptId -> Value
A.String (RuntimeScriptId -> Value) -> RuntimeScriptId -> Value
forall a b. (a -> b) -> a -> b
$ case DebuggerScopeType
v of
    DebuggerScopeType
DebuggerScopeTypeGlobal -> RuntimeScriptId
"global"
    DebuggerScopeType
DebuggerScopeTypeLocal -> RuntimeScriptId
"local"
    DebuggerScopeType
DebuggerScopeTypeWith -> RuntimeScriptId
"with"
    DebuggerScopeType
DebuggerScopeTypeClosure -> RuntimeScriptId
"closure"
    DebuggerScopeType
DebuggerScopeTypeCatch -> RuntimeScriptId
"catch"
    DebuggerScopeType
DebuggerScopeTypeBlock -> RuntimeScriptId
"block"
    DebuggerScopeType
DebuggerScopeTypeScript -> RuntimeScriptId
"script"
    DebuggerScopeType
DebuggerScopeTypeEval -> RuntimeScriptId
"eval"
    DebuggerScopeType
DebuggerScopeTypeModule -> RuntimeScriptId
"module"
    DebuggerScopeType
DebuggerScopeTypeWasmExpressionStack -> RuntimeScriptId
"wasm-expression-stack"
data DebuggerScope = DebuggerScope
  {
    -- | Scope type.
    DebuggerScope -> DebuggerScopeType
debuggerScopeType :: DebuggerScopeType,
    -- | Object representing the scope. For `global` and `with` scopes it represents the actual
    --   object; for the rest of the scopes, it is artificial transient object enumerating scope
    --   variables as its properties.
    DebuggerScope -> RuntimeRemoteObject
debuggerScopeObject :: Runtime.RuntimeRemoteObject,
    DebuggerScope -> Maybe RuntimeScriptId
debuggerScopeName :: Maybe T.Text,
    -- | Location in the source code where scope starts
    DebuggerScope -> Maybe DebuggerLocation
debuggerScopeStartLocation :: Maybe DebuggerLocation,
    -- | Location in the source code where scope ends
    DebuggerScope -> Maybe DebuggerLocation
debuggerScopeEndLocation :: Maybe DebuggerLocation
  }
  deriving (DebuggerScope -> DebuggerScope -> Bool
(DebuggerScope -> DebuggerScope -> Bool)
-> (DebuggerScope -> DebuggerScope -> Bool) -> Eq DebuggerScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerScope -> DebuggerScope -> Bool
$c/= :: DebuggerScope -> DebuggerScope -> Bool
== :: DebuggerScope -> DebuggerScope -> Bool
$c== :: DebuggerScope -> DebuggerScope -> Bool
Eq, Int -> DebuggerScope -> ShowS
[DebuggerScope] -> ShowS
DebuggerScope -> String
(Int -> DebuggerScope -> ShowS)
-> (DebuggerScope -> String)
-> ([DebuggerScope] -> ShowS)
-> Show DebuggerScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerScope] -> ShowS
$cshowList :: [DebuggerScope] -> ShowS
show :: DebuggerScope -> String
$cshow :: DebuggerScope -> String
showsPrec :: Int -> DebuggerScope -> ShowS
$cshowsPrec :: Int -> DebuggerScope -> ShowS
Show)
instance FromJSON DebuggerScope where
  parseJSON :: Value -> Parser DebuggerScope
parseJSON = String
-> (Object -> Parser DebuggerScope)
-> Value
-> Parser DebuggerScope
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerScope" ((Object -> Parser DebuggerScope) -> Value -> Parser DebuggerScope)
-> (Object -> Parser DebuggerScope)
-> Value
-> Parser DebuggerScope
forall a b. (a -> b) -> a -> b
$ \Object
o -> DebuggerScopeType
-> RuntimeRemoteObject
-> Maybe RuntimeScriptId
-> Maybe DebuggerLocation
-> Maybe DebuggerLocation
-> DebuggerScope
DebuggerScope
    (DebuggerScopeType
 -> RuntimeRemoteObject
 -> Maybe RuntimeScriptId
 -> Maybe DebuggerLocation
 -> Maybe DebuggerLocation
 -> DebuggerScope)
-> Parser DebuggerScopeType
-> Parser
     (RuntimeRemoteObject
      -> Maybe RuntimeScriptId
      -> Maybe DebuggerLocation
      -> Maybe DebuggerLocation
      -> DebuggerScope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser DebuggerScopeType
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"type"
    Parser
  (RuntimeRemoteObject
   -> Maybe RuntimeScriptId
   -> Maybe DebuggerLocation
   -> Maybe DebuggerLocation
   -> DebuggerScope)
-> Parser RuntimeRemoteObject
-> Parser
     (Maybe RuntimeScriptId
      -> Maybe DebuggerLocation
      -> Maybe DebuggerLocation
      -> DebuggerScope)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser RuntimeRemoteObject
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"object"
    Parser
  (Maybe RuntimeScriptId
   -> Maybe DebuggerLocation
   -> Maybe DebuggerLocation
   -> DebuggerScope)
-> Parser (Maybe RuntimeScriptId)
-> Parser
     (Maybe DebuggerLocation -> Maybe DebuggerLocation -> DebuggerScope)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeScriptId)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"name"
    Parser
  (Maybe DebuggerLocation -> Maybe DebuggerLocation -> DebuggerScope)
-> Parser (Maybe DebuggerLocation)
-> Parser (Maybe DebuggerLocation -> DebuggerScope)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe DebuggerLocation)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"startLocation"
    Parser (Maybe DebuggerLocation -> DebuggerScope)
-> Parser (Maybe DebuggerLocation) -> Parser DebuggerScope
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe DebuggerLocation)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"endLocation"
instance ToJSON DebuggerScope where
  toJSON :: DebuggerScope -> Value
toJSON DebuggerScope
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"type" RuntimeScriptId -> DebuggerScopeType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (DebuggerScopeType -> Pair)
-> Maybe DebuggerScopeType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DebuggerScopeType -> Maybe DebuggerScopeType
forall a. a -> Maybe a
Just (DebuggerScope -> DebuggerScopeType
debuggerScopeType DebuggerScope
p),
    (RuntimeScriptId
"object" RuntimeScriptId -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeRemoteObject -> Maybe RuntimeRemoteObject
forall a. a -> Maybe a
Just (DebuggerScope -> RuntimeRemoteObject
debuggerScopeObject DebuggerScope
p),
    (RuntimeScriptId
"name" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DebuggerScope -> Maybe RuntimeScriptId
debuggerScopeName DebuggerScope
p),
    (RuntimeScriptId
"startLocation" RuntimeScriptId -> DebuggerLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (DebuggerLocation -> Pair) -> Maybe DebuggerLocation -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DebuggerScope -> Maybe DebuggerLocation
debuggerScopeStartLocation DebuggerScope
p),
    (RuntimeScriptId
"endLocation" RuntimeScriptId -> DebuggerLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (DebuggerLocation -> Pair) -> Maybe DebuggerLocation -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DebuggerScope -> Maybe DebuggerLocation
debuggerScopeEndLocation DebuggerScope
p)
    ]

-- | Type 'Debugger.SearchMatch'.
--   Search match for resource.
data DebuggerSearchMatch = DebuggerSearchMatch
  {
    -- | Line number in resource content.
    DebuggerSearchMatch -> Double
debuggerSearchMatchLineNumber :: Double,
    -- | Line with match content.
    DebuggerSearchMatch -> RuntimeScriptId
debuggerSearchMatchLineContent :: T.Text
  }
  deriving (DebuggerSearchMatch -> DebuggerSearchMatch -> Bool
(DebuggerSearchMatch -> DebuggerSearchMatch -> Bool)
-> (DebuggerSearchMatch -> DebuggerSearchMatch -> Bool)
-> Eq DebuggerSearchMatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerSearchMatch -> DebuggerSearchMatch -> Bool
$c/= :: DebuggerSearchMatch -> DebuggerSearchMatch -> Bool
== :: DebuggerSearchMatch -> DebuggerSearchMatch -> Bool
$c== :: DebuggerSearchMatch -> DebuggerSearchMatch -> Bool
Eq, Int -> DebuggerSearchMatch -> ShowS
[DebuggerSearchMatch] -> ShowS
DebuggerSearchMatch -> String
(Int -> DebuggerSearchMatch -> ShowS)
-> (DebuggerSearchMatch -> String)
-> ([DebuggerSearchMatch] -> ShowS)
-> Show DebuggerSearchMatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerSearchMatch] -> ShowS
$cshowList :: [DebuggerSearchMatch] -> ShowS
show :: DebuggerSearchMatch -> String
$cshow :: DebuggerSearchMatch -> String
showsPrec :: Int -> DebuggerSearchMatch -> ShowS
$cshowsPrec :: Int -> DebuggerSearchMatch -> ShowS
Show)
instance FromJSON DebuggerSearchMatch where
  parseJSON :: Value -> Parser DebuggerSearchMatch
parseJSON = String
-> (Object -> Parser DebuggerSearchMatch)
-> Value
-> Parser DebuggerSearchMatch
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerSearchMatch" ((Object -> Parser DebuggerSearchMatch)
 -> Value -> Parser DebuggerSearchMatch)
-> (Object -> Parser DebuggerSearchMatch)
-> Value
-> Parser DebuggerSearchMatch
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double -> RuntimeScriptId -> DebuggerSearchMatch
DebuggerSearchMatch
    (Double -> RuntimeScriptId -> DebuggerSearchMatch)
-> Parser Double -> Parser (RuntimeScriptId -> DebuggerSearchMatch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser Double
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"lineNumber"
    Parser (RuntimeScriptId -> DebuggerSearchMatch)
-> Parser RuntimeScriptId -> Parser DebuggerSearchMatch
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"lineContent"
instance ToJSON DebuggerSearchMatch where
  toJSON :: DebuggerSearchMatch -> Value
toJSON DebuggerSearchMatch
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"lineNumber" RuntimeScriptId -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (DebuggerSearchMatch -> Double
debuggerSearchMatchLineNumber DebuggerSearchMatch
p),
    (RuntimeScriptId
"lineContent" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (DebuggerSearchMatch -> RuntimeScriptId
debuggerSearchMatchLineContent DebuggerSearchMatch
p)
    ]

-- | Type 'Debugger.BreakLocation'.
data DebuggerBreakLocationType = DebuggerBreakLocationTypeDebuggerStatement | DebuggerBreakLocationTypeCall | DebuggerBreakLocationTypeReturn
  deriving (Eq DebuggerBreakLocationType
Eq DebuggerBreakLocationType
-> (DebuggerBreakLocationType
    -> DebuggerBreakLocationType -> Ordering)
-> (DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool)
-> (DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool)
-> (DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool)
-> (DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool)
-> (DebuggerBreakLocationType
    -> DebuggerBreakLocationType -> DebuggerBreakLocationType)
-> (DebuggerBreakLocationType
    -> DebuggerBreakLocationType -> DebuggerBreakLocationType)
-> Ord DebuggerBreakLocationType
DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool
DebuggerBreakLocationType -> DebuggerBreakLocationType -> Ordering
DebuggerBreakLocationType
-> DebuggerBreakLocationType -> DebuggerBreakLocationType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DebuggerBreakLocationType
-> DebuggerBreakLocationType -> DebuggerBreakLocationType
$cmin :: DebuggerBreakLocationType
-> DebuggerBreakLocationType -> DebuggerBreakLocationType
max :: DebuggerBreakLocationType
-> DebuggerBreakLocationType -> DebuggerBreakLocationType
$cmax :: DebuggerBreakLocationType
-> DebuggerBreakLocationType -> DebuggerBreakLocationType
>= :: DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool
$c>= :: DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool
> :: DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool
$c> :: DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool
<= :: DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool
$c<= :: DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool
< :: DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool
$c< :: DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool
compare :: DebuggerBreakLocationType -> DebuggerBreakLocationType -> Ordering
$ccompare :: DebuggerBreakLocationType -> DebuggerBreakLocationType -> Ordering
$cp1Ord :: Eq DebuggerBreakLocationType
Ord, DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool
(DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool)
-> (DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool)
-> Eq DebuggerBreakLocationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool
$c/= :: DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool
== :: DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool
$c== :: DebuggerBreakLocationType -> DebuggerBreakLocationType -> Bool
Eq, Int -> DebuggerBreakLocationType -> ShowS
[DebuggerBreakLocationType] -> ShowS
DebuggerBreakLocationType -> String
(Int -> DebuggerBreakLocationType -> ShowS)
-> (DebuggerBreakLocationType -> String)
-> ([DebuggerBreakLocationType] -> ShowS)
-> Show DebuggerBreakLocationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerBreakLocationType] -> ShowS
$cshowList :: [DebuggerBreakLocationType] -> ShowS
show :: DebuggerBreakLocationType -> String
$cshow :: DebuggerBreakLocationType -> String
showsPrec :: Int -> DebuggerBreakLocationType -> ShowS
$cshowsPrec :: Int -> DebuggerBreakLocationType -> ShowS
Show, ReadPrec [DebuggerBreakLocationType]
ReadPrec DebuggerBreakLocationType
Int -> ReadS DebuggerBreakLocationType
ReadS [DebuggerBreakLocationType]
(Int -> ReadS DebuggerBreakLocationType)
-> ReadS [DebuggerBreakLocationType]
-> ReadPrec DebuggerBreakLocationType
-> ReadPrec [DebuggerBreakLocationType]
-> Read DebuggerBreakLocationType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DebuggerBreakLocationType]
$creadListPrec :: ReadPrec [DebuggerBreakLocationType]
readPrec :: ReadPrec DebuggerBreakLocationType
$creadPrec :: ReadPrec DebuggerBreakLocationType
readList :: ReadS [DebuggerBreakLocationType]
$creadList :: ReadS [DebuggerBreakLocationType]
readsPrec :: Int -> ReadS DebuggerBreakLocationType
$creadsPrec :: Int -> ReadS DebuggerBreakLocationType
Read)
instance FromJSON DebuggerBreakLocationType where
  parseJSON :: Value -> Parser DebuggerBreakLocationType
parseJSON = String
-> (RuntimeScriptId -> Parser DebuggerBreakLocationType)
-> Value
-> Parser DebuggerBreakLocationType
forall a.
String -> (RuntimeScriptId -> Parser a) -> Value -> Parser a
A.withText String
"DebuggerBreakLocationType" ((RuntimeScriptId -> Parser DebuggerBreakLocationType)
 -> Value -> Parser DebuggerBreakLocationType)
-> (RuntimeScriptId -> Parser DebuggerBreakLocationType)
-> Value
-> Parser DebuggerBreakLocationType
forall a b. (a -> b) -> a -> b
$ \RuntimeScriptId
v -> case RuntimeScriptId
v of
    RuntimeScriptId
"debuggerStatement" -> DebuggerBreakLocationType -> Parser DebuggerBreakLocationType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerBreakLocationType
DebuggerBreakLocationTypeDebuggerStatement
    RuntimeScriptId
"call" -> DebuggerBreakLocationType -> Parser DebuggerBreakLocationType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerBreakLocationType
DebuggerBreakLocationTypeCall
    RuntimeScriptId
"return" -> DebuggerBreakLocationType -> Parser DebuggerBreakLocationType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerBreakLocationType
DebuggerBreakLocationTypeReturn
    RuntimeScriptId
"_" -> String -> Parser DebuggerBreakLocationType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse DebuggerBreakLocationType"
instance ToJSON DebuggerBreakLocationType where
  toJSON :: DebuggerBreakLocationType -> Value
toJSON DebuggerBreakLocationType
v = RuntimeScriptId -> Value
A.String (RuntimeScriptId -> Value) -> RuntimeScriptId -> Value
forall a b. (a -> b) -> a -> b
$ case DebuggerBreakLocationType
v of
    DebuggerBreakLocationType
DebuggerBreakLocationTypeDebuggerStatement -> RuntimeScriptId
"debuggerStatement"
    DebuggerBreakLocationType
DebuggerBreakLocationTypeCall -> RuntimeScriptId
"call"
    DebuggerBreakLocationType
DebuggerBreakLocationTypeReturn -> RuntimeScriptId
"return"
data DebuggerBreakLocation = DebuggerBreakLocation
  {
    -- | Script identifier as reported in the `Debugger.scriptParsed`.
    DebuggerBreakLocation -> RuntimeScriptId
debuggerBreakLocationScriptId :: Runtime.RuntimeScriptId,
    -- | Line number in the script (0-based).
    DebuggerBreakLocation -> Int
debuggerBreakLocationLineNumber :: Int,
    -- | Column number in the script (0-based).
    DebuggerBreakLocation -> Maybe Int
debuggerBreakLocationColumnNumber :: Maybe Int,
    DebuggerBreakLocation -> Maybe DebuggerBreakLocationType
debuggerBreakLocationType :: Maybe DebuggerBreakLocationType
  }
  deriving (DebuggerBreakLocation -> DebuggerBreakLocation -> Bool
(DebuggerBreakLocation -> DebuggerBreakLocation -> Bool)
-> (DebuggerBreakLocation -> DebuggerBreakLocation -> Bool)
-> Eq DebuggerBreakLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerBreakLocation -> DebuggerBreakLocation -> Bool
$c/= :: DebuggerBreakLocation -> DebuggerBreakLocation -> Bool
== :: DebuggerBreakLocation -> DebuggerBreakLocation -> Bool
$c== :: DebuggerBreakLocation -> DebuggerBreakLocation -> Bool
Eq, Int -> DebuggerBreakLocation -> ShowS
[DebuggerBreakLocation] -> ShowS
DebuggerBreakLocation -> String
(Int -> DebuggerBreakLocation -> ShowS)
-> (DebuggerBreakLocation -> String)
-> ([DebuggerBreakLocation] -> ShowS)
-> Show DebuggerBreakLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerBreakLocation] -> ShowS
$cshowList :: [DebuggerBreakLocation] -> ShowS
show :: DebuggerBreakLocation -> String
$cshow :: DebuggerBreakLocation -> String
showsPrec :: Int -> DebuggerBreakLocation -> ShowS
$cshowsPrec :: Int -> DebuggerBreakLocation -> ShowS
Show)
instance FromJSON DebuggerBreakLocation where
  parseJSON :: Value -> Parser DebuggerBreakLocation
parseJSON = String
-> (Object -> Parser DebuggerBreakLocation)
-> Value
-> Parser DebuggerBreakLocation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerBreakLocation" ((Object -> Parser DebuggerBreakLocation)
 -> Value -> Parser DebuggerBreakLocation)
-> (Object -> Parser DebuggerBreakLocation)
-> Value
-> Parser DebuggerBreakLocation
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeScriptId
-> Int
-> Maybe Int
-> Maybe DebuggerBreakLocationType
-> DebuggerBreakLocation
DebuggerBreakLocation
    (RuntimeScriptId
 -> Int
 -> Maybe Int
 -> Maybe DebuggerBreakLocationType
 -> DebuggerBreakLocation)
-> Parser RuntimeScriptId
-> Parser
     (Int
      -> Maybe Int
      -> Maybe DebuggerBreakLocationType
      -> DebuggerBreakLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"scriptId"
    Parser
  (Int
   -> Maybe Int
   -> Maybe DebuggerBreakLocationType
   -> DebuggerBreakLocation)
-> Parser Int
-> Parser
     (Maybe Int
      -> Maybe DebuggerBreakLocationType -> DebuggerBreakLocation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"lineNumber"
    Parser
  (Maybe Int
   -> Maybe DebuggerBreakLocationType -> DebuggerBreakLocation)
-> Parser (Maybe Int)
-> Parser
     (Maybe DebuggerBreakLocationType -> DebuggerBreakLocation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe Int)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"columnNumber"
    Parser (Maybe DebuggerBreakLocationType -> DebuggerBreakLocation)
-> Parser (Maybe DebuggerBreakLocationType)
-> Parser DebuggerBreakLocation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> RuntimeScriptId -> Parser (Maybe DebuggerBreakLocationType)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"type"
instance ToJSON DebuggerBreakLocation where
  toJSON :: DebuggerBreakLocation -> Value
toJSON DebuggerBreakLocation
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"scriptId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (DebuggerBreakLocation -> RuntimeScriptId
debuggerBreakLocationScriptId DebuggerBreakLocation
p),
    (RuntimeScriptId
"lineNumber" RuntimeScriptId -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DebuggerBreakLocation -> Int
debuggerBreakLocationLineNumber DebuggerBreakLocation
p),
    (RuntimeScriptId
"columnNumber" RuntimeScriptId -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DebuggerBreakLocation -> Maybe Int
debuggerBreakLocationColumnNumber DebuggerBreakLocation
p),
    (RuntimeScriptId
"type" RuntimeScriptId -> DebuggerBreakLocationType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (DebuggerBreakLocationType -> Pair)
-> Maybe DebuggerBreakLocationType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DebuggerBreakLocation -> Maybe DebuggerBreakLocationType
debuggerBreakLocationType DebuggerBreakLocation
p)
    ]

-- | Type 'Debugger.WasmDisassemblyChunk'.
data DebuggerWasmDisassemblyChunk = DebuggerWasmDisassemblyChunk
  {
    -- | The next chunk of disassembled lines.
    DebuggerWasmDisassemblyChunk -> [RuntimeScriptId]
debuggerWasmDisassemblyChunkLines :: [T.Text],
    -- | The bytecode offsets describing the start of each line.
    DebuggerWasmDisassemblyChunk -> [Int]
debuggerWasmDisassemblyChunkBytecodeOffsets :: [Int]
  }
  deriving (DebuggerWasmDisassemblyChunk
-> DebuggerWasmDisassemblyChunk -> Bool
(DebuggerWasmDisassemblyChunk
 -> DebuggerWasmDisassemblyChunk -> Bool)
-> (DebuggerWasmDisassemblyChunk
    -> DebuggerWasmDisassemblyChunk -> Bool)
-> Eq DebuggerWasmDisassemblyChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerWasmDisassemblyChunk
-> DebuggerWasmDisassemblyChunk -> Bool
$c/= :: DebuggerWasmDisassemblyChunk
-> DebuggerWasmDisassemblyChunk -> Bool
== :: DebuggerWasmDisassemblyChunk
-> DebuggerWasmDisassemblyChunk -> Bool
$c== :: DebuggerWasmDisassemblyChunk
-> DebuggerWasmDisassemblyChunk -> Bool
Eq, Int -> DebuggerWasmDisassemblyChunk -> ShowS
[DebuggerWasmDisassemblyChunk] -> ShowS
DebuggerWasmDisassemblyChunk -> String
(Int -> DebuggerWasmDisassemblyChunk -> ShowS)
-> (DebuggerWasmDisassemblyChunk -> String)
-> ([DebuggerWasmDisassemblyChunk] -> ShowS)
-> Show DebuggerWasmDisassemblyChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerWasmDisassemblyChunk] -> ShowS
$cshowList :: [DebuggerWasmDisassemblyChunk] -> ShowS
show :: DebuggerWasmDisassemblyChunk -> String
$cshow :: DebuggerWasmDisassemblyChunk -> String
showsPrec :: Int -> DebuggerWasmDisassemblyChunk -> ShowS
$cshowsPrec :: Int -> DebuggerWasmDisassemblyChunk -> ShowS
Show)
instance FromJSON DebuggerWasmDisassemblyChunk where
  parseJSON :: Value -> Parser DebuggerWasmDisassemblyChunk
parseJSON = String
-> (Object -> Parser DebuggerWasmDisassemblyChunk)
-> Value
-> Parser DebuggerWasmDisassemblyChunk
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerWasmDisassemblyChunk" ((Object -> Parser DebuggerWasmDisassemblyChunk)
 -> Value -> Parser DebuggerWasmDisassemblyChunk)
-> (Object -> Parser DebuggerWasmDisassemblyChunk)
-> Value
-> Parser DebuggerWasmDisassemblyChunk
forall a b. (a -> b) -> a -> b
$ \Object
o -> [RuntimeScriptId] -> [Int] -> DebuggerWasmDisassemblyChunk
DebuggerWasmDisassemblyChunk
    ([RuntimeScriptId] -> [Int] -> DebuggerWasmDisassemblyChunk)
-> Parser [RuntimeScriptId]
-> Parser ([Int] -> DebuggerWasmDisassemblyChunk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser [RuntimeScriptId]
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"lines"
    Parser ([Int] -> DebuggerWasmDisassemblyChunk)
-> Parser [Int] -> Parser DebuggerWasmDisassemblyChunk
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser [Int]
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"bytecodeOffsets"
instance ToJSON DebuggerWasmDisassemblyChunk where
  toJSON :: DebuggerWasmDisassemblyChunk -> Value
toJSON DebuggerWasmDisassemblyChunk
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"lines" RuntimeScriptId -> [RuntimeScriptId] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) ([RuntimeScriptId] -> Pair)
-> Maybe [RuntimeScriptId] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RuntimeScriptId] -> Maybe [RuntimeScriptId]
forall a. a -> Maybe a
Just (DebuggerWasmDisassemblyChunk -> [RuntimeScriptId]
debuggerWasmDisassemblyChunkLines DebuggerWasmDisassemblyChunk
p),
    (RuntimeScriptId
"bytecodeOffsets" RuntimeScriptId -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just (DebuggerWasmDisassemblyChunk -> [Int]
debuggerWasmDisassemblyChunkBytecodeOffsets DebuggerWasmDisassemblyChunk
p)
    ]

-- | Type 'Debugger.ScriptLanguage'.
--   Enum of possible script languages.
data DebuggerScriptLanguage = DebuggerScriptLanguageJavaScript | DebuggerScriptLanguageWebAssembly
  deriving (Eq DebuggerScriptLanguage
Eq DebuggerScriptLanguage
-> (DebuggerScriptLanguage -> DebuggerScriptLanguage -> Ordering)
-> (DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool)
-> (DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool)
-> (DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool)
-> (DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool)
-> (DebuggerScriptLanguage
    -> DebuggerScriptLanguage -> DebuggerScriptLanguage)
-> (DebuggerScriptLanguage
    -> DebuggerScriptLanguage -> DebuggerScriptLanguage)
-> Ord DebuggerScriptLanguage
DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool
DebuggerScriptLanguage -> DebuggerScriptLanguage -> Ordering
DebuggerScriptLanguage
-> DebuggerScriptLanguage -> DebuggerScriptLanguage
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DebuggerScriptLanguage
-> DebuggerScriptLanguage -> DebuggerScriptLanguage
$cmin :: DebuggerScriptLanguage
-> DebuggerScriptLanguage -> DebuggerScriptLanguage
max :: DebuggerScriptLanguage
-> DebuggerScriptLanguage -> DebuggerScriptLanguage
$cmax :: DebuggerScriptLanguage
-> DebuggerScriptLanguage -> DebuggerScriptLanguage
>= :: DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool
$c>= :: DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool
> :: DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool
$c> :: DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool
<= :: DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool
$c<= :: DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool
< :: DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool
$c< :: DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool
compare :: DebuggerScriptLanguage -> DebuggerScriptLanguage -> Ordering
$ccompare :: DebuggerScriptLanguage -> DebuggerScriptLanguage -> Ordering
$cp1Ord :: Eq DebuggerScriptLanguage
Ord, DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool
(DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool)
-> (DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool)
-> Eq DebuggerScriptLanguage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool
$c/= :: DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool
== :: DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool
$c== :: DebuggerScriptLanguage -> DebuggerScriptLanguage -> Bool
Eq, Int -> DebuggerScriptLanguage -> ShowS
[DebuggerScriptLanguage] -> ShowS
DebuggerScriptLanguage -> String
(Int -> DebuggerScriptLanguage -> ShowS)
-> (DebuggerScriptLanguage -> String)
-> ([DebuggerScriptLanguage] -> ShowS)
-> Show DebuggerScriptLanguage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerScriptLanguage] -> ShowS
$cshowList :: [DebuggerScriptLanguage] -> ShowS
show :: DebuggerScriptLanguage -> String
$cshow :: DebuggerScriptLanguage -> String
showsPrec :: Int -> DebuggerScriptLanguage -> ShowS
$cshowsPrec :: Int -> DebuggerScriptLanguage -> ShowS
Show, ReadPrec [DebuggerScriptLanguage]
ReadPrec DebuggerScriptLanguage
Int -> ReadS DebuggerScriptLanguage
ReadS [DebuggerScriptLanguage]
(Int -> ReadS DebuggerScriptLanguage)
-> ReadS [DebuggerScriptLanguage]
-> ReadPrec DebuggerScriptLanguage
-> ReadPrec [DebuggerScriptLanguage]
-> Read DebuggerScriptLanguage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DebuggerScriptLanguage]
$creadListPrec :: ReadPrec [DebuggerScriptLanguage]
readPrec :: ReadPrec DebuggerScriptLanguage
$creadPrec :: ReadPrec DebuggerScriptLanguage
readList :: ReadS [DebuggerScriptLanguage]
$creadList :: ReadS [DebuggerScriptLanguage]
readsPrec :: Int -> ReadS DebuggerScriptLanguage
$creadsPrec :: Int -> ReadS DebuggerScriptLanguage
Read)
instance FromJSON DebuggerScriptLanguage where
  parseJSON :: Value -> Parser DebuggerScriptLanguage
parseJSON = String
-> (RuntimeScriptId -> Parser DebuggerScriptLanguage)
-> Value
-> Parser DebuggerScriptLanguage
forall a.
String -> (RuntimeScriptId -> Parser a) -> Value -> Parser a
A.withText String
"DebuggerScriptLanguage" ((RuntimeScriptId -> Parser DebuggerScriptLanguage)
 -> Value -> Parser DebuggerScriptLanguage)
-> (RuntimeScriptId -> Parser DebuggerScriptLanguage)
-> Value
-> Parser DebuggerScriptLanguage
forall a b. (a -> b) -> a -> b
$ \RuntimeScriptId
v -> case RuntimeScriptId
v of
    RuntimeScriptId
"JavaScript" -> DebuggerScriptLanguage -> Parser DebuggerScriptLanguage
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerScriptLanguage
DebuggerScriptLanguageJavaScript
    RuntimeScriptId
"WebAssembly" -> DebuggerScriptLanguage -> Parser DebuggerScriptLanguage
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerScriptLanguage
DebuggerScriptLanguageWebAssembly
    RuntimeScriptId
"_" -> String -> Parser DebuggerScriptLanguage
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse DebuggerScriptLanguage"
instance ToJSON DebuggerScriptLanguage where
  toJSON :: DebuggerScriptLanguage -> Value
toJSON DebuggerScriptLanguage
v = RuntimeScriptId -> Value
A.String (RuntimeScriptId -> Value) -> RuntimeScriptId -> Value
forall a b. (a -> b) -> a -> b
$ case DebuggerScriptLanguage
v of
    DebuggerScriptLanguage
DebuggerScriptLanguageJavaScript -> RuntimeScriptId
"JavaScript"
    DebuggerScriptLanguage
DebuggerScriptLanguageWebAssembly -> RuntimeScriptId
"WebAssembly"

-- | Type 'Debugger.DebugSymbols'.
--   Debug symbols available for a wasm script.
data DebuggerDebugSymbolsType = DebuggerDebugSymbolsTypeNone | DebuggerDebugSymbolsTypeSourceMap | DebuggerDebugSymbolsTypeEmbeddedDWARF | DebuggerDebugSymbolsTypeExternalDWARF
  deriving (Eq DebuggerDebugSymbolsType
Eq DebuggerDebugSymbolsType
-> (DebuggerDebugSymbolsType
    -> DebuggerDebugSymbolsType -> Ordering)
-> (DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool)
-> (DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool)
-> (DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool)
-> (DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool)
-> (DebuggerDebugSymbolsType
    -> DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType)
-> (DebuggerDebugSymbolsType
    -> DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType)
-> Ord DebuggerDebugSymbolsType
DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool
DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Ordering
DebuggerDebugSymbolsType
-> DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DebuggerDebugSymbolsType
-> DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType
$cmin :: DebuggerDebugSymbolsType
-> DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType
max :: DebuggerDebugSymbolsType
-> DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType
$cmax :: DebuggerDebugSymbolsType
-> DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType
>= :: DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool
$c>= :: DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool
> :: DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool
$c> :: DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool
<= :: DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool
$c<= :: DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool
< :: DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool
$c< :: DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool
compare :: DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Ordering
$ccompare :: DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Ordering
$cp1Ord :: Eq DebuggerDebugSymbolsType
Ord, DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool
(DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool)
-> (DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool)
-> Eq DebuggerDebugSymbolsType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool
$c/= :: DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool
== :: DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool
$c== :: DebuggerDebugSymbolsType -> DebuggerDebugSymbolsType -> Bool
Eq, Int -> DebuggerDebugSymbolsType -> ShowS
[DebuggerDebugSymbolsType] -> ShowS
DebuggerDebugSymbolsType -> String
(Int -> DebuggerDebugSymbolsType -> ShowS)
-> (DebuggerDebugSymbolsType -> String)
-> ([DebuggerDebugSymbolsType] -> ShowS)
-> Show DebuggerDebugSymbolsType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerDebugSymbolsType] -> ShowS
$cshowList :: [DebuggerDebugSymbolsType] -> ShowS
show :: DebuggerDebugSymbolsType -> String
$cshow :: DebuggerDebugSymbolsType -> String
showsPrec :: Int -> DebuggerDebugSymbolsType -> ShowS
$cshowsPrec :: Int -> DebuggerDebugSymbolsType -> ShowS
Show, ReadPrec [DebuggerDebugSymbolsType]
ReadPrec DebuggerDebugSymbolsType
Int -> ReadS DebuggerDebugSymbolsType
ReadS [DebuggerDebugSymbolsType]
(Int -> ReadS DebuggerDebugSymbolsType)
-> ReadS [DebuggerDebugSymbolsType]
-> ReadPrec DebuggerDebugSymbolsType
-> ReadPrec [DebuggerDebugSymbolsType]
-> Read DebuggerDebugSymbolsType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DebuggerDebugSymbolsType]
$creadListPrec :: ReadPrec [DebuggerDebugSymbolsType]
readPrec :: ReadPrec DebuggerDebugSymbolsType
$creadPrec :: ReadPrec DebuggerDebugSymbolsType
readList :: ReadS [DebuggerDebugSymbolsType]
$creadList :: ReadS [DebuggerDebugSymbolsType]
readsPrec :: Int -> ReadS DebuggerDebugSymbolsType
$creadsPrec :: Int -> ReadS DebuggerDebugSymbolsType
Read)
instance FromJSON DebuggerDebugSymbolsType where
  parseJSON :: Value -> Parser DebuggerDebugSymbolsType
parseJSON = String
-> (RuntimeScriptId -> Parser DebuggerDebugSymbolsType)
-> Value
-> Parser DebuggerDebugSymbolsType
forall a.
String -> (RuntimeScriptId -> Parser a) -> Value -> Parser a
A.withText String
"DebuggerDebugSymbolsType" ((RuntimeScriptId -> Parser DebuggerDebugSymbolsType)
 -> Value -> Parser DebuggerDebugSymbolsType)
-> (RuntimeScriptId -> Parser DebuggerDebugSymbolsType)
-> Value
-> Parser DebuggerDebugSymbolsType
forall a b. (a -> b) -> a -> b
$ \RuntimeScriptId
v -> case RuntimeScriptId
v of
    RuntimeScriptId
"None" -> DebuggerDebugSymbolsType -> Parser DebuggerDebugSymbolsType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerDebugSymbolsType
DebuggerDebugSymbolsTypeNone
    RuntimeScriptId
"SourceMap" -> DebuggerDebugSymbolsType -> Parser DebuggerDebugSymbolsType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerDebugSymbolsType
DebuggerDebugSymbolsTypeSourceMap
    RuntimeScriptId
"EmbeddedDWARF" -> DebuggerDebugSymbolsType -> Parser DebuggerDebugSymbolsType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerDebugSymbolsType
DebuggerDebugSymbolsTypeEmbeddedDWARF
    RuntimeScriptId
"ExternalDWARF" -> DebuggerDebugSymbolsType -> Parser DebuggerDebugSymbolsType
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerDebugSymbolsType
DebuggerDebugSymbolsTypeExternalDWARF
    RuntimeScriptId
"_" -> String -> Parser DebuggerDebugSymbolsType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse DebuggerDebugSymbolsType"
instance ToJSON DebuggerDebugSymbolsType where
  toJSON :: DebuggerDebugSymbolsType -> Value
toJSON DebuggerDebugSymbolsType
v = RuntimeScriptId -> Value
A.String (RuntimeScriptId -> Value) -> RuntimeScriptId -> Value
forall a b. (a -> b) -> a -> b
$ case DebuggerDebugSymbolsType
v of
    DebuggerDebugSymbolsType
DebuggerDebugSymbolsTypeNone -> RuntimeScriptId
"None"
    DebuggerDebugSymbolsType
DebuggerDebugSymbolsTypeSourceMap -> RuntimeScriptId
"SourceMap"
    DebuggerDebugSymbolsType
DebuggerDebugSymbolsTypeEmbeddedDWARF -> RuntimeScriptId
"EmbeddedDWARF"
    DebuggerDebugSymbolsType
DebuggerDebugSymbolsTypeExternalDWARF -> RuntimeScriptId
"ExternalDWARF"
data DebuggerDebugSymbols = DebuggerDebugSymbols
  {
    -- | Type of the debug symbols.
    DebuggerDebugSymbols -> DebuggerDebugSymbolsType
debuggerDebugSymbolsType :: DebuggerDebugSymbolsType,
    -- | URL of the external symbol source.
    DebuggerDebugSymbols -> Maybe RuntimeScriptId
debuggerDebugSymbolsExternalURL :: Maybe T.Text
  }
  deriving (DebuggerDebugSymbols -> DebuggerDebugSymbols -> Bool
(DebuggerDebugSymbols -> DebuggerDebugSymbols -> Bool)
-> (DebuggerDebugSymbols -> DebuggerDebugSymbols -> Bool)
-> Eq DebuggerDebugSymbols
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerDebugSymbols -> DebuggerDebugSymbols -> Bool
$c/= :: DebuggerDebugSymbols -> DebuggerDebugSymbols -> Bool
== :: DebuggerDebugSymbols -> DebuggerDebugSymbols -> Bool
$c== :: DebuggerDebugSymbols -> DebuggerDebugSymbols -> Bool
Eq, Int -> DebuggerDebugSymbols -> ShowS
[DebuggerDebugSymbols] -> ShowS
DebuggerDebugSymbols -> String
(Int -> DebuggerDebugSymbols -> ShowS)
-> (DebuggerDebugSymbols -> String)
-> ([DebuggerDebugSymbols] -> ShowS)
-> Show DebuggerDebugSymbols
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerDebugSymbols] -> ShowS
$cshowList :: [DebuggerDebugSymbols] -> ShowS
show :: DebuggerDebugSymbols -> String
$cshow :: DebuggerDebugSymbols -> String
showsPrec :: Int -> DebuggerDebugSymbols -> ShowS
$cshowsPrec :: Int -> DebuggerDebugSymbols -> ShowS
Show)
instance FromJSON DebuggerDebugSymbols where
  parseJSON :: Value -> Parser DebuggerDebugSymbols
parseJSON = String
-> (Object -> Parser DebuggerDebugSymbols)
-> Value
-> Parser DebuggerDebugSymbols
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerDebugSymbols" ((Object -> Parser DebuggerDebugSymbols)
 -> Value -> Parser DebuggerDebugSymbols)
-> (Object -> Parser DebuggerDebugSymbols)
-> Value
-> Parser DebuggerDebugSymbols
forall a b. (a -> b) -> a -> b
$ \Object
o -> DebuggerDebugSymbolsType
-> Maybe RuntimeScriptId -> DebuggerDebugSymbols
DebuggerDebugSymbols
    (DebuggerDebugSymbolsType
 -> Maybe RuntimeScriptId -> DebuggerDebugSymbols)
-> Parser DebuggerDebugSymbolsType
-> Parser (Maybe RuntimeScriptId -> DebuggerDebugSymbols)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser DebuggerDebugSymbolsType
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"type"
    Parser (Maybe RuntimeScriptId -> DebuggerDebugSymbols)
-> Parser (Maybe RuntimeScriptId) -> Parser DebuggerDebugSymbols
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeScriptId)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"externalURL"
instance ToJSON DebuggerDebugSymbols where
  toJSON :: DebuggerDebugSymbols -> Value
toJSON DebuggerDebugSymbols
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"type" RuntimeScriptId -> DebuggerDebugSymbolsType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (DebuggerDebugSymbolsType -> Pair)
-> Maybe DebuggerDebugSymbolsType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DebuggerDebugSymbolsType -> Maybe DebuggerDebugSymbolsType
forall a. a -> Maybe a
Just (DebuggerDebugSymbols -> DebuggerDebugSymbolsType
debuggerDebugSymbolsType DebuggerDebugSymbols
p),
    (RuntimeScriptId
"externalURL" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DebuggerDebugSymbols -> Maybe RuntimeScriptId
debuggerDebugSymbolsExternalURL DebuggerDebugSymbols
p)
    ]

-- | Type of the 'Debugger.breakpointResolved' event.
data DebuggerBreakpointResolved = DebuggerBreakpointResolved
  {
    -- | Breakpoint unique identifier.
    DebuggerBreakpointResolved -> RuntimeScriptId
debuggerBreakpointResolvedBreakpointId :: DebuggerBreakpointId,
    -- | Actual breakpoint location.
    DebuggerBreakpointResolved -> DebuggerLocation
debuggerBreakpointResolvedLocation :: DebuggerLocation
  }
  deriving (DebuggerBreakpointResolved -> DebuggerBreakpointResolved -> Bool
(DebuggerBreakpointResolved -> DebuggerBreakpointResolved -> Bool)
-> (DebuggerBreakpointResolved
    -> DebuggerBreakpointResolved -> Bool)
-> Eq DebuggerBreakpointResolved
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerBreakpointResolved -> DebuggerBreakpointResolved -> Bool
$c/= :: DebuggerBreakpointResolved -> DebuggerBreakpointResolved -> Bool
== :: DebuggerBreakpointResolved -> DebuggerBreakpointResolved -> Bool
$c== :: DebuggerBreakpointResolved -> DebuggerBreakpointResolved -> Bool
Eq, Int -> DebuggerBreakpointResolved -> ShowS
[DebuggerBreakpointResolved] -> ShowS
DebuggerBreakpointResolved -> String
(Int -> DebuggerBreakpointResolved -> ShowS)
-> (DebuggerBreakpointResolved -> String)
-> ([DebuggerBreakpointResolved] -> ShowS)
-> Show DebuggerBreakpointResolved
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerBreakpointResolved] -> ShowS
$cshowList :: [DebuggerBreakpointResolved] -> ShowS
show :: DebuggerBreakpointResolved -> String
$cshow :: DebuggerBreakpointResolved -> String
showsPrec :: Int -> DebuggerBreakpointResolved -> ShowS
$cshowsPrec :: Int -> DebuggerBreakpointResolved -> ShowS
Show)
instance FromJSON DebuggerBreakpointResolved where
  parseJSON :: Value -> Parser DebuggerBreakpointResolved
parseJSON = String
-> (Object -> Parser DebuggerBreakpointResolved)
-> Value
-> Parser DebuggerBreakpointResolved
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerBreakpointResolved" ((Object -> Parser DebuggerBreakpointResolved)
 -> Value -> Parser DebuggerBreakpointResolved)
-> (Object -> Parser DebuggerBreakpointResolved)
-> Value
-> Parser DebuggerBreakpointResolved
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeScriptId -> DebuggerLocation -> DebuggerBreakpointResolved
DebuggerBreakpointResolved
    (RuntimeScriptId -> DebuggerLocation -> DebuggerBreakpointResolved)
-> Parser RuntimeScriptId
-> Parser (DebuggerLocation -> DebuggerBreakpointResolved)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"breakpointId"
    Parser (DebuggerLocation -> DebuggerBreakpointResolved)
-> Parser DebuggerLocation -> Parser DebuggerBreakpointResolved
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser DebuggerLocation
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"location"
instance Event DebuggerBreakpointResolved where
  eventName :: Proxy DebuggerBreakpointResolved -> String
eventName Proxy DebuggerBreakpointResolved
_ = String
"Debugger.breakpointResolved"

-- | Type of the 'Debugger.paused' event.
data DebuggerPausedReason = DebuggerPausedReasonAmbiguous | DebuggerPausedReasonAssert | DebuggerPausedReasonCSPViolation | DebuggerPausedReasonDebugCommand | DebuggerPausedReasonDOM | DebuggerPausedReasonEventListener | DebuggerPausedReasonException | DebuggerPausedReasonInstrumentation | DebuggerPausedReasonOOM | DebuggerPausedReasonOther | DebuggerPausedReasonPromiseRejection | DebuggerPausedReasonXHR
  deriving (Eq DebuggerPausedReason
Eq DebuggerPausedReason
-> (DebuggerPausedReason -> DebuggerPausedReason -> Ordering)
-> (DebuggerPausedReason -> DebuggerPausedReason -> Bool)
-> (DebuggerPausedReason -> DebuggerPausedReason -> Bool)
-> (DebuggerPausedReason -> DebuggerPausedReason -> Bool)
-> (DebuggerPausedReason -> DebuggerPausedReason -> Bool)
-> (DebuggerPausedReason
    -> DebuggerPausedReason -> DebuggerPausedReason)
-> (DebuggerPausedReason
    -> DebuggerPausedReason -> DebuggerPausedReason)
-> Ord DebuggerPausedReason
DebuggerPausedReason -> DebuggerPausedReason -> Bool
DebuggerPausedReason -> DebuggerPausedReason -> Ordering
DebuggerPausedReason
-> DebuggerPausedReason -> DebuggerPausedReason
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DebuggerPausedReason
-> DebuggerPausedReason -> DebuggerPausedReason
$cmin :: DebuggerPausedReason
-> DebuggerPausedReason -> DebuggerPausedReason
max :: DebuggerPausedReason
-> DebuggerPausedReason -> DebuggerPausedReason
$cmax :: DebuggerPausedReason
-> DebuggerPausedReason -> DebuggerPausedReason
>= :: DebuggerPausedReason -> DebuggerPausedReason -> Bool
$c>= :: DebuggerPausedReason -> DebuggerPausedReason -> Bool
> :: DebuggerPausedReason -> DebuggerPausedReason -> Bool
$c> :: DebuggerPausedReason -> DebuggerPausedReason -> Bool
<= :: DebuggerPausedReason -> DebuggerPausedReason -> Bool
$c<= :: DebuggerPausedReason -> DebuggerPausedReason -> Bool
< :: DebuggerPausedReason -> DebuggerPausedReason -> Bool
$c< :: DebuggerPausedReason -> DebuggerPausedReason -> Bool
compare :: DebuggerPausedReason -> DebuggerPausedReason -> Ordering
$ccompare :: DebuggerPausedReason -> DebuggerPausedReason -> Ordering
$cp1Ord :: Eq DebuggerPausedReason
Ord, DebuggerPausedReason -> DebuggerPausedReason -> Bool
(DebuggerPausedReason -> DebuggerPausedReason -> Bool)
-> (DebuggerPausedReason -> DebuggerPausedReason -> Bool)
-> Eq DebuggerPausedReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerPausedReason -> DebuggerPausedReason -> Bool
$c/= :: DebuggerPausedReason -> DebuggerPausedReason -> Bool
== :: DebuggerPausedReason -> DebuggerPausedReason -> Bool
$c== :: DebuggerPausedReason -> DebuggerPausedReason -> Bool
Eq, Int -> DebuggerPausedReason -> ShowS
[DebuggerPausedReason] -> ShowS
DebuggerPausedReason -> String
(Int -> DebuggerPausedReason -> ShowS)
-> (DebuggerPausedReason -> String)
-> ([DebuggerPausedReason] -> ShowS)
-> Show DebuggerPausedReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerPausedReason] -> ShowS
$cshowList :: [DebuggerPausedReason] -> ShowS
show :: DebuggerPausedReason -> String
$cshow :: DebuggerPausedReason -> String
showsPrec :: Int -> DebuggerPausedReason -> ShowS
$cshowsPrec :: Int -> DebuggerPausedReason -> ShowS
Show, ReadPrec [DebuggerPausedReason]
ReadPrec DebuggerPausedReason
Int -> ReadS DebuggerPausedReason
ReadS [DebuggerPausedReason]
(Int -> ReadS DebuggerPausedReason)
-> ReadS [DebuggerPausedReason]
-> ReadPrec DebuggerPausedReason
-> ReadPrec [DebuggerPausedReason]
-> Read DebuggerPausedReason
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DebuggerPausedReason]
$creadListPrec :: ReadPrec [DebuggerPausedReason]
readPrec :: ReadPrec DebuggerPausedReason
$creadPrec :: ReadPrec DebuggerPausedReason
readList :: ReadS [DebuggerPausedReason]
$creadList :: ReadS [DebuggerPausedReason]
readsPrec :: Int -> ReadS DebuggerPausedReason
$creadsPrec :: Int -> ReadS DebuggerPausedReason
Read)
instance FromJSON DebuggerPausedReason where
  parseJSON :: Value -> Parser DebuggerPausedReason
parseJSON = String
-> (RuntimeScriptId -> Parser DebuggerPausedReason)
-> Value
-> Parser DebuggerPausedReason
forall a.
String -> (RuntimeScriptId -> Parser a) -> Value -> Parser a
A.withText String
"DebuggerPausedReason" ((RuntimeScriptId -> Parser DebuggerPausedReason)
 -> Value -> Parser DebuggerPausedReason)
-> (RuntimeScriptId -> Parser DebuggerPausedReason)
-> Value
-> Parser DebuggerPausedReason
forall a b. (a -> b) -> a -> b
$ \RuntimeScriptId
v -> case RuntimeScriptId
v of
    RuntimeScriptId
"ambiguous" -> DebuggerPausedReason -> Parser DebuggerPausedReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerPausedReason
DebuggerPausedReasonAmbiguous
    RuntimeScriptId
"assert" -> DebuggerPausedReason -> Parser DebuggerPausedReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerPausedReason
DebuggerPausedReasonAssert
    RuntimeScriptId
"CSPViolation" -> DebuggerPausedReason -> Parser DebuggerPausedReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerPausedReason
DebuggerPausedReasonCSPViolation
    RuntimeScriptId
"debugCommand" -> DebuggerPausedReason -> Parser DebuggerPausedReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerPausedReason
DebuggerPausedReasonDebugCommand
    RuntimeScriptId
"DOM" -> DebuggerPausedReason -> Parser DebuggerPausedReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerPausedReason
DebuggerPausedReasonDOM
    RuntimeScriptId
"EventListener" -> DebuggerPausedReason -> Parser DebuggerPausedReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerPausedReason
DebuggerPausedReasonEventListener
    RuntimeScriptId
"exception" -> DebuggerPausedReason -> Parser DebuggerPausedReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerPausedReason
DebuggerPausedReasonException
    RuntimeScriptId
"instrumentation" -> DebuggerPausedReason -> Parser DebuggerPausedReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerPausedReason
DebuggerPausedReasonInstrumentation
    RuntimeScriptId
"OOM" -> DebuggerPausedReason -> Parser DebuggerPausedReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerPausedReason
DebuggerPausedReasonOOM
    RuntimeScriptId
"other" -> DebuggerPausedReason -> Parser DebuggerPausedReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerPausedReason
DebuggerPausedReasonOther
    RuntimeScriptId
"promiseRejection" -> DebuggerPausedReason -> Parser DebuggerPausedReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerPausedReason
DebuggerPausedReasonPromiseRejection
    RuntimeScriptId
"XHR" -> DebuggerPausedReason -> Parser DebuggerPausedReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerPausedReason
DebuggerPausedReasonXHR
    RuntimeScriptId
"_" -> String -> Parser DebuggerPausedReason
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse DebuggerPausedReason"
instance ToJSON DebuggerPausedReason where
  toJSON :: DebuggerPausedReason -> Value
toJSON DebuggerPausedReason
v = RuntimeScriptId -> Value
A.String (RuntimeScriptId -> Value) -> RuntimeScriptId -> Value
forall a b. (a -> b) -> a -> b
$ case DebuggerPausedReason
v of
    DebuggerPausedReason
DebuggerPausedReasonAmbiguous -> RuntimeScriptId
"ambiguous"
    DebuggerPausedReason
DebuggerPausedReasonAssert -> RuntimeScriptId
"assert"
    DebuggerPausedReason
DebuggerPausedReasonCSPViolation -> RuntimeScriptId
"CSPViolation"
    DebuggerPausedReason
DebuggerPausedReasonDebugCommand -> RuntimeScriptId
"debugCommand"
    DebuggerPausedReason
DebuggerPausedReasonDOM -> RuntimeScriptId
"DOM"
    DebuggerPausedReason
DebuggerPausedReasonEventListener -> RuntimeScriptId
"EventListener"
    DebuggerPausedReason
DebuggerPausedReasonException -> RuntimeScriptId
"exception"
    DebuggerPausedReason
DebuggerPausedReasonInstrumentation -> RuntimeScriptId
"instrumentation"
    DebuggerPausedReason
DebuggerPausedReasonOOM -> RuntimeScriptId
"OOM"
    DebuggerPausedReason
DebuggerPausedReasonOther -> RuntimeScriptId
"other"
    DebuggerPausedReason
DebuggerPausedReasonPromiseRejection -> RuntimeScriptId
"promiseRejection"
    DebuggerPausedReason
DebuggerPausedReasonXHR -> RuntimeScriptId
"XHR"
data DebuggerPaused = DebuggerPaused
  {
    -- | Call stack the virtual machine stopped on.
    DebuggerPaused -> [DebuggerCallFrame]
debuggerPausedCallFrames :: [DebuggerCallFrame],
    -- | Pause reason.
    DebuggerPaused -> DebuggerPausedReason
debuggerPausedReason :: DebuggerPausedReason,
    -- | Object containing break-specific auxiliary properties.
    DebuggerPaused -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
debuggerPausedData :: Maybe [(T.Text, T.Text)],
    -- | Hit breakpoints IDs
    DebuggerPaused -> Maybe [RuntimeScriptId]
debuggerPausedHitBreakpoints :: Maybe [T.Text],
    -- | Async stack trace, if any.
    DebuggerPaused -> Maybe RuntimeStackTrace
debuggerPausedAsyncStackTrace :: Maybe Runtime.RuntimeStackTrace,
    -- | Async stack trace, if any.
    DebuggerPaused -> Maybe RuntimeStackTraceId
debuggerPausedAsyncStackTraceId :: Maybe Runtime.RuntimeStackTraceId
  }
  deriving (DebuggerPaused -> DebuggerPaused -> Bool
(DebuggerPaused -> DebuggerPaused -> Bool)
-> (DebuggerPaused -> DebuggerPaused -> Bool) -> Eq DebuggerPaused
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerPaused -> DebuggerPaused -> Bool
$c/= :: DebuggerPaused -> DebuggerPaused -> Bool
== :: DebuggerPaused -> DebuggerPaused -> Bool
$c== :: DebuggerPaused -> DebuggerPaused -> Bool
Eq, Int -> DebuggerPaused -> ShowS
[DebuggerPaused] -> ShowS
DebuggerPaused -> String
(Int -> DebuggerPaused -> ShowS)
-> (DebuggerPaused -> String)
-> ([DebuggerPaused] -> ShowS)
-> Show DebuggerPaused
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerPaused] -> ShowS
$cshowList :: [DebuggerPaused] -> ShowS
show :: DebuggerPaused -> String
$cshow :: DebuggerPaused -> String
showsPrec :: Int -> DebuggerPaused -> ShowS
$cshowsPrec :: Int -> DebuggerPaused -> ShowS
Show)
instance FromJSON DebuggerPaused where
  parseJSON :: Value -> Parser DebuggerPaused
parseJSON = String
-> (Object -> Parser DebuggerPaused)
-> Value
-> Parser DebuggerPaused
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerPaused" ((Object -> Parser DebuggerPaused)
 -> Value -> Parser DebuggerPaused)
-> (Object -> Parser DebuggerPaused)
-> Value
-> Parser DebuggerPaused
forall a b. (a -> b) -> a -> b
$ \Object
o -> [DebuggerCallFrame]
-> DebuggerPausedReason
-> Maybe [(RuntimeScriptId, RuntimeScriptId)]
-> Maybe [RuntimeScriptId]
-> Maybe RuntimeStackTrace
-> Maybe RuntimeStackTraceId
-> DebuggerPaused
DebuggerPaused
    ([DebuggerCallFrame]
 -> DebuggerPausedReason
 -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
 -> Maybe [RuntimeScriptId]
 -> Maybe RuntimeStackTrace
 -> Maybe RuntimeStackTraceId
 -> DebuggerPaused)
-> Parser [DebuggerCallFrame]
-> Parser
     (DebuggerPausedReason
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe [RuntimeScriptId]
      -> Maybe RuntimeStackTrace
      -> Maybe RuntimeStackTraceId
      -> DebuggerPaused)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser [DebuggerCallFrame]
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"callFrames"
    Parser
  (DebuggerPausedReason
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe [RuntimeScriptId]
   -> Maybe RuntimeStackTrace
   -> Maybe RuntimeStackTraceId
   -> DebuggerPaused)
-> Parser DebuggerPausedReason
-> Parser
     (Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe [RuntimeScriptId]
      -> Maybe RuntimeStackTrace
      -> Maybe RuntimeStackTraceId
      -> DebuggerPaused)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser DebuggerPausedReason
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"reason"
    Parser
  (Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe [RuntimeScriptId]
   -> Maybe RuntimeStackTrace
   -> Maybe RuntimeStackTraceId
   -> DebuggerPaused)
-> Parser (Maybe [(RuntimeScriptId, RuntimeScriptId)])
-> Parser
     (Maybe [RuntimeScriptId]
      -> Maybe RuntimeStackTrace
      -> Maybe RuntimeStackTraceId
      -> DebuggerPaused)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> RuntimeScriptId
-> Parser (Maybe [(RuntimeScriptId, RuntimeScriptId)])
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"data"
    Parser
  (Maybe [RuntimeScriptId]
   -> Maybe RuntimeStackTrace
   -> Maybe RuntimeStackTraceId
   -> DebuggerPaused)
-> Parser (Maybe [RuntimeScriptId])
-> Parser
     (Maybe RuntimeStackTrace
      -> Maybe RuntimeStackTraceId -> DebuggerPaused)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe [RuntimeScriptId])
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"hitBreakpoints"
    Parser
  (Maybe RuntimeStackTrace
   -> Maybe RuntimeStackTraceId -> DebuggerPaused)
-> Parser (Maybe RuntimeStackTrace)
-> Parser (Maybe RuntimeStackTraceId -> DebuggerPaused)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeStackTrace)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"asyncStackTrace"
    Parser (Maybe RuntimeStackTraceId -> DebuggerPaused)
-> Parser (Maybe RuntimeStackTraceId) -> Parser DebuggerPaused
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeStackTraceId)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"asyncStackTraceId"
instance Event DebuggerPaused where
  eventName :: Proxy DebuggerPaused -> String
eventName Proxy DebuggerPaused
_ = String
"Debugger.paused"

-- | Type of the 'Debugger.resumed' event.
data DebuggerResumed = DebuggerResumed
  deriving (DebuggerResumed -> DebuggerResumed -> Bool
(DebuggerResumed -> DebuggerResumed -> Bool)
-> (DebuggerResumed -> DebuggerResumed -> Bool)
-> Eq DebuggerResumed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerResumed -> DebuggerResumed -> Bool
$c/= :: DebuggerResumed -> DebuggerResumed -> Bool
== :: DebuggerResumed -> DebuggerResumed -> Bool
$c== :: DebuggerResumed -> DebuggerResumed -> Bool
Eq, Int -> DebuggerResumed -> ShowS
[DebuggerResumed] -> ShowS
DebuggerResumed -> String
(Int -> DebuggerResumed -> ShowS)
-> (DebuggerResumed -> String)
-> ([DebuggerResumed] -> ShowS)
-> Show DebuggerResumed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerResumed] -> ShowS
$cshowList :: [DebuggerResumed] -> ShowS
show :: DebuggerResumed -> String
$cshow :: DebuggerResumed -> String
showsPrec :: Int -> DebuggerResumed -> ShowS
$cshowsPrec :: Int -> DebuggerResumed -> ShowS
Show, ReadPrec [DebuggerResumed]
ReadPrec DebuggerResumed
Int -> ReadS DebuggerResumed
ReadS [DebuggerResumed]
(Int -> ReadS DebuggerResumed)
-> ReadS [DebuggerResumed]
-> ReadPrec DebuggerResumed
-> ReadPrec [DebuggerResumed]
-> Read DebuggerResumed
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DebuggerResumed]
$creadListPrec :: ReadPrec [DebuggerResumed]
readPrec :: ReadPrec DebuggerResumed
$creadPrec :: ReadPrec DebuggerResumed
readList :: ReadS [DebuggerResumed]
$creadList :: ReadS [DebuggerResumed]
readsPrec :: Int -> ReadS DebuggerResumed
$creadsPrec :: Int -> ReadS DebuggerResumed
Read)
instance FromJSON DebuggerResumed where
  parseJSON :: Value -> Parser DebuggerResumed
parseJSON Value
_ = DebuggerResumed -> Parser DebuggerResumed
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerResumed
DebuggerResumed
instance Event DebuggerResumed where
  eventName :: Proxy DebuggerResumed -> String
eventName Proxy DebuggerResumed
_ = String
"Debugger.resumed"

-- | Type of the 'Debugger.scriptFailedToParse' event.
data DebuggerScriptFailedToParse = DebuggerScriptFailedToParse
  {
    -- | Identifier of the script parsed.
    DebuggerScriptFailedToParse -> RuntimeScriptId
debuggerScriptFailedToParseScriptId :: Runtime.RuntimeScriptId,
    -- | URL or name of the script parsed (if any).
    DebuggerScriptFailedToParse -> RuntimeScriptId
debuggerScriptFailedToParseUrl :: T.Text,
    -- | Line offset of the script within the resource with given URL (for script tags).
    DebuggerScriptFailedToParse -> Int
debuggerScriptFailedToParseStartLine :: Int,
    -- | Column offset of the script within the resource with given URL.
    DebuggerScriptFailedToParse -> Int
debuggerScriptFailedToParseStartColumn :: Int,
    -- | Last line of the script.
    DebuggerScriptFailedToParse -> Int
debuggerScriptFailedToParseEndLine :: Int,
    -- | Length of the last line of the script.
    DebuggerScriptFailedToParse -> Int
debuggerScriptFailedToParseEndColumn :: Int,
    -- | Specifies script creation context.
    DebuggerScriptFailedToParse -> Int
debuggerScriptFailedToParseExecutionContextId :: Runtime.RuntimeExecutionContextId,
    -- | Content hash of the script, SHA-256.
    DebuggerScriptFailedToParse -> RuntimeScriptId
debuggerScriptFailedToParseHash :: T.Text,
    -- | Embedder-specific auxiliary data.
    DebuggerScriptFailedToParse
-> Maybe [(RuntimeScriptId, RuntimeScriptId)]
debuggerScriptFailedToParseExecutionContextAuxData :: Maybe [(T.Text, T.Text)],
    -- | URL of source map associated with script (if any).
    DebuggerScriptFailedToParse -> Maybe RuntimeScriptId
debuggerScriptFailedToParseSourceMapURL :: Maybe T.Text,
    -- | True, if this script has sourceURL.
    DebuggerScriptFailedToParse -> Maybe Bool
debuggerScriptFailedToParseHasSourceURL :: Maybe Bool,
    -- | True, if this script is ES6 module.
    DebuggerScriptFailedToParse -> Maybe Bool
debuggerScriptFailedToParseIsModule :: Maybe Bool,
    -- | This script length.
    DebuggerScriptFailedToParse -> Maybe Int
debuggerScriptFailedToParseLength :: Maybe Int,
    -- | JavaScript top stack frame of where the script parsed event was triggered if available.
    DebuggerScriptFailedToParse -> Maybe RuntimeStackTrace
debuggerScriptFailedToParseStackTrace :: Maybe Runtime.RuntimeStackTrace,
    -- | If the scriptLanguage is WebAssembly, the code section offset in the module.
    DebuggerScriptFailedToParse -> Maybe Int
debuggerScriptFailedToParseCodeOffset :: Maybe Int,
    -- | The language of the script.
    DebuggerScriptFailedToParse -> Maybe DebuggerScriptLanguage
debuggerScriptFailedToParseScriptLanguage :: Maybe DebuggerScriptLanguage,
    -- | The name the embedder supplied for this script.
    DebuggerScriptFailedToParse -> Maybe RuntimeScriptId
debuggerScriptFailedToParseEmbedderName :: Maybe T.Text
  }
  deriving (DebuggerScriptFailedToParse -> DebuggerScriptFailedToParse -> Bool
(DebuggerScriptFailedToParse
 -> DebuggerScriptFailedToParse -> Bool)
-> (DebuggerScriptFailedToParse
    -> DebuggerScriptFailedToParse -> Bool)
-> Eq DebuggerScriptFailedToParse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerScriptFailedToParse -> DebuggerScriptFailedToParse -> Bool
$c/= :: DebuggerScriptFailedToParse -> DebuggerScriptFailedToParse -> Bool
== :: DebuggerScriptFailedToParse -> DebuggerScriptFailedToParse -> Bool
$c== :: DebuggerScriptFailedToParse -> DebuggerScriptFailedToParse -> Bool
Eq, Int -> DebuggerScriptFailedToParse -> ShowS
[DebuggerScriptFailedToParse] -> ShowS
DebuggerScriptFailedToParse -> String
(Int -> DebuggerScriptFailedToParse -> ShowS)
-> (DebuggerScriptFailedToParse -> String)
-> ([DebuggerScriptFailedToParse] -> ShowS)
-> Show DebuggerScriptFailedToParse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerScriptFailedToParse] -> ShowS
$cshowList :: [DebuggerScriptFailedToParse] -> ShowS
show :: DebuggerScriptFailedToParse -> String
$cshow :: DebuggerScriptFailedToParse -> String
showsPrec :: Int -> DebuggerScriptFailedToParse -> ShowS
$cshowsPrec :: Int -> DebuggerScriptFailedToParse -> ShowS
Show)
instance FromJSON DebuggerScriptFailedToParse where
  parseJSON :: Value -> Parser DebuggerScriptFailedToParse
parseJSON = String
-> (Object -> Parser DebuggerScriptFailedToParse)
-> Value
-> Parser DebuggerScriptFailedToParse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerScriptFailedToParse" ((Object -> Parser DebuggerScriptFailedToParse)
 -> Value -> Parser DebuggerScriptFailedToParse)
-> (Object -> Parser DebuggerScriptFailedToParse)
-> Value
-> Parser DebuggerScriptFailedToParse
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeScriptId
-> RuntimeScriptId
-> Int
-> Int
-> Int
-> Int
-> Int
-> RuntimeScriptId
-> Maybe [(RuntimeScriptId, RuntimeScriptId)]
-> Maybe RuntimeScriptId
-> Maybe Bool
-> Maybe Bool
-> Maybe Int
-> Maybe RuntimeStackTrace
-> Maybe Int
-> Maybe DebuggerScriptLanguage
-> Maybe RuntimeScriptId
-> DebuggerScriptFailedToParse
DebuggerScriptFailedToParse
    (RuntimeScriptId
 -> RuntimeScriptId
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> RuntimeScriptId
 -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
 -> Maybe RuntimeScriptId
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Int
 -> Maybe RuntimeStackTrace
 -> Maybe Int
 -> Maybe DebuggerScriptLanguage
 -> Maybe RuntimeScriptId
 -> DebuggerScriptFailedToParse)
-> Parser RuntimeScriptId
-> Parser
     (RuntimeScriptId
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> RuntimeScriptId
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId
      -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"scriptId"
    Parser
  (RuntimeScriptId
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> RuntimeScriptId
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId
   -> DebuggerScriptFailedToParse)
-> Parser RuntimeScriptId
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> RuntimeScriptId
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId
      -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"url"
    Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> RuntimeScriptId
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId
   -> DebuggerScriptFailedToParse)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> RuntimeScriptId
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId
      -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"startLine"
    Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> RuntimeScriptId
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId
   -> DebuggerScriptFailedToParse)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> RuntimeScriptId
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId
      -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"startColumn"
    Parser
  (Int
   -> Int
   -> Int
   -> RuntimeScriptId
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId
   -> DebuggerScriptFailedToParse)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> RuntimeScriptId
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId
      -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"endLine"
    Parser
  (Int
   -> Int
   -> RuntimeScriptId
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId
   -> DebuggerScriptFailedToParse)
-> Parser Int
-> Parser
     (Int
      -> RuntimeScriptId
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId
      -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"endColumn"
    Parser
  (Int
   -> RuntimeScriptId
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId
   -> DebuggerScriptFailedToParse)
-> Parser Int
-> Parser
     (RuntimeScriptId
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId
      -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"executionContextId"
    Parser
  (RuntimeScriptId
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId
   -> DebuggerScriptFailedToParse)
-> Parser RuntimeScriptId
-> Parser
     (Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId
      -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"hash"
    Parser
  (Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId
   -> DebuggerScriptFailedToParse)
-> Parser (Maybe [(RuntimeScriptId, RuntimeScriptId)])
-> Parser
     (Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId
      -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> RuntimeScriptId
-> Parser (Maybe [(RuntimeScriptId, RuntimeScriptId)])
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"executionContextAuxData"
    Parser
  (Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId
   -> DebuggerScriptFailedToParse)
-> Parser (Maybe RuntimeScriptId)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId
      -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeScriptId)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"sourceMapURL"
    Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId
   -> DebuggerScriptFailedToParse)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId
      -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe Bool)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"hasSourceURL"
    Parser
  (Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId
   -> DebuggerScriptFailedToParse)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId
      -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe Bool)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"isModule"
    Parser
  (Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId
   -> DebuggerScriptFailedToParse)
-> Parser (Maybe Int)
-> Parser
     (Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId
      -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe Int)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"length"
    Parser
  (Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId
   -> DebuggerScriptFailedToParse)
-> Parser (Maybe RuntimeStackTrace)
-> Parser
     (Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId
      -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeStackTrace)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"stackTrace"
    Parser
  (Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId
   -> DebuggerScriptFailedToParse)
-> Parser (Maybe Int)
-> Parser
     (Maybe DebuggerScriptLanguage
      -> Maybe RuntimeScriptId -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe Int)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"codeOffset"
    Parser
  (Maybe DebuggerScriptLanguage
   -> Maybe RuntimeScriptId -> DebuggerScriptFailedToParse)
-> Parser (Maybe DebuggerScriptLanguage)
-> Parser (Maybe RuntimeScriptId -> DebuggerScriptFailedToParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe DebuggerScriptLanguage)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"scriptLanguage"
    Parser (Maybe RuntimeScriptId -> DebuggerScriptFailedToParse)
-> Parser (Maybe RuntimeScriptId)
-> Parser DebuggerScriptFailedToParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeScriptId)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"embedderName"
instance Event DebuggerScriptFailedToParse where
  eventName :: Proxy DebuggerScriptFailedToParse -> String
eventName Proxy DebuggerScriptFailedToParse
_ = String
"Debugger.scriptFailedToParse"

-- | Type of the 'Debugger.scriptParsed' event.
data DebuggerScriptParsed = DebuggerScriptParsed
  {
    -- | Identifier of the script parsed.
    DebuggerScriptParsed -> RuntimeScriptId
debuggerScriptParsedScriptId :: Runtime.RuntimeScriptId,
    -- | URL or name of the script parsed (if any).
    DebuggerScriptParsed -> RuntimeScriptId
debuggerScriptParsedUrl :: T.Text,
    -- | Line offset of the script within the resource with given URL (for script tags).
    DebuggerScriptParsed -> Int
debuggerScriptParsedStartLine :: Int,
    -- | Column offset of the script within the resource with given URL.
    DebuggerScriptParsed -> Int
debuggerScriptParsedStartColumn :: Int,
    -- | Last line of the script.
    DebuggerScriptParsed -> Int
debuggerScriptParsedEndLine :: Int,
    -- | Length of the last line of the script.
    DebuggerScriptParsed -> Int
debuggerScriptParsedEndColumn :: Int,
    -- | Specifies script creation context.
    DebuggerScriptParsed -> Int
debuggerScriptParsedExecutionContextId :: Runtime.RuntimeExecutionContextId,
    -- | Content hash of the script, SHA-256.
    DebuggerScriptParsed -> RuntimeScriptId
debuggerScriptParsedHash :: T.Text,
    -- | Embedder-specific auxiliary data.
    DebuggerScriptParsed -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
debuggerScriptParsedExecutionContextAuxData :: Maybe [(T.Text, T.Text)],
    -- | True, if this script is generated as a result of the live edit operation.
    DebuggerScriptParsed -> Maybe Bool
debuggerScriptParsedIsLiveEdit :: Maybe Bool,
    -- | URL of source map associated with script (if any).
    DebuggerScriptParsed -> Maybe RuntimeScriptId
debuggerScriptParsedSourceMapURL :: Maybe T.Text,
    -- | True, if this script has sourceURL.
    DebuggerScriptParsed -> Maybe Bool
debuggerScriptParsedHasSourceURL :: Maybe Bool,
    -- | True, if this script is ES6 module.
    DebuggerScriptParsed -> Maybe Bool
debuggerScriptParsedIsModule :: Maybe Bool,
    -- | This script length.
    DebuggerScriptParsed -> Maybe Int
debuggerScriptParsedLength :: Maybe Int,
    -- | JavaScript top stack frame of where the script parsed event was triggered if available.
    DebuggerScriptParsed -> Maybe RuntimeStackTrace
debuggerScriptParsedStackTrace :: Maybe Runtime.RuntimeStackTrace,
    -- | If the scriptLanguage is WebAssembly, the code section offset in the module.
    DebuggerScriptParsed -> Maybe Int
debuggerScriptParsedCodeOffset :: Maybe Int,
    -- | The language of the script.
    DebuggerScriptParsed -> Maybe DebuggerScriptLanguage
debuggerScriptParsedScriptLanguage :: Maybe DebuggerScriptLanguage,
    -- | If the scriptLanguage is WebASsembly, the source of debug symbols for the module.
    DebuggerScriptParsed -> Maybe DebuggerDebugSymbols
debuggerScriptParsedDebugSymbols :: Maybe DebuggerDebugSymbols,
    -- | The name the embedder supplied for this script.
    DebuggerScriptParsed -> Maybe RuntimeScriptId
debuggerScriptParsedEmbedderName :: Maybe T.Text
  }
  deriving (DebuggerScriptParsed -> DebuggerScriptParsed -> Bool
(DebuggerScriptParsed -> DebuggerScriptParsed -> Bool)
-> (DebuggerScriptParsed -> DebuggerScriptParsed -> Bool)
-> Eq DebuggerScriptParsed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerScriptParsed -> DebuggerScriptParsed -> Bool
$c/= :: DebuggerScriptParsed -> DebuggerScriptParsed -> Bool
== :: DebuggerScriptParsed -> DebuggerScriptParsed -> Bool
$c== :: DebuggerScriptParsed -> DebuggerScriptParsed -> Bool
Eq, Int -> DebuggerScriptParsed -> ShowS
[DebuggerScriptParsed] -> ShowS
DebuggerScriptParsed -> String
(Int -> DebuggerScriptParsed -> ShowS)
-> (DebuggerScriptParsed -> String)
-> ([DebuggerScriptParsed] -> ShowS)
-> Show DebuggerScriptParsed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerScriptParsed] -> ShowS
$cshowList :: [DebuggerScriptParsed] -> ShowS
show :: DebuggerScriptParsed -> String
$cshow :: DebuggerScriptParsed -> String
showsPrec :: Int -> DebuggerScriptParsed -> ShowS
$cshowsPrec :: Int -> DebuggerScriptParsed -> ShowS
Show)
instance FromJSON DebuggerScriptParsed where
  parseJSON :: Value -> Parser DebuggerScriptParsed
parseJSON = String
-> (Object -> Parser DebuggerScriptParsed)
-> Value
-> Parser DebuggerScriptParsed
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerScriptParsed" ((Object -> Parser DebuggerScriptParsed)
 -> Value -> Parser DebuggerScriptParsed)
-> (Object -> Parser DebuggerScriptParsed)
-> Value
-> Parser DebuggerScriptParsed
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeScriptId
-> RuntimeScriptId
-> Int
-> Int
-> Int
-> Int
-> Int
-> RuntimeScriptId
-> Maybe [(RuntimeScriptId, RuntimeScriptId)]
-> Maybe Bool
-> Maybe RuntimeScriptId
-> Maybe Bool
-> Maybe Bool
-> Maybe Int
-> Maybe RuntimeStackTrace
-> Maybe Int
-> Maybe DebuggerScriptLanguage
-> Maybe DebuggerDebugSymbols
-> Maybe RuntimeScriptId
-> DebuggerScriptParsed
DebuggerScriptParsed
    (RuntimeScriptId
 -> RuntimeScriptId
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> RuntimeScriptId
 -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
 -> Maybe Bool
 -> Maybe RuntimeScriptId
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Int
 -> Maybe RuntimeStackTrace
 -> Maybe Int
 -> Maybe DebuggerScriptLanguage
 -> Maybe DebuggerDebugSymbols
 -> Maybe RuntimeScriptId
 -> DebuggerScriptParsed)
-> Parser RuntimeScriptId
-> Parser
     (RuntimeScriptId
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> RuntimeScriptId
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe Bool
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"scriptId"
    Parser
  (RuntimeScriptId
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> RuntimeScriptId
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe Bool
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser RuntimeScriptId
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> RuntimeScriptId
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe Bool
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"url"
    Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> RuntimeScriptId
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe Bool
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> RuntimeScriptId
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe Bool
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"startLine"
    Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> RuntimeScriptId
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe Bool
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> RuntimeScriptId
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe Bool
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"startColumn"
    Parser
  (Int
   -> Int
   -> Int
   -> RuntimeScriptId
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe Bool
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> RuntimeScriptId
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe Bool
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"endLine"
    Parser
  (Int
   -> Int
   -> RuntimeScriptId
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe Bool
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser Int
-> Parser
     (Int
      -> RuntimeScriptId
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe Bool
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"endColumn"
    Parser
  (Int
   -> RuntimeScriptId
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe Bool
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser Int
-> Parser
     (RuntimeScriptId
      -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe Bool
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"executionContextId"
    Parser
  (RuntimeScriptId
   -> Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe Bool
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser RuntimeScriptId
-> Parser
     (Maybe [(RuntimeScriptId, RuntimeScriptId)]
      -> Maybe Bool
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"hash"
    Parser
  (Maybe [(RuntimeScriptId, RuntimeScriptId)]
   -> Maybe Bool
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser (Maybe [(RuntimeScriptId, RuntimeScriptId)])
-> Parser
     (Maybe Bool
      -> Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> RuntimeScriptId
-> Parser (Maybe [(RuntimeScriptId, RuntimeScriptId)])
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"executionContextAuxData"
    Parser
  (Maybe Bool
   -> Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser (Maybe Bool)
-> Parser
     (Maybe RuntimeScriptId
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe Bool)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"isLiveEdit"
    Parser
  (Maybe RuntimeScriptId
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser (Maybe RuntimeScriptId)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeScriptId)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"sourceMapURL"
    Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe Bool)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"hasSourceURL"
    Parser
  (Maybe Bool
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe Bool)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"isModule"
    Parser
  (Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser (Maybe Int)
-> Parser
     (Maybe RuntimeStackTrace
      -> Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe Int)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"length"
    Parser
  (Maybe RuntimeStackTrace
   -> Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser (Maybe RuntimeStackTrace)
-> Parser
     (Maybe Int
      -> Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeStackTrace)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"stackTrace"
    Parser
  (Maybe Int
   -> Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser (Maybe Int)
-> Parser
     (Maybe DebuggerScriptLanguage
      -> Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId
      -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe Int)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"codeOffset"
    Parser
  (Maybe DebuggerScriptLanguage
   -> Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId
   -> DebuggerScriptParsed)
-> Parser (Maybe DebuggerScriptLanguage)
-> Parser
     (Maybe DebuggerDebugSymbols
      -> Maybe RuntimeScriptId -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe DebuggerScriptLanguage)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"scriptLanguage"
    Parser
  (Maybe DebuggerDebugSymbols
   -> Maybe RuntimeScriptId -> DebuggerScriptParsed)
-> Parser (Maybe DebuggerDebugSymbols)
-> Parser (Maybe RuntimeScriptId -> DebuggerScriptParsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe DebuggerDebugSymbols)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"debugSymbols"
    Parser (Maybe RuntimeScriptId -> DebuggerScriptParsed)
-> Parser (Maybe RuntimeScriptId) -> Parser DebuggerScriptParsed
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeScriptId)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"embedderName"
instance Event DebuggerScriptParsed where
  eventName :: Proxy DebuggerScriptParsed -> String
eventName Proxy DebuggerScriptParsed
_ = String
"Debugger.scriptParsed"

-- | Continues execution until specific location is reached.

-- | Parameters of the 'Debugger.continueToLocation' command.
data PDebuggerContinueToLocationTargetCallFrames = PDebuggerContinueToLocationTargetCallFramesAny | PDebuggerContinueToLocationTargetCallFramesCurrent
  deriving (Eq PDebuggerContinueToLocationTargetCallFrames
Eq PDebuggerContinueToLocationTargetCallFrames
-> (PDebuggerContinueToLocationTargetCallFrames
    -> PDebuggerContinueToLocationTargetCallFrames -> Ordering)
-> (PDebuggerContinueToLocationTargetCallFrames
    -> PDebuggerContinueToLocationTargetCallFrames -> Bool)
-> (PDebuggerContinueToLocationTargetCallFrames
    -> PDebuggerContinueToLocationTargetCallFrames -> Bool)
-> (PDebuggerContinueToLocationTargetCallFrames
    -> PDebuggerContinueToLocationTargetCallFrames -> Bool)
-> (PDebuggerContinueToLocationTargetCallFrames
    -> PDebuggerContinueToLocationTargetCallFrames -> Bool)
-> (PDebuggerContinueToLocationTargetCallFrames
    -> PDebuggerContinueToLocationTargetCallFrames
    -> PDebuggerContinueToLocationTargetCallFrames)
-> (PDebuggerContinueToLocationTargetCallFrames
    -> PDebuggerContinueToLocationTargetCallFrames
    -> PDebuggerContinueToLocationTargetCallFrames)
-> Ord PDebuggerContinueToLocationTargetCallFrames
PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Bool
PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Ordering
PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames
$cmin :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames
max :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames
$cmax :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames
>= :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Bool
$c>= :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Bool
> :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Bool
$c> :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Bool
<= :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Bool
$c<= :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Bool
< :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Bool
$c< :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Bool
compare :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Ordering
$ccompare :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Ordering
$cp1Ord :: Eq PDebuggerContinueToLocationTargetCallFrames
Ord, PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Bool
(PDebuggerContinueToLocationTargetCallFrames
 -> PDebuggerContinueToLocationTargetCallFrames -> Bool)
-> (PDebuggerContinueToLocationTargetCallFrames
    -> PDebuggerContinueToLocationTargetCallFrames -> Bool)
-> Eq PDebuggerContinueToLocationTargetCallFrames
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Bool
$c/= :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Bool
== :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Bool
$c== :: PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocationTargetCallFrames -> Bool
Eq, Int -> PDebuggerContinueToLocationTargetCallFrames -> ShowS
[PDebuggerContinueToLocationTargetCallFrames] -> ShowS
PDebuggerContinueToLocationTargetCallFrames -> String
(Int -> PDebuggerContinueToLocationTargetCallFrames -> ShowS)
-> (PDebuggerContinueToLocationTargetCallFrames -> String)
-> ([PDebuggerContinueToLocationTargetCallFrames] -> ShowS)
-> Show PDebuggerContinueToLocationTargetCallFrames
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerContinueToLocationTargetCallFrames] -> ShowS
$cshowList :: [PDebuggerContinueToLocationTargetCallFrames] -> ShowS
show :: PDebuggerContinueToLocationTargetCallFrames -> String
$cshow :: PDebuggerContinueToLocationTargetCallFrames -> String
showsPrec :: Int -> PDebuggerContinueToLocationTargetCallFrames -> ShowS
$cshowsPrec :: Int -> PDebuggerContinueToLocationTargetCallFrames -> ShowS
Show, ReadPrec [PDebuggerContinueToLocationTargetCallFrames]
ReadPrec PDebuggerContinueToLocationTargetCallFrames
Int -> ReadS PDebuggerContinueToLocationTargetCallFrames
ReadS [PDebuggerContinueToLocationTargetCallFrames]
(Int -> ReadS PDebuggerContinueToLocationTargetCallFrames)
-> ReadS [PDebuggerContinueToLocationTargetCallFrames]
-> ReadPrec PDebuggerContinueToLocationTargetCallFrames
-> ReadPrec [PDebuggerContinueToLocationTargetCallFrames]
-> Read PDebuggerContinueToLocationTargetCallFrames
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PDebuggerContinueToLocationTargetCallFrames]
$creadListPrec :: ReadPrec [PDebuggerContinueToLocationTargetCallFrames]
readPrec :: ReadPrec PDebuggerContinueToLocationTargetCallFrames
$creadPrec :: ReadPrec PDebuggerContinueToLocationTargetCallFrames
readList :: ReadS [PDebuggerContinueToLocationTargetCallFrames]
$creadList :: ReadS [PDebuggerContinueToLocationTargetCallFrames]
readsPrec :: Int -> ReadS PDebuggerContinueToLocationTargetCallFrames
$creadsPrec :: Int -> ReadS PDebuggerContinueToLocationTargetCallFrames
Read)
instance FromJSON PDebuggerContinueToLocationTargetCallFrames where
  parseJSON :: Value -> Parser PDebuggerContinueToLocationTargetCallFrames
parseJSON = String
-> (RuntimeScriptId
    -> Parser PDebuggerContinueToLocationTargetCallFrames)
-> Value
-> Parser PDebuggerContinueToLocationTargetCallFrames
forall a.
String -> (RuntimeScriptId -> Parser a) -> Value -> Parser a
A.withText String
"PDebuggerContinueToLocationTargetCallFrames" ((RuntimeScriptId
  -> Parser PDebuggerContinueToLocationTargetCallFrames)
 -> Value -> Parser PDebuggerContinueToLocationTargetCallFrames)
-> (RuntimeScriptId
    -> Parser PDebuggerContinueToLocationTargetCallFrames)
-> Value
-> Parser PDebuggerContinueToLocationTargetCallFrames
forall a b. (a -> b) -> a -> b
$ \RuntimeScriptId
v -> case RuntimeScriptId
v of
    RuntimeScriptId
"any" -> PDebuggerContinueToLocationTargetCallFrames
-> Parser PDebuggerContinueToLocationTargetCallFrames
forall (f :: * -> *) a. Applicative f => a -> f a
pure PDebuggerContinueToLocationTargetCallFrames
PDebuggerContinueToLocationTargetCallFramesAny
    RuntimeScriptId
"current" -> PDebuggerContinueToLocationTargetCallFrames
-> Parser PDebuggerContinueToLocationTargetCallFrames
forall (f :: * -> *) a. Applicative f => a -> f a
pure PDebuggerContinueToLocationTargetCallFrames
PDebuggerContinueToLocationTargetCallFramesCurrent
    RuntimeScriptId
"_" -> String -> Parser PDebuggerContinueToLocationTargetCallFrames
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse PDebuggerContinueToLocationTargetCallFrames"
instance ToJSON PDebuggerContinueToLocationTargetCallFrames where
  toJSON :: PDebuggerContinueToLocationTargetCallFrames -> Value
toJSON PDebuggerContinueToLocationTargetCallFrames
v = RuntimeScriptId -> Value
A.String (RuntimeScriptId -> Value) -> RuntimeScriptId -> Value
forall a b. (a -> b) -> a -> b
$ case PDebuggerContinueToLocationTargetCallFrames
v of
    PDebuggerContinueToLocationTargetCallFrames
PDebuggerContinueToLocationTargetCallFramesAny -> RuntimeScriptId
"any"
    PDebuggerContinueToLocationTargetCallFrames
PDebuggerContinueToLocationTargetCallFramesCurrent -> RuntimeScriptId
"current"
data PDebuggerContinueToLocation = PDebuggerContinueToLocation
  {
    -- | Location to continue to.
    PDebuggerContinueToLocation -> DebuggerLocation
pDebuggerContinueToLocationLocation :: DebuggerLocation,
    PDebuggerContinueToLocation
-> Maybe PDebuggerContinueToLocationTargetCallFrames
pDebuggerContinueToLocationTargetCallFrames :: Maybe PDebuggerContinueToLocationTargetCallFrames
  }
  deriving (PDebuggerContinueToLocation -> PDebuggerContinueToLocation -> Bool
(PDebuggerContinueToLocation
 -> PDebuggerContinueToLocation -> Bool)
-> (PDebuggerContinueToLocation
    -> PDebuggerContinueToLocation -> Bool)
-> Eq PDebuggerContinueToLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerContinueToLocation -> PDebuggerContinueToLocation -> Bool
$c/= :: PDebuggerContinueToLocation -> PDebuggerContinueToLocation -> Bool
== :: PDebuggerContinueToLocation -> PDebuggerContinueToLocation -> Bool
$c== :: PDebuggerContinueToLocation -> PDebuggerContinueToLocation -> Bool
Eq, Int -> PDebuggerContinueToLocation -> ShowS
[PDebuggerContinueToLocation] -> ShowS
PDebuggerContinueToLocation -> String
(Int -> PDebuggerContinueToLocation -> ShowS)
-> (PDebuggerContinueToLocation -> String)
-> ([PDebuggerContinueToLocation] -> ShowS)
-> Show PDebuggerContinueToLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerContinueToLocation] -> ShowS
$cshowList :: [PDebuggerContinueToLocation] -> ShowS
show :: PDebuggerContinueToLocation -> String
$cshow :: PDebuggerContinueToLocation -> String
showsPrec :: Int -> PDebuggerContinueToLocation -> ShowS
$cshowsPrec :: Int -> PDebuggerContinueToLocation -> ShowS
Show)
pDebuggerContinueToLocation
  {-
  -- | Location to continue to.
  -}
  :: DebuggerLocation
  -> PDebuggerContinueToLocation
pDebuggerContinueToLocation :: DebuggerLocation -> PDebuggerContinueToLocation
pDebuggerContinueToLocation
  DebuggerLocation
arg_pDebuggerContinueToLocationLocation
  = DebuggerLocation
-> Maybe PDebuggerContinueToLocationTargetCallFrames
-> PDebuggerContinueToLocation
PDebuggerContinueToLocation
    DebuggerLocation
arg_pDebuggerContinueToLocationLocation
    Maybe PDebuggerContinueToLocationTargetCallFrames
forall a. Maybe a
Nothing
instance ToJSON PDebuggerContinueToLocation where
  toJSON :: PDebuggerContinueToLocation -> Value
toJSON PDebuggerContinueToLocation
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"location" RuntimeScriptId -> DebuggerLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (DebuggerLocation -> Pair) -> Maybe DebuggerLocation -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DebuggerLocation -> Maybe DebuggerLocation
forall a. a -> Maybe a
Just (PDebuggerContinueToLocation -> DebuggerLocation
pDebuggerContinueToLocationLocation PDebuggerContinueToLocation
p),
    (RuntimeScriptId
"targetCallFrames" RuntimeScriptId
-> PDebuggerContinueToLocationTargetCallFrames -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (PDebuggerContinueToLocationTargetCallFrames -> Pair)
-> Maybe PDebuggerContinueToLocationTargetCallFrames -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerContinueToLocation
-> Maybe PDebuggerContinueToLocationTargetCallFrames
pDebuggerContinueToLocationTargetCallFrames PDebuggerContinueToLocation
p)
    ]
instance Command PDebuggerContinueToLocation where
  type CommandResponse PDebuggerContinueToLocation = ()
  commandName :: Proxy PDebuggerContinueToLocation -> String
commandName Proxy PDebuggerContinueToLocation
_ = String
"Debugger.continueToLocation"
  fromJSON :: Proxy PDebuggerContinueToLocation
-> Value -> Result (CommandResponse PDebuggerContinueToLocation)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerContinueToLocation -> Result ())
-> Proxy PDebuggerContinueToLocation
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerContinueToLocation -> ())
-> Proxy PDebuggerContinueToLocation
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerContinueToLocation -> ()
forall a b. a -> b -> a
const ()

-- | Disables debugger for given page.

-- | Parameters of the 'Debugger.disable' command.
data PDebuggerDisable = PDebuggerDisable
  deriving (PDebuggerDisable -> PDebuggerDisable -> Bool
(PDebuggerDisable -> PDebuggerDisable -> Bool)
-> (PDebuggerDisable -> PDebuggerDisable -> Bool)
-> Eq PDebuggerDisable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerDisable -> PDebuggerDisable -> Bool
$c/= :: PDebuggerDisable -> PDebuggerDisable -> Bool
== :: PDebuggerDisable -> PDebuggerDisable -> Bool
$c== :: PDebuggerDisable -> PDebuggerDisable -> Bool
Eq, Int -> PDebuggerDisable -> ShowS
[PDebuggerDisable] -> ShowS
PDebuggerDisable -> String
(Int -> PDebuggerDisable -> ShowS)
-> (PDebuggerDisable -> String)
-> ([PDebuggerDisable] -> ShowS)
-> Show PDebuggerDisable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerDisable] -> ShowS
$cshowList :: [PDebuggerDisable] -> ShowS
show :: PDebuggerDisable -> String
$cshow :: PDebuggerDisable -> String
showsPrec :: Int -> PDebuggerDisable -> ShowS
$cshowsPrec :: Int -> PDebuggerDisable -> ShowS
Show)
pDebuggerDisable
  :: PDebuggerDisable
pDebuggerDisable :: PDebuggerDisable
pDebuggerDisable
  = PDebuggerDisable
PDebuggerDisable
instance ToJSON PDebuggerDisable where
  toJSON :: PDebuggerDisable -> Value
toJSON PDebuggerDisable
_ = Value
A.Null
instance Command PDebuggerDisable where
  type CommandResponse PDebuggerDisable = ()
  commandName :: Proxy PDebuggerDisable -> String
commandName Proxy PDebuggerDisable
_ = String
"Debugger.disable"
  fromJSON :: Proxy PDebuggerDisable
-> Value -> Result (CommandResponse PDebuggerDisable)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerDisable -> Result ())
-> Proxy PDebuggerDisable
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerDisable -> ())
-> Proxy PDebuggerDisable
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerDisable -> ()
forall a b. a -> b -> a
const ()

-- | Enables debugger for the given page. Clients should not assume that the debugging has been
--   enabled until the result for this command is received.

-- | Parameters of the 'Debugger.enable' command.
data PDebuggerEnable = PDebuggerEnable
  {
    -- | The maximum size in bytes of collected scripts (not referenced by other heap objects)
    --   the debugger can hold. Puts no limit if parameter is omitted.
    PDebuggerEnable -> Maybe Double
pDebuggerEnableMaxScriptsCacheSize :: Maybe Double
  }
  deriving (PDebuggerEnable -> PDebuggerEnable -> Bool
(PDebuggerEnable -> PDebuggerEnable -> Bool)
-> (PDebuggerEnable -> PDebuggerEnable -> Bool)
-> Eq PDebuggerEnable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerEnable -> PDebuggerEnable -> Bool
$c/= :: PDebuggerEnable -> PDebuggerEnable -> Bool
== :: PDebuggerEnable -> PDebuggerEnable -> Bool
$c== :: PDebuggerEnable -> PDebuggerEnable -> Bool
Eq, Int -> PDebuggerEnable -> ShowS
[PDebuggerEnable] -> ShowS
PDebuggerEnable -> String
(Int -> PDebuggerEnable -> ShowS)
-> (PDebuggerEnable -> String)
-> ([PDebuggerEnable] -> ShowS)
-> Show PDebuggerEnable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerEnable] -> ShowS
$cshowList :: [PDebuggerEnable] -> ShowS
show :: PDebuggerEnable -> String
$cshow :: PDebuggerEnable -> String
showsPrec :: Int -> PDebuggerEnable -> ShowS
$cshowsPrec :: Int -> PDebuggerEnable -> ShowS
Show)
pDebuggerEnable
  :: PDebuggerEnable
pDebuggerEnable :: PDebuggerEnable
pDebuggerEnable
  = Maybe Double -> PDebuggerEnable
PDebuggerEnable
    Maybe Double
forall a. Maybe a
Nothing
instance ToJSON PDebuggerEnable where
  toJSON :: PDebuggerEnable -> Value
toJSON PDebuggerEnable
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"maxScriptsCacheSize" RuntimeScriptId -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerEnable -> Maybe Double
pDebuggerEnableMaxScriptsCacheSize PDebuggerEnable
p)
    ]
data DebuggerEnable = DebuggerEnable
  {
    -- | Unique identifier of the debugger.
    DebuggerEnable -> RuntimeScriptId
debuggerEnableDebuggerId :: Runtime.RuntimeUniqueDebuggerId
  }
  deriving (DebuggerEnable -> DebuggerEnable -> Bool
(DebuggerEnable -> DebuggerEnable -> Bool)
-> (DebuggerEnable -> DebuggerEnable -> Bool) -> Eq DebuggerEnable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerEnable -> DebuggerEnable -> Bool
$c/= :: DebuggerEnable -> DebuggerEnable -> Bool
== :: DebuggerEnable -> DebuggerEnable -> Bool
$c== :: DebuggerEnable -> DebuggerEnable -> Bool
Eq, Int -> DebuggerEnable -> ShowS
[DebuggerEnable] -> ShowS
DebuggerEnable -> String
(Int -> DebuggerEnable -> ShowS)
-> (DebuggerEnable -> String)
-> ([DebuggerEnable] -> ShowS)
-> Show DebuggerEnable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerEnable] -> ShowS
$cshowList :: [DebuggerEnable] -> ShowS
show :: DebuggerEnable -> String
$cshow :: DebuggerEnable -> String
showsPrec :: Int -> DebuggerEnable -> ShowS
$cshowsPrec :: Int -> DebuggerEnable -> ShowS
Show)
instance FromJSON DebuggerEnable where
  parseJSON :: Value -> Parser DebuggerEnable
parseJSON = String
-> (Object -> Parser DebuggerEnable)
-> Value
-> Parser DebuggerEnable
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerEnable" ((Object -> Parser DebuggerEnable)
 -> Value -> Parser DebuggerEnable)
-> (Object -> Parser DebuggerEnable)
-> Value
-> Parser DebuggerEnable
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeScriptId -> DebuggerEnable
DebuggerEnable
    (RuntimeScriptId -> DebuggerEnable)
-> Parser RuntimeScriptId -> Parser DebuggerEnable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"debuggerId"
instance Command PDebuggerEnable where
  type CommandResponse PDebuggerEnable = DebuggerEnable
  commandName :: Proxy PDebuggerEnable -> String
commandName Proxy PDebuggerEnable
_ = String
"Debugger.enable"

-- | Evaluates expression on a given call frame.

-- | Parameters of the 'Debugger.evaluateOnCallFrame' command.
data PDebuggerEvaluateOnCallFrame = PDebuggerEvaluateOnCallFrame
  {
    -- | Call frame identifier to evaluate on.
    PDebuggerEvaluateOnCallFrame -> RuntimeScriptId
pDebuggerEvaluateOnCallFrameCallFrameId :: DebuggerCallFrameId,
    -- | Expression to evaluate.
    PDebuggerEvaluateOnCallFrame -> RuntimeScriptId
pDebuggerEvaluateOnCallFrameExpression :: T.Text,
    -- | String object group name to put result into (allows rapid releasing resulting object handles
    --   using `releaseObjectGroup`).
    PDebuggerEvaluateOnCallFrame -> Maybe RuntimeScriptId
pDebuggerEvaluateOnCallFrameObjectGroup :: Maybe T.Text,
    -- | Specifies whether command line API should be available to the evaluated expression, defaults
    --   to false.
    PDebuggerEvaluateOnCallFrame -> Maybe Bool
pDebuggerEvaluateOnCallFrameIncludeCommandLineAPI :: Maybe Bool,
    -- | In silent mode exceptions thrown during evaluation are not reported and do not pause
    --   execution. Overrides `setPauseOnException` state.
    PDebuggerEvaluateOnCallFrame -> Maybe Bool
pDebuggerEvaluateOnCallFrameSilent :: Maybe Bool,
    -- | Whether the result is expected to be a JSON object that should be sent by value.
    PDebuggerEvaluateOnCallFrame -> Maybe Bool
pDebuggerEvaluateOnCallFrameReturnByValue :: Maybe Bool,
    -- | Whether preview should be generated for the result.
    PDebuggerEvaluateOnCallFrame -> Maybe Bool
pDebuggerEvaluateOnCallFrameGeneratePreview :: Maybe Bool,
    -- | Whether to throw an exception if side effect cannot be ruled out during evaluation.
    PDebuggerEvaluateOnCallFrame -> Maybe Bool
pDebuggerEvaluateOnCallFrameThrowOnSideEffect :: Maybe Bool,
    -- | Terminate execution after timing out (number of milliseconds).
    PDebuggerEvaluateOnCallFrame -> Maybe Double
pDebuggerEvaluateOnCallFrameTimeout :: Maybe Runtime.RuntimeTimeDelta
  }
  deriving (PDebuggerEvaluateOnCallFrame
-> PDebuggerEvaluateOnCallFrame -> Bool
(PDebuggerEvaluateOnCallFrame
 -> PDebuggerEvaluateOnCallFrame -> Bool)
-> (PDebuggerEvaluateOnCallFrame
    -> PDebuggerEvaluateOnCallFrame -> Bool)
-> Eq PDebuggerEvaluateOnCallFrame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerEvaluateOnCallFrame
-> PDebuggerEvaluateOnCallFrame -> Bool
$c/= :: PDebuggerEvaluateOnCallFrame
-> PDebuggerEvaluateOnCallFrame -> Bool
== :: PDebuggerEvaluateOnCallFrame
-> PDebuggerEvaluateOnCallFrame -> Bool
$c== :: PDebuggerEvaluateOnCallFrame
-> PDebuggerEvaluateOnCallFrame -> Bool
Eq, Int -> PDebuggerEvaluateOnCallFrame -> ShowS
[PDebuggerEvaluateOnCallFrame] -> ShowS
PDebuggerEvaluateOnCallFrame -> String
(Int -> PDebuggerEvaluateOnCallFrame -> ShowS)
-> (PDebuggerEvaluateOnCallFrame -> String)
-> ([PDebuggerEvaluateOnCallFrame] -> ShowS)
-> Show PDebuggerEvaluateOnCallFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerEvaluateOnCallFrame] -> ShowS
$cshowList :: [PDebuggerEvaluateOnCallFrame] -> ShowS
show :: PDebuggerEvaluateOnCallFrame -> String
$cshow :: PDebuggerEvaluateOnCallFrame -> String
showsPrec :: Int -> PDebuggerEvaluateOnCallFrame -> ShowS
$cshowsPrec :: Int -> PDebuggerEvaluateOnCallFrame -> ShowS
Show)
pDebuggerEvaluateOnCallFrame
  {-
  -- | Call frame identifier to evaluate on.
  -}
  :: DebuggerCallFrameId
  {-
  -- | Expression to evaluate.
  -}
  -> T.Text
  -> PDebuggerEvaluateOnCallFrame
pDebuggerEvaluateOnCallFrame :: RuntimeScriptId -> RuntimeScriptId -> PDebuggerEvaluateOnCallFrame
pDebuggerEvaluateOnCallFrame
  RuntimeScriptId
arg_pDebuggerEvaluateOnCallFrameCallFrameId
  RuntimeScriptId
arg_pDebuggerEvaluateOnCallFrameExpression
  = RuntimeScriptId
-> RuntimeScriptId
-> Maybe RuntimeScriptId
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Double
-> PDebuggerEvaluateOnCallFrame
PDebuggerEvaluateOnCallFrame
    RuntimeScriptId
arg_pDebuggerEvaluateOnCallFrameCallFrameId
    RuntimeScriptId
arg_pDebuggerEvaluateOnCallFrameExpression
    Maybe RuntimeScriptId
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Double
forall a. Maybe a
Nothing
instance ToJSON PDebuggerEvaluateOnCallFrame where
  toJSON :: PDebuggerEvaluateOnCallFrame -> Value
toJSON PDebuggerEvaluateOnCallFrame
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"callFrameId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerEvaluateOnCallFrame -> RuntimeScriptId
pDebuggerEvaluateOnCallFrameCallFrameId PDebuggerEvaluateOnCallFrame
p),
    (RuntimeScriptId
"expression" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerEvaluateOnCallFrame -> RuntimeScriptId
pDebuggerEvaluateOnCallFrameExpression PDebuggerEvaluateOnCallFrame
p),
    (RuntimeScriptId
"objectGroup" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerEvaluateOnCallFrame -> Maybe RuntimeScriptId
pDebuggerEvaluateOnCallFrameObjectGroup PDebuggerEvaluateOnCallFrame
p),
    (RuntimeScriptId
"includeCommandLineAPI" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerEvaluateOnCallFrame -> Maybe Bool
pDebuggerEvaluateOnCallFrameIncludeCommandLineAPI PDebuggerEvaluateOnCallFrame
p),
    (RuntimeScriptId
"silent" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerEvaluateOnCallFrame -> Maybe Bool
pDebuggerEvaluateOnCallFrameSilent PDebuggerEvaluateOnCallFrame
p),
    (RuntimeScriptId
"returnByValue" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerEvaluateOnCallFrame -> Maybe Bool
pDebuggerEvaluateOnCallFrameReturnByValue PDebuggerEvaluateOnCallFrame
p),
    (RuntimeScriptId
"generatePreview" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerEvaluateOnCallFrame -> Maybe Bool
pDebuggerEvaluateOnCallFrameGeneratePreview PDebuggerEvaluateOnCallFrame
p),
    (RuntimeScriptId
"throwOnSideEffect" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerEvaluateOnCallFrame -> Maybe Bool
pDebuggerEvaluateOnCallFrameThrowOnSideEffect PDebuggerEvaluateOnCallFrame
p),
    (RuntimeScriptId
"timeout" RuntimeScriptId -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerEvaluateOnCallFrame -> Maybe Double
pDebuggerEvaluateOnCallFrameTimeout PDebuggerEvaluateOnCallFrame
p)
    ]
data DebuggerEvaluateOnCallFrame = DebuggerEvaluateOnCallFrame
  {
    -- | Object wrapper for the evaluation result.
    DebuggerEvaluateOnCallFrame -> RuntimeRemoteObject
debuggerEvaluateOnCallFrameResult :: Runtime.RuntimeRemoteObject,
    -- | Exception details.
    DebuggerEvaluateOnCallFrame -> Maybe RuntimeExceptionDetails
debuggerEvaluateOnCallFrameExceptionDetails :: Maybe Runtime.RuntimeExceptionDetails
  }
  deriving (DebuggerEvaluateOnCallFrame -> DebuggerEvaluateOnCallFrame -> Bool
(DebuggerEvaluateOnCallFrame
 -> DebuggerEvaluateOnCallFrame -> Bool)
-> (DebuggerEvaluateOnCallFrame
    -> DebuggerEvaluateOnCallFrame -> Bool)
-> Eq DebuggerEvaluateOnCallFrame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerEvaluateOnCallFrame -> DebuggerEvaluateOnCallFrame -> Bool
$c/= :: DebuggerEvaluateOnCallFrame -> DebuggerEvaluateOnCallFrame -> Bool
== :: DebuggerEvaluateOnCallFrame -> DebuggerEvaluateOnCallFrame -> Bool
$c== :: DebuggerEvaluateOnCallFrame -> DebuggerEvaluateOnCallFrame -> Bool
Eq, Int -> DebuggerEvaluateOnCallFrame -> ShowS
[DebuggerEvaluateOnCallFrame] -> ShowS
DebuggerEvaluateOnCallFrame -> String
(Int -> DebuggerEvaluateOnCallFrame -> ShowS)
-> (DebuggerEvaluateOnCallFrame -> String)
-> ([DebuggerEvaluateOnCallFrame] -> ShowS)
-> Show DebuggerEvaluateOnCallFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerEvaluateOnCallFrame] -> ShowS
$cshowList :: [DebuggerEvaluateOnCallFrame] -> ShowS
show :: DebuggerEvaluateOnCallFrame -> String
$cshow :: DebuggerEvaluateOnCallFrame -> String
showsPrec :: Int -> DebuggerEvaluateOnCallFrame -> ShowS
$cshowsPrec :: Int -> DebuggerEvaluateOnCallFrame -> ShowS
Show)
instance FromJSON DebuggerEvaluateOnCallFrame where
  parseJSON :: Value -> Parser DebuggerEvaluateOnCallFrame
parseJSON = String
-> (Object -> Parser DebuggerEvaluateOnCallFrame)
-> Value
-> Parser DebuggerEvaluateOnCallFrame
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerEvaluateOnCallFrame" ((Object -> Parser DebuggerEvaluateOnCallFrame)
 -> Value -> Parser DebuggerEvaluateOnCallFrame)
-> (Object -> Parser DebuggerEvaluateOnCallFrame)
-> Value
-> Parser DebuggerEvaluateOnCallFrame
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeRemoteObject
-> Maybe RuntimeExceptionDetails -> DebuggerEvaluateOnCallFrame
DebuggerEvaluateOnCallFrame
    (RuntimeRemoteObject
 -> Maybe RuntimeExceptionDetails -> DebuggerEvaluateOnCallFrame)
-> Parser RuntimeRemoteObject
-> Parser
     (Maybe RuntimeExceptionDetails -> DebuggerEvaluateOnCallFrame)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeRemoteObject
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"result"
    Parser
  (Maybe RuntimeExceptionDetails -> DebuggerEvaluateOnCallFrame)
-> Parser (Maybe RuntimeExceptionDetails)
-> Parser DebuggerEvaluateOnCallFrame
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeExceptionDetails)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"exceptionDetails"
instance Command PDebuggerEvaluateOnCallFrame where
  type CommandResponse PDebuggerEvaluateOnCallFrame = DebuggerEvaluateOnCallFrame
  commandName :: Proxy PDebuggerEvaluateOnCallFrame -> String
commandName Proxy PDebuggerEvaluateOnCallFrame
_ = String
"Debugger.evaluateOnCallFrame"

-- | Returns possible locations for breakpoint. scriptId in start and end range locations should be
--   the same.

-- | Parameters of the 'Debugger.getPossibleBreakpoints' command.
data PDebuggerGetPossibleBreakpoints = PDebuggerGetPossibleBreakpoints
  {
    -- | Start of range to search possible breakpoint locations in.
    PDebuggerGetPossibleBreakpoints -> DebuggerLocation
pDebuggerGetPossibleBreakpointsStart :: DebuggerLocation,
    -- | End of range to search possible breakpoint locations in (excluding). When not specified, end
    --   of scripts is used as end of range.
    PDebuggerGetPossibleBreakpoints -> Maybe DebuggerLocation
pDebuggerGetPossibleBreakpointsEnd :: Maybe DebuggerLocation,
    -- | Only consider locations which are in the same (non-nested) function as start.
    PDebuggerGetPossibleBreakpoints -> Maybe Bool
pDebuggerGetPossibleBreakpointsRestrictToFunction :: Maybe Bool
  }
  deriving (PDebuggerGetPossibleBreakpoints
-> PDebuggerGetPossibleBreakpoints -> Bool
(PDebuggerGetPossibleBreakpoints
 -> PDebuggerGetPossibleBreakpoints -> Bool)
-> (PDebuggerGetPossibleBreakpoints
    -> PDebuggerGetPossibleBreakpoints -> Bool)
-> Eq PDebuggerGetPossibleBreakpoints
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerGetPossibleBreakpoints
-> PDebuggerGetPossibleBreakpoints -> Bool
$c/= :: PDebuggerGetPossibleBreakpoints
-> PDebuggerGetPossibleBreakpoints -> Bool
== :: PDebuggerGetPossibleBreakpoints
-> PDebuggerGetPossibleBreakpoints -> Bool
$c== :: PDebuggerGetPossibleBreakpoints
-> PDebuggerGetPossibleBreakpoints -> Bool
Eq, Int -> PDebuggerGetPossibleBreakpoints -> ShowS
[PDebuggerGetPossibleBreakpoints] -> ShowS
PDebuggerGetPossibleBreakpoints -> String
(Int -> PDebuggerGetPossibleBreakpoints -> ShowS)
-> (PDebuggerGetPossibleBreakpoints -> String)
-> ([PDebuggerGetPossibleBreakpoints] -> ShowS)
-> Show PDebuggerGetPossibleBreakpoints
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerGetPossibleBreakpoints] -> ShowS
$cshowList :: [PDebuggerGetPossibleBreakpoints] -> ShowS
show :: PDebuggerGetPossibleBreakpoints -> String
$cshow :: PDebuggerGetPossibleBreakpoints -> String
showsPrec :: Int -> PDebuggerGetPossibleBreakpoints -> ShowS
$cshowsPrec :: Int -> PDebuggerGetPossibleBreakpoints -> ShowS
Show)
pDebuggerGetPossibleBreakpoints
  {-
  -- | Start of range to search possible breakpoint locations in.
  -}
  :: DebuggerLocation
  -> PDebuggerGetPossibleBreakpoints
pDebuggerGetPossibleBreakpoints :: DebuggerLocation -> PDebuggerGetPossibleBreakpoints
pDebuggerGetPossibleBreakpoints
  DebuggerLocation
arg_pDebuggerGetPossibleBreakpointsStart
  = DebuggerLocation
-> Maybe DebuggerLocation
-> Maybe Bool
-> PDebuggerGetPossibleBreakpoints
PDebuggerGetPossibleBreakpoints
    DebuggerLocation
arg_pDebuggerGetPossibleBreakpointsStart
    Maybe DebuggerLocation
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PDebuggerGetPossibleBreakpoints where
  toJSON :: PDebuggerGetPossibleBreakpoints -> Value
toJSON PDebuggerGetPossibleBreakpoints
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"start" RuntimeScriptId -> DebuggerLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (DebuggerLocation -> Pair) -> Maybe DebuggerLocation -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DebuggerLocation -> Maybe DebuggerLocation
forall a. a -> Maybe a
Just (PDebuggerGetPossibleBreakpoints -> DebuggerLocation
pDebuggerGetPossibleBreakpointsStart PDebuggerGetPossibleBreakpoints
p),
    (RuntimeScriptId
"end" RuntimeScriptId -> DebuggerLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (DebuggerLocation -> Pair) -> Maybe DebuggerLocation -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerGetPossibleBreakpoints -> Maybe DebuggerLocation
pDebuggerGetPossibleBreakpointsEnd PDebuggerGetPossibleBreakpoints
p),
    (RuntimeScriptId
"restrictToFunction" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerGetPossibleBreakpoints -> Maybe Bool
pDebuggerGetPossibleBreakpointsRestrictToFunction PDebuggerGetPossibleBreakpoints
p)
    ]
data DebuggerGetPossibleBreakpoints = DebuggerGetPossibleBreakpoints
  {
    -- | List of the possible breakpoint locations.
    DebuggerGetPossibleBreakpoints -> [DebuggerBreakLocation]
debuggerGetPossibleBreakpointsLocations :: [DebuggerBreakLocation]
  }
  deriving (DebuggerGetPossibleBreakpoints
-> DebuggerGetPossibleBreakpoints -> Bool
(DebuggerGetPossibleBreakpoints
 -> DebuggerGetPossibleBreakpoints -> Bool)
-> (DebuggerGetPossibleBreakpoints
    -> DebuggerGetPossibleBreakpoints -> Bool)
-> Eq DebuggerGetPossibleBreakpoints
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerGetPossibleBreakpoints
-> DebuggerGetPossibleBreakpoints -> Bool
$c/= :: DebuggerGetPossibleBreakpoints
-> DebuggerGetPossibleBreakpoints -> Bool
== :: DebuggerGetPossibleBreakpoints
-> DebuggerGetPossibleBreakpoints -> Bool
$c== :: DebuggerGetPossibleBreakpoints
-> DebuggerGetPossibleBreakpoints -> Bool
Eq, Int -> DebuggerGetPossibleBreakpoints -> ShowS
[DebuggerGetPossibleBreakpoints] -> ShowS
DebuggerGetPossibleBreakpoints -> String
(Int -> DebuggerGetPossibleBreakpoints -> ShowS)
-> (DebuggerGetPossibleBreakpoints -> String)
-> ([DebuggerGetPossibleBreakpoints] -> ShowS)
-> Show DebuggerGetPossibleBreakpoints
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerGetPossibleBreakpoints] -> ShowS
$cshowList :: [DebuggerGetPossibleBreakpoints] -> ShowS
show :: DebuggerGetPossibleBreakpoints -> String
$cshow :: DebuggerGetPossibleBreakpoints -> String
showsPrec :: Int -> DebuggerGetPossibleBreakpoints -> ShowS
$cshowsPrec :: Int -> DebuggerGetPossibleBreakpoints -> ShowS
Show)
instance FromJSON DebuggerGetPossibleBreakpoints where
  parseJSON :: Value -> Parser DebuggerGetPossibleBreakpoints
parseJSON = String
-> (Object -> Parser DebuggerGetPossibleBreakpoints)
-> Value
-> Parser DebuggerGetPossibleBreakpoints
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerGetPossibleBreakpoints" ((Object -> Parser DebuggerGetPossibleBreakpoints)
 -> Value -> Parser DebuggerGetPossibleBreakpoints)
-> (Object -> Parser DebuggerGetPossibleBreakpoints)
-> Value
-> Parser DebuggerGetPossibleBreakpoints
forall a b. (a -> b) -> a -> b
$ \Object
o -> [DebuggerBreakLocation] -> DebuggerGetPossibleBreakpoints
DebuggerGetPossibleBreakpoints
    ([DebuggerBreakLocation] -> DebuggerGetPossibleBreakpoints)
-> Parser [DebuggerBreakLocation]
-> Parser DebuggerGetPossibleBreakpoints
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser [DebuggerBreakLocation]
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"locations"
instance Command PDebuggerGetPossibleBreakpoints where
  type CommandResponse PDebuggerGetPossibleBreakpoints = DebuggerGetPossibleBreakpoints
  commandName :: Proxy PDebuggerGetPossibleBreakpoints -> String
commandName Proxy PDebuggerGetPossibleBreakpoints
_ = String
"Debugger.getPossibleBreakpoints"

-- | Returns source for the script with given id.

-- | Parameters of the 'Debugger.getScriptSource' command.
data PDebuggerGetScriptSource = PDebuggerGetScriptSource
  {
    -- | Id of the script to get source for.
    PDebuggerGetScriptSource -> RuntimeScriptId
pDebuggerGetScriptSourceScriptId :: Runtime.RuntimeScriptId
  }
  deriving (PDebuggerGetScriptSource -> PDebuggerGetScriptSource -> Bool
(PDebuggerGetScriptSource -> PDebuggerGetScriptSource -> Bool)
-> (PDebuggerGetScriptSource -> PDebuggerGetScriptSource -> Bool)
-> Eq PDebuggerGetScriptSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerGetScriptSource -> PDebuggerGetScriptSource -> Bool
$c/= :: PDebuggerGetScriptSource -> PDebuggerGetScriptSource -> Bool
== :: PDebuggerGetScriptSource -> PDebuggerGetScriptSource -> Bool
$c== :: PDebuggerGetScriptSource -> PDebuggerGetScriptSource -> Bool
Eq, Int -> PDebuggerGetScriptSource -> ShowS
[PDebuggerGetScriptSource] -> ShowS
PDebuggerGetScriptSource -> String
(Int -> PDebuggerGetScriptSource -> ShowS)
-> (PDebuggerGetScriptSource -> String)
-> ([PDebuggerGetScriptSource] -> ShowS)
-> Show PDebuggerGetScriptSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerGetScriptSource] -> ShowS
$cshowList :: [PDebuggerGetScriptSource] -> ShowS
show :: PDebuggerGetScriptSource -> String
$cshow :: PDebuggerGetScriptSource -> String
showsPrec :: Int -> PDebuggerGetScriptSource -> ShowS
$cshowsPrec :: Int -> PDebuggerGetScriptSource -> ShowS
Show)
pDebuggerGetScriptSource
  {-
  -- | Id of the script to get source for.
  -}
  :: Runtime.RuntimeScriptId
  -> PDebuggerGetScriptSource
pDebuggerGetScriptSource :: RuntimeScriptId -> PDebuggerGetScriptSource
pDebuggerGetScriptSource
  RuntimeScriptId
arg_pDebuggerGetScriptSourceScriptId
  = RuntimeScriptId -> PDebuggerGetScriptSource
PDebuggerGetScriptSource
    RuntimeScriptId
arg_pDebuggerGetScriptSourceScriptId
instance ToJSON PDebuggerGetScriptSource where
  toJSON :: PDebuggerGetScriptSource -> Value
toJSON PDebuggerGetScriptSource
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"scriptId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerGetScriptSource -> RuntimeScriptId
pDebuggerGetScriptSourceScriptId PDebuggerGetScriptSource
p)
    ]
data DebuggerGetScriptSource = DebuggerGetScriptSource
  {
    -- | Script source (empty in case of Wasm bytecode).
    DebuggerGetScriptSource -> RuntimeScriptId
debuggerGetScriptSourceScriptSource :: T.Text,
    -- | Wasm bytecode. (Encoded as a base64 string when passed over JSON)
    DebuggerGetScriptSource -> Maybe RuntimeScriptId
debuggerGetScriptSourceBytecode :: Maybe T.Text
  }
  deriving (DebuggerGetScriptSource -> DebuggerGetScriptSource -> Bool
(DebuggerGetScriptSource -> DebuggerGetScriptSource -> Bool)
-> (DebuggerGetScriptSource -> DebuggerGetScriptSource -> Bool)
-> Eq DebuggerGetScriptSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerGetScriptSource -> DebuggerGetScriptSource -> Bool
$c/= :: DebuggerGetScriptSource -> DebuggerGetScriptSource -> Bool
== :: DebuggerGetScriptSource -> DebuggerGetScriptSource -> Bool
$c== :: DebuggerGetScriptSource -> DebuggerGetScriptSource -> Bool
Eq, Int -> DebuggerGetScriptSource -> ShowS
[DebuggerGetScriptSource] -> ShowS
DebuggerGetScriptSource -> String
(Int -> DebuggerGetScriptSource -> ShowS)
-> (DebuggerGetScriptSource -> String)
-> ([DebuggerGetScriptSource] -> ShowS)
-> Show DebuggerGetScriptSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerGetScriptSource] -> ShowS
$cshowList :: [DebuggerGetScriptSource] -> ShowS
show :: DebuggerGetScriptSource -> String
$cshow :: DebuggerGetScriptSource -> String
showsPrec :: Int -> DebuggerGetScriptSource -> ShowS
$cshowsPrec :: Int -> DebuggerGetScriptSource -> ShowS
Show)
instance FromJSON DebuggerGetScriptSource where
  parseJSON :: Value -> Parser DebuggerGetScriptSource
parseJSON = String
-> (Object -> Parser DebuggerGetScriptSource)
-> Value
-> Parser DebuggerGetScriptSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerGetScriptSource" ((Object -> Parser DebuggerGetScriptSource)
 -> Value -> Parser DebuggerGetScriptSource)
-> (Object -> Parser DebuggerGetScriptSource)
-> Value
-> Parser DebuggerGetScriptSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeScriptId -> Maybe RuntimeScriptId -> DebuggerGetScriptSource
DebuggerGetScriptSource
    (RuntimeScriptId
 -> Maybe RuntimeScriptId -> DebuggerGetScriptSource)
-> Parser RuntimeScriptId
-> Parser (Maybe RuntimeScriptId -> DebuggerGetScriptSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"scriptSource"
    Parser (Maybe RuntimeScriptId -> DebuggerGetScriptSource)
-> Parser (Maybe RuntimeScriptId) -> Parser DebuggerGetScriptSource
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeScriptId)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"bytecode"
instance Command PDebuggerGetScriptSource where
  type CommandResponse PDebuggerGetScriptSource = DebuggerGetScriptSource
  commandName :: Proxy PDebuggerGetScriptSource -> String
commandName Proxy PDebuggerGetScriptSource
_ = String
"Debugger.getScriptSource"


-- | Parameters of the 'Debugger.disassembleWasmModule' command.
data PDebuggerDisassembleWasmModule = PDebuggerDisassembleWasmModule
  {
    -- | Id of the script to disassemble
    PDebuggerDisassembleWasmModule -> RuntimeScriptId
pDebuggerDisassembleWasmModuleScriptId :: Runtime.RuntimeScriptId
  }
  deriving (PDebuggerDisassembleWasmModule
-> PDebuggerDisassembleWasmModule -> Bool
(PDebuggerDisassembleWasmModule
 -> PDebuggerDisassembleWasmModule -> Bool)
-> (PDebuggerDisassembleWasmModule
    -> PDebuggerDisassembleWasmModule -> Bool)
-> Eq PDebuggerDisassembleWasmModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerDisassembleWasmModule
-> PDebuggerDisassembleWasmModule -> Bool
$c/= :: PDebuggerDisassembleWasmModule
-> PDebuggerDisassembleWasmModule -> Bool
== :: PDebuggerDisassembleWasmModule
-> PDebuggerDisassembleWasmModule -> Bool
$c== :: PDebuggerDisassembleWasmModule
-> PDebuggerDisassembleWasmModule -> Bool
Eq, Int -> PDebuggerDisassembleWasmModule -> ShowS
[PDebuggerDisassembleWasmModule] -> ShowS
PDebuggerDisassembleWasmModule -> String
(Int -> PDebuggerDisassembleWasmModule -> ShowS)
-> (PDebuggerDisassembleWasmModule -> String)
-> ([PDebuggerDisassembleWasmModule] -> ShowS)
-> Show PDebuggerDisassembleWasmModule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerDisassembleWasmModule] -> ShowS
$cshowList :: [PDebuggerDisassembleWasmModule] -> ShowS
show :: PDebuggerDisassembleWasmModule -> String
$cshow :: PDebuggerDisassembleWasmModule -> String
showsPrec :: Int -> PDebuggerDisassembleWasmModule -> ShowS
$cshowsPrec :: Int -> PDebuggerDisassembleWasmModule -> ShowS
Show)
pDebuggerDisassembleWasmModule
  {-
  -- | Id of the script to disassemble
  -}
  :: Runtime.RuntimeScriptId
  -> PDebuggerDisassembleWasmModule
pDebuggerDisassembleWasmModule :: RuntimeScriptId -> PDebuggerDisassembleWasmModule
pDebuggerDisassembleWasmModule
  RuntimeScriptId
arg_pDebuggerDisassembleWasmModuleScriptId
  = RuntimeScriptId -> PDebuggerDisassembleWasmModule
PDebuggerDisassembleWasmModule
    RuntimeScriptId
arg_pDebuggerDisassembleWasmModuleScriptId
instance ToJSON PDebuggerDisassembleWasmModule where
  toJSON :: PDebuggerDisassembleWasmModule -> Value
toJSON PDebuggerDisassembleWasmModule
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"scriptId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerDisassembleWasmModule -> RuntimeScriptId
pDebuggerDisassembleWasmModuleScriptId PDebuggerDisassembleWasmModule
p)
    ]
data DebuggerDisassembleWasmModule = DebuggerDisassembleWasmModule
  {
    -- | For large modules, return a stream from which additional chunks of
    --   disassembly can be read successively.
    DebuggerDisassembleWasmModule -> Maybe RuntimeScriptId
debuggerDisassembleWasmModuleStreamId :: Maybe T.Text,
    -- | The total number of lines in the disassembly text.
    DebuggerDisassembleWasmModule -> Int
debuggerDisassembleWasmModuleTotalNumberOfLines :: Int,
    -- | The offsets of all function bodies, in the format [start1, end1,
    --   start2, end2, ...] where all ends are exclusive.
    DebuggerDisassembleWasmModule -> [Int]
debuggerDisassembleWasmModuleFunctionBodyOffsets :: [Int],
    -- | The first chunk of disassembly.
    DebuggerDisassembleWasmModule -> DebuggerWasmDisassemblyChunk
debuggerDisassembleWasmModuleChunk :: DebuggerWasmDisassemblyChunk
  }
  deriving (DebuggerDisassembleWasmModule
-> DebuggerDisassembleWasmModule -> Bool
(DebuggerDisassembleWasmModule
 -> DebuggerDisassembleWasmModule -> Bool)
-> (DebuggerDisassembleWasmModule
    -> DebuggerDisassembleWasmModule -> Bool)
-> Eq DebuggerDisassembleWasmModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerDisassembleWasmModule
-> DebuggerDisassembleWasmModule -> Bool
$c/= :: DebuggerDisassembleWasmModule
-> DebuggerDisassembleWasmModule -> Bool
== :: DebuggerDisassembleWasmModule
-> DebuggerDisassembleWasmModule -> Bool
$c== :: DebuggerDisassembleWasmModule
-> DebuggerDisassembleWasmModule -> Bool
Eq, Int -> DebuggerDisassembleWasmModule -> ShowS
[DebuggerDisassembleWasmModule] -> ShowS
DebuggerDisassembleWasmModule -> String
(Int -> DebuggerDisassembleWasmModule -> ShowS)
-> (DebuggerDisassembleWasmModule -> String)
-> ([DebuggerDisassembleWasmModule] -> ShowS)
-> Show DebuggerDisassembleWasmModule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerDisassembleWasmModule] -> ShowS
$cshowList :: [DebuggerDisassembleWasmModule] -> ShowS
show :: DebuggerDisassembleWasmModule -> String
$cshow :: DebuggerDisassembleWasmModule -> String
showsPrec :: Int -> DebuggerDisassembleWasmModule -> ShowS
$cshowsPrec :: Int -> DebuggerDisassembleWasmModule -> ShowS
Show)
instance FromJSON DebuggerDisassembleWasmModule where
  parseJSON :: Value -> Parser DebuggerDisassembleWasmModule
parseJSON = String
-> (Object -> Parser DebuggerDisassembleWasmModule)
-> Value
-> Parser DebuggerDisassembleWasmModule
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerDisassembleWasmModule" ((Object -> Parser DebuggerDisassembleWasmModule)
 -> Value -> Parser DebuggerDisassembleWasmModule)
-> (Object -> Parser DebuggerDisassembleWasmModule)
-> Value
-> Parser DebuggerDisassembleWasmModule
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe RuntimeScriptId
-> Int
-> [Int]
-> DebuggerWasmDisassemblyChunk
-> DebuggerDisassembleWasmModule
DebuggerDisassembleWasmModule
    (Maybe RuntimeScriptId
 -> Int
 -> [Int]
 -> DebuggerWasmDisassemblyChunk
 -> DebuggerDisassembleWasmModule)
-> Parser (Maybe RuntimeScriptId)
-> Parser
     (Int
      -> [Int]
      -> DebuggerWasmDisassemblyChunk
      -> DebuggerDisassembleWasmModule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeScriptId)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"streamId"
    Parser
  (Int
   -> [Int]
   -> DebuggerWasmDisassemblyChunk
   -> DebuggerDisassembleWasmModule)
-> Parser Int
-> Parser
     ([Int]
      -> DebuggerWasmDisassemblyChunk -> DebuggerDisassembleWasmModule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser Int
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"totalNumberOfLines"
    Parser
  ([Int]
   -> DebuggerWasmDisassemblyChunk -> DebuggerDisassembleWasmModule)
-> Parser [Int]
-> Parser
     (DebuggerWasmDisassemblyChunk -> DebuggerDisassembleWasmModule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser [Int]
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"functionBodyOffsets"
    Parser
  (DebuggerWasmDisassemblyChunk -> DebuggerDisassembleWasmModule)
-> Parser DebuggerWasmDisassemblyChunk
-> Parser DebuggerDisassembleWasmModule
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser DebuggerWasmDisassemblyChunk
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"chunk"
instance Command PDebuggerDisassembleWasmModule where
  type CommandResponse PDebuggerDisassembleWasmModule = DebuggerDisassembleWasmModule
  commandName :: Proxy PDebuggerDisassembleWasmModule -> String
commandName Proxy PDebuggerDisassembleWasmModule
_ = String
"Debugger.disassembleWasmModule"

-- | Disassemble the next chunk of lines for the module corresponding to the
--   stream. If disassembly is complete, this API will invalidate the streamId
--   and return an empty chunk. Any subsequent calls for the now invalid stream
--   will return errors.

-- | Parameters of the 'Debugger.nextWasmDisassemblyChunk' command.
data PDebuggerNextWasmDisassemblyChunk = PDebuggerNextWasmDisassemblyChunk
  {
    PDebuggerNextWasmDisassemblyChunk -> RuntimeScriptId
pDebuggerNextWasmDisassemblyChunkStreamId :: T.Text
  }
  deriving (PDebuggerNextWasmDisassemblyChunk
-> PDebuggerNextWasmDisassemblyChunk -> Bool
(PDebuggerNextWasmDisassemblyChunk
 -> PDebuggerNextWasmDisassemblyChunk -> Bool)
-> (PDebuggerNextWasmDisassemblyChunk
    -> PDebuggerNextWasmDisassemblyChunk -> Bool)
-> Eq PDebuggerNextWasmDisassemblyChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerNextWasmDisassemblyChunk
-> PDebuggerNextWasmDisassemblyChunk -> Bool
$c/= :: PDebuggerNextWasmDisassemblyChunk
-> PDebuggerNextWasmDisassemblyChunk -> Bool
== :: PDebuggerNextWasmDisassemblyChunk
-> PDebuggerNextWasmDisassemblyChunk -> Bool
$c== :: PDebuggerNextWasmDisassemblyChunk
-> PDebuggerNextWasmDisassemblyChunk -> Bool
Eq, Int -> PDebuggerNextWasmDisassemblyChunk -> ShowS
[PDebuggerNextWasmDisassemblyChunk] -> ShowS
PDebuggerNextWasmDisassemblyChunk -> String
(Int -> PDebuggerNextWasmDisassemblyChunk -> ShowS)
-> (PDebuggerNextWasmDisassemblyChunk -> String)
-> ([PDebuggerNextWasmDisassemblyChunk] -> ShowS)
-> Show PDebuggerNextWasmDisassemblyChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerNextWasmDisassemblyChunk] -> ShowS
$cshowList :: [PDebuggerNextWasmDisassemblyChunk] -> ShowS
show :: PDebuggerNextWasmDisassemblyChunk -> String
$cshow :: PDebuggerNextWasmDisassemblyChunk -> String
showsPrec :: Int -> PDebuggerNextWasmDisassemblyChunk -> ShowS
$cshowsPrec :: Int -> PDebuggerNextWasmDisassemblyChunk -> ShowS
Show)
pDebuggerNextWasmDisassemblyChunk
  :: T.Text
  -> PDebuggerNextWasmDisassemblyChunk
pDebuggerNextWasmDisassemblyChunk :: RuntimeScriptId -> PDebuggerNextWasmDisassemblyChunk
pDebuggerNextWasmDisassemblyChunk
  RuntimeScriptId
arg_pDebuggerNextWasmDisassemblyChunkStreamId
  = RuntimeScriptId -> PDebuggerNextWasmDisassemblyChunk
PDebuggerNextWasmDisassemblyChunk
    RuntimeScriptId
arg_pDebuggerNextWasmDisassemblyChunkStreamId
instance ToJSON PDebuggerNextWasmDisassemblyChunk where
  toJSON :: PDebuggerNextWasmDisassemblyChunk -> Value
toJSON PDebuggerNextWasmDisassemblyChunk
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"streamId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerNextWasmDisassemblyChunk -> RuntimeScriptId
pDebuggerNextWasmDisassemblyChunkStreamId PDebuggerNextWasmDisassemblyChunk
p)
    ]
data DebuggerNextWasmDisassemblyChunk = DebuggerNextWasmDisassemblyChunk
  {
    -- | The next chunk of disassembly.
    DebuggerNextWasmDisassemblyChunk -> DebuggerWasmDisassemblyChunk
debuggerNextWasmDisassemblyChunkChunk :: DebuggerWasmDisassemblyChunk
  }
  deriving (DebuggerNextWasmDisassemblyChunk
-> DebuggerNextWasmDisassemblyChunk -> Bool
(DebuggerNextWasmDisassemblyChunk
 -> DebuggerNextWasmDisassemblyChunk -> Bool)
-> (DebuggerNextWasmDisassemblyChunk
    -> DebuggerNextWasmDisassemblyChunk -> Bool)
-> Eq DebuggerNextWasmDisassemblyChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerNextWasmDisassemblyChunk
-> DebuggerNextWasmDisassemblyChunk -> Bool
$c/= :: DebuggerNextWasmDisassemblyChunk
-> DebuggerNextWasmDisassemblyChunk -> Bool
== :: DebuggerNextWasmDisassemblyChunk
-> DebuggerNextWasmDisassemblyChunk -> Bool
$c== :: DebuggerNextWasmDisassemblyChunk
-> DebuggerNextWasmDisassemblyChunk -> Bool
Eq, Int -> DebuggerNextWasmDisassemblyChunk -> ShowS
[DebuggerNextWasmDisassemblyChunk] -> ShowS
DebuggerNextWasmDisassemblyChunk -> String
(Int -> DebuggerNextWasmDisassemblyChunk -> ShowS)
-> (DebuggerNextWasmDisassemblyChunk -> String)
-> ([DebuggerNextWasmDisassemblyChunk] -> ShowS)
-> Show DebuggerNextWasmDisassemblyChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerNextWasmDisassemblyChunk] -> ShowS
$cshowList :: [DebuggerNextWasmDisassemblyChunk] -> ShowS
show :: DebuggerNextWasmDisassemblyChunk -> String
$cshow :: DebuggerNextWasmDisassemblyChunk -> String
showsPrec :: Int -> DebuggerNextWasmDisassemblyChunk -> ShowS
$cshowsPrec :: Int -> DebuggerNextWasmDisassemblyChunk -> ShowS
Show)
instance FromJSON DebuggerNextWasmDisassemblyChunk where
  parseJSON :: Value -> Parser DebuggerNextWasmDisassemblyChunk
parseJSON = String
-> (Object -> Parser DebuggerNextWasmDisassemblyChunk)
-> Value
-> Parser DebuggerNextWasmDisassemblyChunk
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerNextWasmDisassemblyChunk" ((Object -> Parser DebuggerNextWasmDisassemblyChunk)
 -> Value -> Parser DebuggerNextWasmDisassemblyChunk)
-> (Object -> Parser DebuggerNextWasmDisassemblyChunk)
-> Value
-> Parser DebuggerNextWasmDisassemblyChunk
forall a b. (a -> b) -> a -> b
$ \Object
o -> DebuggerWasmDisassemblyChunk -> DebuggerNextWasmDisassemblyChunk
DebuggerNextWasmDisassemblyChunk
    (DebuggerWasmDisassemblyChunk -> DebuggerNextWasmDisassemblyChunk)
-> Parser DebuggerWasmDisassemblyChunk
-> Parser DebuggerNextWasmDisassemblyChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser DebuggerWasmDisassemblyChunk
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"chunk"
instance Command PDebuggerNextWasmDisassemblyChunk where
  type CommandResponse PDebuggerNextWasmDisassemblyChunk = DebuggerNextWasmDisassemblyChunk
  commandName :: Proxy PDebuggerNextWasmDisassemblyChunk -> String
commandName Proxy PDebuggerNextWasmDisassemblyChunk
_ = String
"Debugger.nextWasmDisassemblyChunk"

-- | Returns stack trace with given `stackTraceId`.

-- | Parameters of the 'Debugger.getStackTrace' command.
data PDebuggerGetStackTrace = PDebuggerGetStackTrace
  {
    PDebuggerGetStackTrace -> RuntimeStackTraceId
pDebuggerGetStackTraceStackTraceId :: Runtime.RuntimeStackTraceId
  }
  deriving (PDebuggerGetStackTrace -> PDebuggerGetStackTrace -> Bool
(PDebuggerGetStackTrace -> PDebuggerGetStackTrace -> Bool)
-> (PDebuggerGetStackTrace -> PDebuggerGetStackTrace -> Bool)
-> Eq PDebuggerGetStackTrace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerGetStackTrace -> PDebuggerGetStackTrace -> Bool
$c/= :: PDebuggerGetStackTrace -> PDebuggerGetStackTrace -> Bool
== :: PDebuggerGetStackTrace -> PDebuggerGetStackTrace -> Bool
$c== :: PDebuggerGetStackTrace -> PDebuggerGetStackTrace -> Bool
Eq, Int -> PDebuggerGetStackTrace -> ShowS
[PDebuggerGetStackTrace] -> ShowS
PDebuggerGetStackTrace -> String
(Int -> PDebuggerGetStackTrace -> ShowS)
-> (PDebuggerGetStackTrace -> String)
-> ([PDebuggerGetStackTrace] -> ShowS)
-> Show PDebuggerGetStackTrace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerGetStackTrace] -> ShowS
$cshowList :: [PDebuggerGetStackTrace] -> ShowS
show :: PDebuggerGetStackTrace -> String
$cshow :: PDebuggerGetStackTrace -> String
showsPrec :: Int -> PDebuggerGetStackTrace -> ShowS
$cshowsPrec :: Int -> PDebuggerGetStackTrace -> ShowS
Show)
pDebuggerGetStackTrace
  :: Runtime.RuntimeStackTraceId
  -> PDebuggerGetStackTrace
pDebuggerGetStackTrace :: RuntimeStackTraceId -> PDebuggerGetStackTrace
pDebuggerGetStackTrace
  RuntimeStackTraceId
arg_pDebuggerGetStackTraceStackTraceId
  = RuntimeStackTraceId -> PDebuggerGetStackTrace
PDebuggerGetStackTrace
    RuntimeStackTraceId
arg_pDebuggerGetStackTraceStackTraceId
instance ToJSON PDebuggerGetStackTrace where
  toJSON :: PDebuggerGetStackTrace -> Value
toJSON PDebuggerGetStackTrace
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"stackTraceId" RuntimeScriptId -> RuntimeStackTraceId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeStackTraceId -> Pair)
-> Maybe RuntimeStackTraceId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeStackTraceId -> Maybe RuntimeStackTraceId
forall a. a -> Maybe a
Just (PDebuggerGetStackTrace -> RuntimeStackTraceId
pDebuggerGetStackTraceStackTraceId PDebuggerGetStackTrace
p)
    ]
data DebuggerGetStackTrace = DebuggerGetStackTrace
  {
    DebuggerGetStackTrace -> RuntimeStackTrace
debuggerGetStackTraceStackTrace :: Runtime.RuntimeStackTrace
  }
  deriving (DebuggerGetStackTrace -> DebuggerGetStackTrace -> Bool
(DebuggerGetStackTrace -> DebuggerGetStackTrace -> Bool)
-> (DebuggerGetStackTrace -> DebuggerGetStackTrace -> Bool)
-> Eq DebuggerGetStackTrace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerGetStackTrace -> DebuggerGetStackTrace -> Bool
$c/= :: DebuggerGetStackTrace -> DebuggerGetStackTrace -> Bool
== :: DebuggerGetStackTrace -> DebuggerGetStackTrace -> Bool
$c== :: DebuggerGetStackTrace -> DebuggerGetStackTrace -> Bool
Eq, Int -> DebuggerGetStackTrace -> ShowS
[DebuggerGetStackTrace] -> ShowS
DebuggerGetStackTrace -> String
(Int -> DebuggerGetStackTrace -> ShowS)
-> (DebuggerGetStackTrace -> String)
-> ([DebuggerGetStackTrace] -> ShowS)
-> Show DebuggerGetStackTrace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerGetStackTrace] -> ShowS
$cshowList :: [DebuggerGetStackTrace] -> ShowS
show :: DebuggerGetStackTrace -> String
$cshow :: DebuggerGetStackTrace -> String
showsPrec :: Int -> DebuggerGetStackTrace -> ShowS
$cshowsPrec :: Int -> DebuggerGetStackTrace -> ShowS
Show)
instance FromJSON DebuggerGetStackTrace where
  parseJSON :: Value -> Parser DebuggerGetStackTrace
parseJSON = String
-> (Object -> Parser DebuggerGetStackTrace)
-> Value
-> Parser DebuggerGetStackTrace
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerGetStackTrace" ((Object -> Parser DebuggerGetStackTrace)
 -> Value -> Parser DebuggerGetStackTrace)
-> (Object -> Parser DebuggerGetStackTrace)
-> Value
-> Parser DebuggerGetStackTrace
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeStackTrace -> DebuggerGetStackTrace
DebuggerGetStackTrace
    (RuntimeStackTrace -> DebuggerGetStackTrace)
-> Parser RuntimeStackTrace -> Parser DebuggerGetStackTrace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeStackTrace
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"stackTrace"
instance Command PDebuggerGetStackTrace where
  type CommandResponse PDebuggerGetStackTrace = DebuggerGetStackTrace
  commandName :: Proxy PDebuggerGetStackTrace -> String
commandName Proxy PDebuggerGetStackTrace
_ = String
"Debugger.getStackTrace"

-- | Stops on the next JavaScript statement.

-- | Parameters of the 'Debugger.pause' command.
data PDebuggerPause = PDebuggerPause
  deriving (PDebuggerPause -> PDebuggerPause -> Bool
(PDebuggerPause -> PDebuggerPause -> Bool)
-> (PDebuggerPause -> PDebuggerPause -> Bool) -> Eq PDebuggerPause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerPause -> PDebuggerPause -> Bool
$c/= :: PDebuggerPause -> PDebuggerPause -> Bool
== :: PDebuggerPause -> PDebuggerPause -> Bool
$c== :: PDebuggerPause -> PDebuggerPause -> Bool
Eq, Int -> PDebuggerPause -> ShowS
[PDebuggerPause] -> ShowS
PDebuggerPause -> String
(Int -> PDebuggerPause -> ShowS)
-> (PDebuggerPause -> String)
-> ([PDebuggerPause] -> ShowS)
-> Show PDebuggerPause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerPause] -> ShowS
$cshowList :: [PDebuggerPause] -> ShowS
show :: PDebuggerPause -> String
$cshow :: PDebuggerPause -> String
showsPrec :: Int -> PDebuggerPause -> ShowS
$cshowsPrec :: Int -> PDebuggerPause -> ShowS
Show)
pDebuggerPause
  :: PDebuggerPause
pDebuggerPause :: PDebuggerPause
pDebuggerPause
  = PDebuggerPause
PDebuggerPause
instance ToJSON PDebuggerPause where
  toJSON :: PDebuggerPause -> Value
toJSON PDebuggerPause
_ = Value
A.Null
instance Command PDebuggerPause where
  type CommandResponse PDebuggerPause = ()
  commandName :: Proxy PDebuggerPause -> String
commandName Proxy PDebuggerPause
_ = String
"Debugger.pause"
  fromJSON :: Proxy PDebuggerPause
-> Value -> Result (CommandResponse PDebuggerPause)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerPause -> Result ())
-> Proxy PDebuggerPause
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerPause -> ())
-> Proxy PDebuggerPause
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerPause -> ()
forall a b. a -> b -> a
const ()

-- | Removes JavaScript breakpoint.

-- | Parameters of the 'Debugger.removeBreakpoint' command.
data PDebuggerRemoveBreakpoint = PDebuggerRemoveBreakpoint
  {
    PDebuggerRemoveBreakpoint -> RuntimeScriptId
pDebuggerRemoveBreakpointBreakpointId :: DebuggerBreakpointId
  }
  deriving (PDebuggerRemoveBreakpoint -> PDebuggerRemoveBreakpoint -> Bool
(PDebuggerRemoveBreakpoint -> PDebuggerRemoveBreakpoint -> Bool)
-> (PDebuggerRemoveBreakpoint -> PDebuggerRemoveBreakpoint -> Bool)
-> Eq PDebuggerRemoveBreakpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerRemoveBreakpoint -> PDebuggerRemoveBreakpoint -> Bool
$c/= :: PDebuggerRemoveBreakpoint -> PDebuggerRemoveBreakpoint -> Bool
== :: PDebuggerRemoveBreakpoint -> PDebuggerRemoveBreakpoint -> Bool
$c== :: PDebuggerRemoveBreakpoint -> PDebuggerRemoveBreakpoint -> Bool
Eq, Int -> PDebuggerRemoveBreakpoint -> ShowS
[PDebuggerRemoveBreakpoint] -> ShowS
PDebuggerRemoveBreakpoint -> String
(Int -> PDebuggerRemoveBreakpoint -> ShowS)
-> (PDebuggerRemoveBreakpoint -> String)
-> ([PDebuggerRemoveBreakpoint] -> ShowS)
-> Show PDebuggerRemoveBreakpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerRemoveBreakpoint] -> ShowS
$cshowList :: [PDebuggerRemoveBreakpoint] -> ShowS
show :: PDebuggerRemoveBreakpoint -> String
$cshow :: PDebuggerRemoveBreakpoint -> String
showsPrec :: Int -> PDebuggerRemoveBreakpoint -> ShowS
$cshowsPrec :: Int -> PDebuggerRemoveBreakpoint -> ShowS
Show)
pDebuggerRemoveBreakpoint
  :: DebuggerBreakpointId
  -> PDebuggerRemoveBreakpoint
pDebuggerRemoveBreakpoint :: RuntimeScriptId -> PDebuggerRemoveBreakpoint
pDebuggerRemoveBreakpoint
  RuntimeScriptId
arg_pDebuggerRemoveBreakpointBreakpointId
  = RuntimeScriptId -> PDebuggerRemoveBreakpoint
PDebuggerRemoveBreakpoint
    RuntimeScriptId
arg_pDebuggerRemoveBreakpointBreakpointId
instance ToJSON PDebuggerRemoveBreakpoint where
  toJSON :: PDebuggerRemoveBreakpoint -> Value
toJSON PDebuggerRemoveBreakpoint
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"breakpointId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerRemoveBreakpoint -> RuntimeScriptId
pDebuggerRemoveBreakpointBreakpointId PDebuggerRemoveBreakpoint
p)
    ]
instance Command PDebuggerRemoveBreakpoint where
  type CommandResponse PDebuggerRemoveBreakpoint = ()
  commandName :: Proxy PDebuggerRemoveBreakpoint -> String
commandName Proxy PDebuggerRemoveBreakpoint
_ = String
"Debugger.removeBreakpoint"
  fromJSON :: Proxy PDebuggerRemoveBreakpoint
-> Value -> Result (CommandResponse PDebuggerRemoveBreakpoint)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerRemoveBreakpoint -> Result ())
-> Proxy PDebuggerRemoveBreakpoint
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerRemoveBreakpoint -> ())
-> Proxy PDebuggerRemoveBreakpoint
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerRemoveBreakpoint -> ()
forall a b. a -> b -> a
const ()

-- | Restarts particular call frame from the beginning. The old, deprecated
--   behavior of `restartFrame` is to stay paused and allow further CDP commands
--   after a restart was scheduled. This can cause problems with restarting, so
--   we now continue execution immediatly after it has been scheduled until we
--   reach the beginning of the restarted frame.
--   
--   To stay back-wards compatible, `restartFrame` now expects a `mode`
--   parameter to be present. If the `mode` parameter is missing, `restartFrame`
--   errors out.
--   
--   The various return values are deprecated and `callFrames` is always empty.
--   Use the call frames from the `Debugger#paused` events instead, that fires
--   once V8 pauses at the beginning of the restarted function.

-- | Parameters of the 'Debugger.restartFrame' command.
data PDebuggerRestartFrameMode = PDebuggerRestartFrameModeStepInto
  deriving (Eq PDebuggerRestartFrameMode
Eq PDebuggerRestartFrameMode
-> (PDebuggerRestartFrameMode
    -> PDebuggerRestartFrameMode -> Ordering)
-> (PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool)
-> (PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool)
-> (PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool)
-> (PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool)
-> (PDebuggerRestartFrameMode
    -> PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode)
-> (PDebuggerRestartFrameMode
    -> PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode)
-> Ord PDebuggerRestartFrameMode
PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool
PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Ordering
PDebuggerRestartFrameMode
-> PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PDebuggerRestartFrameMode
-> PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode
$cmin :: PDebuggerRestartFrameMode
-> PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode
max :: PDebuggerRestartFrameMode
-> PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode
$cmax :: PDebuggerRestartFrameMode
-> PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode
>= :: PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool
$c>= :: PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool
> :: PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool
$c> :: PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool
<= :: PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool
$c<= :: PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool
< :: PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool
$c< :: PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool
compare :: PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Ordering
$ccompare :: PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Ordering
$cp1Ord :: Eq PDebuggerRestartFrameMode
Ord, PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool
(PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool)
-> (PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool)
-> Eq PDebuggerRestartFrameMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool
$c/= :: PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool
== :: PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool
$c== :: PDebuggerRestartFrameMode -> PDebuggerRestartFrameMode -> Bool
Eq, Int -> PDebuggerRestartFrameMode -> ShowS
[PDebuggerRestartFrameMode] -> ShowS
PDebuggerRestartFrameMode -> String
(Int -> PDebuggerRestartFrameMode -> ShowS)
-> (PDebuggerRestartFrameMode -> String)
-> ([PDebuggerRestartFrameMode] -> ShowS)
-> Show PDebuggerRestartFrameMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerRestartFrameMode] -> ShowS
$cshowList :: [PDebuggerRestartFrameMode] -> ShowS
show :: PDebuggerRestartFrameMode -> String
$cshow :: PDebuggerRestartFrameMode -> String
showsPrec :: Int -> PDebuggerRestartFrameMode -> ShowS
$cshowsPrec :: Int -> PDebuggerRestartFrameMode -> ShowS
Show, ReadPrec [PDebuggerRestartFrameMode]
ReadPrec PDebuggerRestartFrameMode
Int -> ReadS PDebuggerRestartFrameMode
ReadS [PDebuggerRestartFrameMode]
(Int -> ReadS PDebuggerRestartFrameMode)
-> ReadS [PDebuggerRestartFrameMode]
-> ReadPrec PDebuggerRestartFrameMode
-> ReadPrec [PDebuggerRestartFrameMode]
-> Read PDebuggerRestartFrameMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PDebuggerRestartFrameMode]
$creadListPrec :: ReadPrec [PDebuggerRestartFrameMode]
readPrec :: ReadPrec PDebuggerRestartFrameMode
$creadPrec :: ReadPrec PDebuggerRestartFrameMode
readList :: ReadS [PDebuggerRestartFrameMode]
$creadList :: ReadS [PDebuggerRestartFrameMode]
readsPrec :: Int -> ReadS PDebuggerRestartFrameMode
$creadsPrec :: Int -> ReadS PDebuggerRestartFrameMode
Read)
instance FromJSON PDebuggerRestartFrameMode where
  parseJSON :: Value -> Parser PDebuggerRestartFrameMode
parseJSON = String
-> (RuntimeScriptId -> Parser PDebuggerRestartFrameMode)
-> Value
-> Parser PDebuggerRestartFrameMode
forall a.
String -> (RuntimeScriptId -> Parser a) -> Value -> Parser a
A.withText String
"PDebuggerRestartFrameMode" ((RuntimeScriptId -> Parser PDebuggerRestartFrameMode)
 -> Value -> Parser PDebuggerRestartFrameMode)
-> (RuntimeScriptId -> Parser PDebuggerRestartFrameMode)
-> Value
-> Parser PDebuggerRestartFrameMode
forall a b. (a -> b) -> a -> b
$ \RuntimeScriptId
v -> case RuntimeScriptId
v of
    RuntimeScriptId
"StepInto" -> PDebuggerRestartFrameMode -> Parser PDebuggerRestartFrameMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure PDebuggerRestartFrameMode
PDebuggerRestartFrameModeStepInto
    RuntimeScriptId
"_" -> String -> Parser PDebuggerRestartFrameMode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse PDebuggerRestartFrameMode"
instance ToJSON PDebuggerRestartFrameMode where
  toJSON :: PDebuggerRestartFrameMode -> Value
toJSON PDebuggerRestartFrameMode
v = RuntimeScriptId -> Value
A.String (RuntimeScriptId -> Value) -> RuntimeScriptId -> Value
forall a b. (a -> b) -> a -> b
$ case PDebuggerRestartFrameMode
v of
    PDebuggerRestartFrameMode
PDebuggerRestartFrameModeStepInto -> RuntimeScriptId
"StepInto"
data PDebuggerRestartFrame = PDebuggerRestartFrame
  {
    -- | Call frame identifier to evaluate on.
    PDebuggerRestartFrame -> RuntimeScriptId
pDebuggerRestartFrameCallFrameId :: DebuggerCallFrameId,
    -- | The `mode` parameter must be present and set to 'StepInto', otherwise
    --   `restartFrame` will error out.
    PDebuggerRestartFrame -> Maybe PDebuggerRestartFrameMode
pDebuggerRestartFrameMode :: Maybe PDebuggerRestartFrameMode
  }
  deriving (PDebuggerRestartFrame -> PDebuggerRestartFrame -> Bool
(PDebuggerRestartFrame -> PDebuggerRestartFrame -> Bool)
-> (PDebuggerRestartFrame -> PDebuggerRestartFrame -> Bool)
-> Eq PDebuggerRestartFrame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerRestartFrame -> PDebuggerRestartFrame -> Bool
$c/= :: PDebuggerRestartFrame -> PDebuggerRestartFrame -> Bool
== :: PDebuggerRestartFrame -> PDebuggerRestartFrame -> Bool
$c== :: PDebuggerRestartFrame -> PDebuggerRestartFrame -> Bool
Eq, Int -> PDebuggerRestartFrame -> ShowS
[PDebuggerRestartFrame] -> ShowS
PDebuggerRestartFrame -> String
(Int -> PDebuggerRestartFrame -> ShowS)
-> (PDebuggerRestartFrame -> String)
-> ([PDebuggerRestartFrame] -> ShowS)
-> Show PDebuggerRestartFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerRestartFrame] -> ShowS
$cshowList :: [PDebuggerRestartFrame] -> ShowS
show :: PDebuggerRestartFrame -> String
$cshow :: PDebuggerRestartFrame -> String
showsPrec :: Int -> PDebuggerRestartFrame -> ShowS
$cshowsPrec :: Int -> PDebuggerRestartFrame -> ShowS
Show)
pDebuggerRestartFrame
  {-
  -- | Call frame identifier to evaluate on.
  -}
  :: DebuggerCallFrameId
  -> PDebuggerRestartFrame
pDebuggerRestartFrame :: RuntimeScriptId -> PDebuggerRestartFrame
pDebuggerRestartFrame
  RuntimeScriptId
arg_pDebuggerRestartFrameCallFrameId
  = RuntimeScriptId
-> Maybe PDebuggerRestartFrameMode -> PDebuggerRestartFrame
PDebuggerRestartFrame
    RuntimeScriptId
arg_pDebuggerRestartFrameCallFrameId
    Maybe PDebuggerRestartFrameMode
forall a. Maybe a
Nothing
instance ToJSON PDebuggerRestartFrame where
  toJSON :: PDebuggerRestartFrame -> Value
toJSON PDebuggerRestartFrame
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"callFrameId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerRestartFrame -> RuntimeScriptId
pDebuggerRestartFrameCallFrameId PDebuggerRestartFrame
p),
    (RuntimeScriptId
"mode" RuntimeScriptId -> PDebuggerRestartFrameMode -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (PDebuggerRestartFrameMode -> Pair)
-> Maybe PDebuggerRestartFrameMode -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerRestartFrame -> Maybe PDebuggerRestartFrameMode
pDebuggerRestartFrameMode PDebuggerRestartFrame
p)
    ]
instance Command PDebuggerRestartFrame where
  type CommandResponse PDebuggerRestartFrame = ()
  commandName :: Proxy PDebuggerRestartFrame -> String
commandName Proxy PDebuggerRestartFrame
_ = String
"Debugger.restartFrame"
  fromJSON :: Proxy PDebuggerRestartFrame
-> Value -> Result (CommandResponse PDebuggerRestartFrame)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerRestartFrame -> Result ())
-> Proxy PDebuggerRestartFrame
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerRestartFrame -> ())
-> Proxy PDebuggerRestartFrame
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerRestartFrame -> ()
forall a b. a -> b -> a
const ()

-- | Resumes JavaScript execution.

-- | Parameters of the 'Debugger.resume' command.
data PDebuggerResume = PDebuggerResume
  {
    -- | Set to true to terminate execution upon resuming execution. In contrast
    --   to Runtime.terminateExecution, this will allows to execute further
    --   JavaScript (i.e. via evaluation) until execution of the paused code
    --   is actually resumed, at which point termination is triggered.
    --   If execution is currently not paused, this parameter has no effect.
    PDebuggerResume -> Maybe Bool
pDebuggerResumeTerminateOnResume :: Maybe Bool
  }
  deriving (PDebuggerResume -> PDebuggerResume -> Bool
(PDebuggerResume -> PDebuggerResume -> Bool)
-> (PDebuggerResume -> PDebuggerResume -> Bool)
-> Eq PDebuggerResume
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerResume -> PDebuggerResume -> Bool
$c/= :: PDebuggerResume -> PDebuggerResume -> Bool
== :: PDebuggerResume -> PDebuggerResume -> Bool
$c== :: PDebuggerResume -> PDebuggerResume -> Bool
Eq, Int -> PDebuggerResume -> ShowS
[PDebuggerResume] -> ShowS
PDebuggerResume -> String
(Int -> PDebuggerResume -> ShowS)
-> (PDebuggerResume -> String)
-> ([PDebuggerResume] -> ShowS)
-> Show PDebuggerResume
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerResume] -> ShowS
$cshowList :: [PDebuggerResume] -> ShowS
show :: PDebuggerResume -> String
$cshow :: PDebuggerResume -> String
showsPrec :: Int -> PDebuggerResume -> ShowS
$cshowsPrec :: Int -> PDebuggerResume -> ShowS
Show)
pDebuggerResume
  :: PDebuggerResume
pDebuggerResume :: PDebuggerResume
pDebuggerResume
  = Maybe Bool -> PDebuggerResume
PDebuggerResume
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PDebuggerResume where
  toJSON :: PDebuggerResume -> Value
toJSON PDebuggerResume
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"terminateOnResume" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerResume -> Maybe Bool
pDebuggerResumeTerminateOnResume PDebuggerResume
p)
    ]
instance Command PDebuggerResume where
  type CommandResponse PDebuggerResume = ()
  commandName :: Proxy PDebuggerResume -> String
commandName Proxy PDebuggerResume
_ = String
"Debugger.resume"
  fromJSON :: Proxy PDebuggerResume
-> Value -> Result (CommandResponse PDebuggerResume)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerResume -> Result ())
-> Proxy PDebuggerResume
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerResume -> ())
-> Proxy PDebuggerResume
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerResume -> ()
forall a b. a -> b -> a
const ()

-- | Searches for given string in script content.

-- | Parameters of the 'Debugger.searchInContent' command.
data PDebuggerSearchInContent = PDebuggerSearchInContent
  {
    -- | Id of the script to search in.
    PDebuggerSearchInContent -> RuntimeScriptId
pDebuggerSearchInContentScriptId :: Runtime.RuntimeScriptId,
    -- | String to search for.
    PDebuggerSearchInContent -> RuntimeScriptId
pDebuggerSearchInContentQuery :: T.Text,
    -- | If true, search is case sensitive.
    PDebuggerSearchInContent -> Maybe Bool
pDebuggerSearchInContentCaseSensitive :: Maybe Bool,
    -- | If true, treats string parameter as regex.
    PDebuggerSearchInContent -> Maybe Bool
pDebuggerSearchInContentIsRegex :: Maybe Bool
  }
  deriving (PDebuggerSearchInContent -> PDebuggerSearchInContent -> Bool
(PDebuggerSearchInContent -> PDebuggerSearchInContent -> Bool)
-> (PDebuggerSearchInContent -> PDebuggerSearchInContent -> Bool)
-> Eq PDebuggerSearchInContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSearchInContent -> PDebuggerSearchInContent -> Bool
$c/= :: PDebuggerSearchInContent -> PDebuggerSearchInContent -> Bool
== :: PDebuggerSearchInContent -> PDebuggerSearchInContent -> Bool
$c== :: PDebuggerSearchInContent -> PDebuggerSearchInContent -> Bool
Eq, Int -> PDebuggerSearchInContent -> ShowS
[PDebuggerSearchInContent] -> ShowS
PDebuggerSearchInContent -> String
(Int -> PDebuggerSearchInContent -> ShowS)
-> (PDebuggerSearchInContent -> String)
-> ([PDebuggerSearchInContent] -> ShowS)
-> Show PDebuggerSearchInContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSearchInContent] -> ShowS
$cshowList :: [PDebuggerSearchInContent] -> ShowS
show :: PDebuggerSearchInContent -> String
$cshow :: PDebuggerSearchInContent -> String
showsPrec :: Int -> PDebuggerSearchInContent -> ShowS
$cshowsPrec :: Int -> PDebuggerSearchInContent -> ShowS
Show)
pDebuggerSearchInContent
  {-
  -- | Id of the script to search in.
  -}
  :: Runtime.RuntimeScriptId
  {-
  -- | String to search for.
  -}
  -> T.Text
  -> PDebuggerSearchInContent
pDebuggerSearchInContent :: RuntimeScriptId -> RuntimeScriptId -> PDebuggerSearchInContent
pDebuggerSearchInContent
  RuntimeScriptId
arg_pDebuggerSearchInContentScriptId
  RuntimeScriptId
arg_pDebuggerSearchInContentQuery
  = RuntimeScriptId
-> RuntimeScriptId
-> Maybe Bool
-> Maybe Bool
-> PDebuggerSearchInContent
PDebuggerSearchInContent
    RuntimeScriptId
arg_pDebuggerSearchInContentScriptId
    RuntimeScriptId
arg_pDebuggerSearchInContentQuery
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PDebuggerSearchInContent where
  toJSON :: PDebuggerSearchInContent -> Value
toJSON PDebuggerSearchInContent
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"scriptId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerSearchInContent -> RuntimeScriptId
pDebuggerSearchInContentScriptId PDebuggerSearchInContent
p),
    (RuntimeScriptId
"query" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerSearchInContent -> RuntimeScriptId
pDebuggerSearchInContentQuery PDebuggerSearchInContent
p),
    (RuntimeScriptId
"caseSensitive" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerSearchInContent -> Maybe Bool
pDebuggerSearchInContentCaseSensitive PDebuggerSearchInContent
p),
    (RuntimeScriptId
"isRegex" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerSearchInContent -> Maybe Bool
pDebuggerSearchInContentIsRegex PDebuggerSearchInContent
p)
    ]
data DebuggerSearchInContent = DebuggerSearchInContent
  {
    -- | List of search matches.
    DebuggerSearchInContent -> [DebuggerSearchMatch]
debuggerSearchInContentResult :: [DebuggerSearchMatch]
  }
  deriving (DebuggerSearchInContent -> DebuggerSearchInContent -> Bool
(DebuggerSearchInContent -> DebuggerSearchInContent -> Bool)
-> (DebuggerSearchInContent -> DebuggerSearchInContent -> Bool)
-> Eq DebuggerSearchInContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerSearchInContent -> DebuggerSearchInContent -> Bool
$c/= :: DebuggerSearchInContent -> DebuggerSearchInContent -> Bool
== :: DebuggerSearchInContent -> DebuggerSearchInContent -> Bool
$c== :: DebuggerSearchInContent -> DebuggerSearchInContent -> Bool
Eq, Int -> DebuggerSearchInContent -> ShowS
[DebuggerSearchInContent] -> ShowS
DebuggerSearchInContent -> String
(Int -> DebuggerSearchInContent -> ShowS)
-> (DebuggerSearchInContent -> String)
-> ([DebuggerSearchInContent] -> ShowS)
-> Show DebuggerSearchInContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerSearchInContent] -> ShowS
$cshowList :: [DebuggerSearchInContent] -> ShowS
show :: DebuggerSearchInContent -> String
$cshow :: DebuggerSearchInContent -> String
showsPrec :: Int -> DebuggerSearchInContent -> ShowS
$cshowsPrec :: Int -> DebuggerSearchInContent -> ShowS
Show)
instance FromJSON DebuggerSearchInContent where
  parseJSON :: Value -> Parser DebuggerSearchInContent
parseJSON = String
-> (Object -> Parser DebuggerSearchInContent)
-> Value
-> Parser DebuggerSearchInContent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerSearchInContent" ((Object -> Parser DebuggerSearchInContent)
 -> Value -> Parser DebuggerSearchInContent)
-> (Object -> Parser DebuggerSearchInContent)
-> Value
-> Parser DebuggerSearchInContent
forall a b. (a -> b) -> a -> b
$ \Object
o -> [DebuggerSearchMatch] -> DebuggerSearchInContent
DebuggerSearchInContent
    ([DebuggerSearchMatch] -> DebuggerSearchInContent)
-> Parser [DebuggerSearchMatch] -> Parser DebuggerSearchInContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser [DebuggerSearchMatch]
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"result"
instance Command PDebuggerSearchInContent where
  type CommandResponse PDebuggerSearchInContent = DebuggerSearchInContent
  commandName :: Proxy PDebuggerSearchInContent -> String
commandName Proxy PDebuggerSearchInContent
_ = String
"Debugger.searchInContent"

-- | Enables or disables async call stacks tracking.

-- | Parameters of the 'Debugger.setAsyncCallStackDepth' command.
data PDebuggerSetAsyncCallStackDepth = PDebuggerSetAsyncCallStackDepth
  {
    -- | Maximum depth of async call stacks. Setting to `0` will effectively disable collecting async
    --   call stacks (default).
    PDebuggerSetAsyncCallStackDepth -> Int
pDebuggerSetAsyncCallStackDepthMaxDepth :: Int
  }
  deriving (PDebuggerSetAsyncCallStackDepth
-> PDebuggerSetAsyncCallStackDepth -> Bool
(PDebuggerSetAsyncCallStackDepth
 -> PDebuggerSetAsyncCallStackDepth -> Bool)
-> (PDebuggerSetAsyncCallStackDepth
    -> PDebuggerSetAsyncCallStackDepth -> Bool)
-> Eq PDebuggerSetAsyncCallStackDepth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetAsyncCallStackDepth
-> PDebuggerSetAsyncCallStackDepth -> Bool
$c/= :: PDebuggerSetAsyncCallStackDepth
-> PDebuggerSetAsyncCallStackDepth -> Bool
== :: PDebuggerSetAsyncCallStackDepth
-> PDebuggerSetAsyncCallStackDepth -> Bool
$c== :: PDebuggerSetAsyncCallStackDepth
-> PDebuggerSetAsyncCallStackDepth -> Bool
Eq, Int -> PDebuggerSetAsyncCallStackDepth -> ShowS
[PDebuggerSetAsyncCallStackDepth] -> ShowS
PDebuggerSetAsyncCallStackDepth -> String
(Int -> PDebuggerSetAsyncCallStackDepth -> ShowS)
-> (PDebuggerSetAsyncCallStackDepth -> String)
-> ([PDebuggerSetAsyncCallStackDepth] -> ShowS)
-> Show PDebuggerSetAsyncCallStackDepth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetAsyncCallStackDepth] -> ShowS
$cshowList :: [PDebuggerSetAsyncCallStackDepth] -> ShowS
show :: PDebuggerSetAsyncCallStackDepth -> String
$cshow :: PDebuggerSetAsyncCallStackDepth -> String
showsPrec :: Int -> PDebuggerSetAsyncCallStackDepth -> ShowS
$cshowsPrec :: Int -> PDebuggerSetAsyncCallStackDepth -> ShowS
Show)
pDebuggerSetAsyncCallStackDepth
  {-
  -- | Maximum depth of async call stacks. Setting to `0` will effectively disable collecting async
  --   call stacks (default).
  -}
  :: Int
  -> PDebuggerSetAsyncCallStackDepth
pDebuggerSetAsyncCallStackDepth :: Int -> PDebuggerSetAsyncCallStackDepth
pDebuggerSetAsyncCallStackDepth
  Int
arg_pDebuggerSetAsyncCallStackDepthMaxDepth
  = Int -> PDebuggerSetAsyncCallStackDepth
PDebuggerSetAsyncCallStackDepth
    Int
arg_pDebuggerSetAsyncCallStackDepthMaxDepth
instance ToJSON PDebuggerSetAsyncCallStackDepth where
  toJSON :: PDebuggerSetAsyncCallStackDepth -> Value
toJSON PDebuggerSetAsyncCallStackDepth
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"maxDepth" RuntimeScriptId -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (PDebuggerSetAsyncCallStackDepth -> Int
pDebuggerSetAsyncCallStackDepthMaxDepth PDebuggerSetAsyncCallStackDepth
p)
    ]
instance Command PDebuggerSetAsyncCallStackDepth where
  type CommandResponse PDebuggerSetAsyncCallStackDepth = ()
  commandName :: Proxy PDebuggerSetAsyncCallStackDepth -> String
commandName Proxy PDebuggerSetAsyncCallStackDepth
_ = String
"Debugger.setAsyncCallStackDepth"
  fromJSON :: Proxy PDebuggerSetAsyncCallStackDepth
-> Value
-> Result (CommandResponse PDebuggerSetAsyncCallStackDepth)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerSetAsyncCallStackDepth -> Result ())
-> Proxy PDebuggerSetAsyncCallStackDepth
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerSetAsyncCallStackDepth -> ())
-> Proxy PDebuggerSetAsyncCallStackDepth
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerSetAsyncCallStackDepth -> ()
forall a b. a -> b -> a
const ()

-- | Replace previous blackbox patterns with passed ones. Forces backend to skip stepping/pausing in
--   scripts with url matching one of the patterns. VM will try to leave blackboxed script by
--   performing 'step in' several times, finally resorting to 'step out' if unsuccessful.

-- | Parameters of the 'Debugger.setBlackboxPatterns' command.
data PDebuggerSetBlackboxPatterns = PDebuggerSetBlackboxPatterns
  {
    -- | Array of regexps that will be used to check script url for blackbox state.
    PDebuggerSetBlackboxPatterns -> [RuntimeScriptId]
pDebuggerSetBlackboxPatternsPatterns :: [T.Text]
  }
  deriving (PDebuggerSetBlackboxPatterns
-> PDebuggerSetBlackboxPatterns -> Bool
(PDebuggerSetBlackboxPatterns
 -> PDebuggerSetBlackboxPatterns -> Bool)
-> (PDebuggerSetBlackboxPatterns
    -> PDebuggerSetBlackboxPatterns -> Bool)
-> Eq PDebuggerSetBlackboxPatterns
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetBlackboxPatterns
-> PDebuggerSetBlackboxPatterns -> Bool
$c/= :: PDebuggerSetBlackboxPatterns
-> PDebuggerSetBlackboxPatterns -> Bool
== :: PDebuggerSetBlackboxPatterns
-> PDebuggerSetBlackboxPatterns -> Bool
$c== :: PDebuggerSetBlackboxPatterns
-> PDebuggerSetBlackboxPatterns -> Bool
Eq, Int -> PDebuggerSetBlackboxPatterns -> ShowS
[PDebuggerSetBlackboxPatterns] -> ShowS
PDebuggerSetBlackboxPatterns -> String
(Int -> PDebuggerSetBlackboxPatterns -> ShowS)
-> (PDebuggerSetBlackboxPatterns -> String)
-> ([PDebuggerSetBlackboxPatterns] -> ShowS)
-> Show PDebuggerSetBlackboxPatterns
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetBlackboxPatterns] -> ShowS
$cshowList :: [PDebuggerSetBlackboxPatterns] -> ShowS
show :: PDebuggerSetBlackboxPatterns -> String
$cshow :: PDebuggerSetBlackboxPatterns -> String
showsPrec :: Int -> PDebuggerSetBlackboxPatterns -> ShowS
$cshowsPrec :: Int -> PDebuggerSetBlackboxPatterns -> ShowS
Show)
pDebuggerSetBlackboxPatterns
  {-
  -- | Array of regexps that will be used to check script url for blackbox state.
  -}
  :: [T.Text]
  -> PDebuggerSetBlackboxPatterns
pDebuggerSetBlackboxPatterns :: [RuntimeScriptId] -> PDebuggerSetBlackboxPatterns
pDebuggerSetBlackboxPatterns
  [RuntimeScriptId]
arg_pDebuggerSetBlackboxPatternsPatterns
  = [RuntimeScriptId] -> PDebuggerSetBlackboxPatterns
PDebuggerSetBlackboxPatterns
    [RuntimeScriptId]
arg_pDebuggerSetBlackboxPatternsPatterns
instance ToJSON PDebuggerSetBlackboxPatterns where
  toJSON :: PDebuggerSetBlackboxPatterns -> Value
toJSON PDebuggerSetBlackboxPatterns
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"patterns" RuntimeScriptId -> [RuntimeScriptId] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) ([RuntimeScriptId] -> Pair)
-> Maybe [RuntimeScriptId] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RuntimeScriptId] -> Maybe [RuntimeScriptId]
forall a. a -> Maybe a
Just (PDebuggerSetBlackboxPatterns -> [RuntimeScriptId]
pDebuggerSetBlackboxPatternsPatterns PDebuggerSetBlackboxPatterns
p)
    ]
instance Command PDebuggerSetBlackboxPatterns where
  type CommandResponse PDebuggerSetBlackboxPatterns = ()
  commandName :: Proxy PDebuggerSetBlackboxPatterns -> String
commandName Proxy PDebuggerSetBlackboxPatterns
_ = String
"Debugger.setBlackboxPatterns"
  fromJSON :: Proxy PDebuggerSetBlackboxPatterns
-> Value -> Result (CommandResponse PDebuggerSetBlackboxPatterns)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerSetBlackboxPatterns -> Result ())
-> Proxy PDebuggerSetBlackboxPatterns
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerSetBlackboxPatterns -> ())
-> Proxy PDebuggerSetBlackboxPatterns
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerSetBlackboxPatterns -> ()
forall a b. a -> b -> a
const ()

-- | Makes backend skip steps in the script in blackboxed ranges. VM will try leave blacklisted
--   scripts by performing 'step in' several times, finally resorting to 'step out' if unsuccessful.
--   Positions array contains positions where blackbox state is changed. First interval isn't
--   blackboxed. Array should be sorted.

-- | Parameters of the 'Debugger.setBlackboxedRanges' command.
data PDebuggerSetBlackboxedRanges = PDebuggerSetBlackboxedRanges
  {
    -- | Id of the script.
    PDebuggerSetBlackboxedRanges -> RuntimeScriptId
pDebuggerSetBlackboxedRangesScriptId :: Runtime.RuntimeScriptId,
    PDebuggerSetBlackboxedRanges -> [DebuggerScriptPosition]
pDebuggerSetBlackboxedRangesPositions :: [DebuggerScriptPosition]
  }
  deriving (PDebuggerSetBlackboxedRanges
-> PDebuggerSetBlackboxedRanges -> Bool
(PDebuggerSetBlackboxedRanges
 -> PDebuggerSetBlackboxedRanges -> Bool)
-> (PDebuggerSetBlackboxedRanges
    -> PDebuggerSetBlackboxedRanges -> Bool)
-> Eq PDebuggerSetBlackboxedRanges
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetBlackboxedRanges
-> PDebuggerSetBlackboxedRanges -> Bool
$c/= :: PDebuggerSetBlackboxedRanges
-> PDebuggerSetBlackboxedRanges -> Bool
== :: PDebuggerSetBlackboxedRanges
-> PDebuggerSetBlackboxedRanges -> Bool
$c== :: PDebuggerSetBlackboxedRanges
-> PDebuggerSetBlackboxedRanges -> Bool
Eq, Int -> PDebuggerSetBlackboxedRanges -> ShowS
[PDebuggerSetBlackboxedRanges] -> ShowS
PDebuggerSetBlackboxedRanges -> String
(Int -> PDebuggerSetBlackboxedRanges -> ShowS)
-> (PDebuggerSetBlackboxedRanges -> String)
-> ([PDebuggerSetBlackboxedRanges] -> ShowS)
-> Show PDebuggerSetBlackboxedRanges
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetBlackboxedRanges] -> ShowS
$cshowList :: [PDebuggerSetBlackboxedRanges] -> ShowS
show :: PDebuggerSetBlackboxedRanges -> String
$cshow :: PDebuggerSetBlackboxedRanges -> String
showsPrec :: Int -> PDebuggerSetBlackboxedRanges -> ShowS
$cshowsPrec :: Int -> PDebuggerSetBlackboxedRanges -> ShowS
Show)
pDebuggerSetBlackboxedRanges
  {-
  -- | Id of the script.
  -}
  :: Runtime.RuntimeScriptId
  -> [DebuggerScriptPosition]
  -> PDebuggerSetBlackboxedRanges
pDebuggerSetBlackboxedRanges :: RuntimeScriptId
-> [DebuggerScriptPosition] -> PDebuggerSetBlackboxedRanges
pDebuggerSetBlackboxedRanges
  RuntimeScriptId
arg_pDebuggerSetBlackboxedRangesScriptId
  [DebuggerScriptPosition]
arg_pDebuggerSetBlackboxedRangesPositions
  = RuntimeScriptId
-> [DebuggerScriptPosition] -> PDebuggerSetBlackboxedRanges
PDebuggerSetBlackboxedRanges
    RuntimeScriptId
arg_pDebuggerSetBlackboxedRangesScriptId
    [DebuggerScriptPosition]
arg_pDebuggerSetBlackboxedRangesPositions
instance ToJSON PDebuggerSetBlackboxedRanges where
  toJSON :: PDebuggerSetBlackboxedRanges -> Value
toJSON PDebuggerSetBlackboxedRanges
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"scriptId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerSetBlackboxedRanges -> RuntimeScriptId
pDebuggerSetBlackboxedRangesScriptId PDebuggerSetBlackboxedRanges
p),
    (RuntimeScriptId
"positions" RuntimeScriptId -> [DebuggerScriptPosition] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) ([DebuggerScriptPosition] -> Pair)
-> Maybe [DebuggerScriptPosition] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DebuggerScriptPosition] -> Maybe [DebuggerScriptPosition]
forall a. a -> Maybe a
Just (PDebuggerSetBlackboxedRanges -> [DebuggerScriptPosition]
pDebuggerSetBlackboxedRangesPositions PDebuggerSetBlackboxedRanges
p)
    ]
instance Command PDebuggerSetBlackboxedRanges where
  type CommandResponse PDebuggerSetBlackboxedRanges = ()
  commandName :: Proxy PDebuggerSetBlackboxedRanges -> String
commandName Proxy PDebuggerSetBlackboxedRanges
_ = String
"Debugger.setBlackboxedRanges"
  fromJSON :: Proxy PDebuggerSetBlackboxedRanges
-> Value -> Result (CommandResponse PDebuggerSetBlackboxedRanges)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerSetBlackboxedRanges -> Result ())
-> Proxy PDebuggerSetBlackboxedRanges
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerSetBlackboxedRanges -> ())
-> Proxy PDebuggerSetBlackboxedRanges
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerSetBlackboxedRanges -> ()
forall a b. a -> b -> a
const ()

-- | Sets JavaScript breakpoint at a given location.

-- | Parameters of the 'Debugger.setBreakpoint' command.
data PDebuggerSetBreakpoint = PDebuggerSetBreakpoint
  {
    -- | Location to set breakpoint in.
    PDebuggerSetBreakpoint -> DebuggerLocation
pDebuggerSetBreakpointLocation :: DebuggerLocation,
    -- | Expression to use as a breakpoint condition. When specified, debugger will only stop on the
    --   breakpoint if this expression evaluates to true.
    PDebuggerSetBreakpoint -> Maybe RuntimeScriptId
pDebuggerSetBreakpointCondition :: Maybe T.Text
  }
  deriving (PDebuggerSetBreakpoint -> PDebuggerSetBreakpoint -> Bool
(PDebuggerSetBreakpoint -> PDebuggerSetBreakpoint -> Bool)
-> (PDebuggerSetBreakpoint -> PDebuggerSetBreakpoint -> Bool)
-> Eq PDebuggerSetBreakpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetBreakpoint -> PDebuggerSetBreakpoint -> Bool
$c/= :: PDebuggerSetBreakpoint -> PDebuggerSetBreakpoint -> Bool
== :: PDebuggerSetBreakpoint -> PDebuggerSetBreakpoint -> Bool
$c== :: PDebuggerSetBreakpoint -> PDebuggerSetBreakpoint -> Bool
Eq, Int -> PDebuggerSetBreakpoint -> ShowS
[PDebuggerSetBreakpoint] -> ShowS
PDebuggerSetBreakpoint -> String
(Int -> PDebuggerSetBreakpoint -> ShowS)
-> (PDebuggerSetBreakpoint -> String)
-> ([PDebuggerSetBreakpoint] -> ShowS)
-> Show PDebuggerSetBreakpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetBreakpoint] -> ShowS
$cshowList :: [PDebuggerSetBreakpoint] -> ShowS
show :: PDebuggerSetBreakpoint -> String
$cshow :: PDebuggerSetBreakpoint -> String
showsPrec :: Int -> PDebuggerSetBreakpoint -> ShowS
$cshowsPrec :: Int -> PDebuggerSetBreakpoint -> ShowS
Show)
pDebuggerSetBreakpoint
  {-
  -- | Location to set breakpoint in.
  -}
  :: DebuggerLocation
  -> PDebuggerSetBreakpoint
pDebuggerSetBreakpoint :: DebuggerLocation -> PDebuggerSetBreakpoint
pDebuggerSetBreakpoint
  DebuggerLocation
arg_pDebuggerSetBreakpointLocation
  = DebuggerLocation -> Maybe RuntimeScriptId -> PDebuggerSetBreakpoint
PDebuggerSetBreakpoint
    DebuggerLocation
arg_pDebuggerSetBreakpointLocation
    Maybe RuntimeScriptId
forall a. Maybe a
Nothing
instance ToJSON PDebuggerSetBreakpoint where
  toJSON :: PDebuggerSetBreakpoint -> Value
toJSON PDebuggerSetBreakpoint
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"location" RuntimeScriptId -> DebuggerLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (DebuggerLocation -> Pair) -> Maybe DebuggerLocation -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DebuggerLocation -> Maybe DebuggerLocation
forall a. a -> Maybe a
Just (PDebuggerSetBreakpoint -> DebuggerLocation
pDebuggerSetBreakpointLocation PDebuggerSetBreakpoint
p),
    (RuntimeScriptId
"condition" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerSetBreakpoint -> Maybe RuntimeScriptId
pDebuggerSetBreakpointCondition PDebuggerSetBreakpoint
p)
    ]
data DebuggerSetBreakpoint = DebuggerSetBreakpoint
  {
    -- | Id of the created breakpoint for further reference.
    DebuggerSetBreakpoint -> RuntimeScriptId
debuggerSetBreakpointBreakpointId :: DebuggerBreakpointId,
    -- | Location this breakpoint resolved into.
    DebuggerSetBreakpoint -> DebuggerLocation
debuggerSetBreakpointActualLocation :: DebuggerLocation
  }
  deriving (DebuggerSetBreakpoint -> DebuggerSetBreakpoint -> Bool
(DebuggerSetBreakpoint -> DebuggerSetBreakpoint -> Bool)
-> (DebuggerSetBreakpoint -> DebuggerSetBreakpoint -> Bool)
-> Eq DebuggerSetBreakpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerSetBreakpoint -> DebuggerSetBreakpoint -> Bool
$c/= :: DebuggerSetBreakpoint -> DebuggerSetBreakpoint -> Bool
== :: DebuggerSetBreakpoint -> DebuggerSetBreakpoint -> Bool
$c== :: DebuggerSetBreakpoint -> DebuggerSetBreakpoint -> Bool
Eq, Int -> DebuggerSetBreakpoint -> ShowS
[DebuggerSetBreakpoint] -> ShowS
DebuggerSetBreakpoint -> String
(Int -> DebuggerSetBreakpoint -> ShowS)
-> (DebuggerSetBreakpoint -> String)
-> ([DebuggerSetBreakpoint] -> ShowS)
-> Show DebuggerSetBreakpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerSetBreakpoint] -> ShowS
$cshowList :: [DebuggerSetBreakpoint] -> ShowS
show :: DebuggerSetBreakpoint -> String
$cshow :: DebuggerSetBreakpoint -> String
showsPrec :: Int -> DebuggerSetBreakpoint -> ShowS
$cshowsPrec :: Int -> DebuggerSetBreakpoint -> ShowS
Show)
instance FromJSON DebuggerSetBreakpoint where
  parseJSON :: Value -> Parser DebuggerSetBreakpoint
parseJSON = String
-> (Object -> Parser DebuggerSetBreakpoint)
-> Value
-> Parser DebuggerSetBreakpoint
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerSetBreakpoint" ((Object -> Parser DebuggerSetBreakpoint)
 -> Value -> Parser DebuggerSetBreakpoint)
-> (Object -> Parser DebuggerSetBreakpoint)
-> Value
-> Parser DebuggerSetBreakpoint
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeScriptId -> DebuggerLocation -> DebuggerSetBreakpoint
DebuggerSetBreakpoint
    (RuntimeScriptId -> DebuggerLocation -> DebuggerSetBreakpoint)
-> Parser RuntimeScriptId
-> Parser (DebuggerLocation -> DebuggerSetBreakpoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"breakpointId"
    Parser (DebuggerLocation -> DebuggerSetBreakpoint)
-> Parser DebuggerLocation -> Parser DebuggerSetBreakpoint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser DebuggerLocation
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"actualLocation"
instance Command PDebuggerSetBreakpoint where
  type CommandResponse PDebuggerSetBreakpoint = DebuggerSetBreakpoint
  commandName :: Proxy PDebuggerSetBreakpoint -> String
commandName Proxy PDebuggerSetBreakpoint
_ = String
"Debugger.setBreakpoint"

-- | Sets instrumentation breakpoint.

-- | Parameters of the 'Debugger.setInstrumentationBreakpoint' command.
data PDebuggerSetInstrumentationBreakpointInstrumentation = PDebuggerSetInstrumentationBreakpointInstrumentationBeforeScriptExecution | PDebuggerSetInstrumentationBreakpointInstrumentationBeforeScriptWithSourceMapExecution
  deriving (Eq PDebuggerSetInstrumentationBreakpointInstrumentation
Eq PDebuggerSetInstrumentationBreakpointInstrumentation
-> (PDebuggerSetInstrumentationBreakpointInstrumentation
    -> PDebuggerSetInstrumentationBreakpointInstrumentation
    -> Ordering)
-> (PDebuggerSetInstrumentationBreakpointInstrumentation
    -> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool)
-> (PDebuggerSetInstrumentationBreakpointInstrumentation
    -> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool)
-> (PDebuggerSetInstrumentationBreakpointInstrumentation
    -> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool)
-> (PDebuggerSetInstrumentationBreakpointInstrumentation
    -> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool)
-> (PDebuggerSetInstrumentationBreakpointInstrumentation
    -> PDebuggerSetInstrumentationBreakpointInstrumentation
    -> PDebuggerSetInstrumentationBreakpointInstrumentation)
-> (PDebuggerSetInstrumentationBreakpointInstrumentation
    -> PDebuggerSetInstrumentationBreakpointInstrumentation
    -> PDebuggerSetInstrumentationBreakpointInstrumentation)
-> Ord PDebuggerSetInstrumentationBreakpointInstrumentation
PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool
PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Ordering
PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation
$cmin :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation
max :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation
$cmax :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation
>= :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool
$c>= :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool
> :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool
$c> :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool
<= :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool
$c<= :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool
< :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool
$c< :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool
compare :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Ordering
$ccompare :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Ordering
$cp1Ord :: Eq PDebuggerSetInstrumentationBreakpointInstrumentation
Ord, PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool
(PDebuggerSetInstrumentationBreakpointInstrumentation
 -> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool)
-> (PDebuggerSetInstrumentationBreakpointInstrumentation
    -> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool)
-> Eq PDebuggerSetInstrumentationBreakpointInstrumentation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool
$c/= :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool
== :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool
$c== :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Bool
Eq, Int
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> ShowS
[PDebuggerSetInstrumentationBreakpointInstrumentation] -> ShowS
PDebuggerSetInstrumentationBreakpointInstrumentation -> String
(Int
 -> PDebuggerSetInstrumentationBreakpointInstrumentation -> ShowS)
-> (PDebuggerSetInstrumentationBreakpointInstrumentation -> String)
-> ([PDebuggerSetInstrumentationBreakpointInstrumentation]
    -> ShowS)
-> Show PDebuggerSetInstrumentationBreakpointInstrumentation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetInstrumentationBreakpointInstrumentation] -> ShowS
$cshowList :: [PDebuggerSetInstrumentationBreakpointInstrumentation] -> ShowS
show :: PDebuggerSetInstrumentationBreakpointInstrumentation -> String
$cshow :: PDebuggerSetInstrumentationBreakpointInstrumentation -> String
showsPrec :: Int
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> ShowS
$cshowsPrec :: Int
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> ShowS
Show, ReadPrec [PDebuggerSetInstrumentationBreakpointInstrumentation]
ReadPrec PDebuggerSetInstrumentationBreakpointInstrumentation
Int -> ReadS PDebuggerSetInstrumentationBreakpointInstrumentation
ReadS [PDebuggerSetInstrumentationBreakpointInstrumentation]
(Int -> ReadS PDebuggerSetInstrumentationBreakpointInstrumentation)
-> ReadS [PDebuggerSetInstrumentationBreakpointInstrumentation]
-> ReadPrec PDebuggerSetInstrumentationBreakpointInstrumentation
-> ReadPrec [PDebuggerSetInstrumentationBreakpointInstrumentation]
-> Read PDebuggerSetInstrumentationBreakpointInstrumentation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PDebuggerSetInstrumentationBreakpointInstrumentation]
$creadListPrec :: ReadPrec [PDebuggerSetInstrumentationBreakpointInstrumentation]
readPrec :: ReadPrec PDebuggerSetInstrumentationBreakpointInstrumentation
$creadPrec :: ReadPrec PDebuggerSetInstrumentationBreakpointInstrumentation
readList :: ReadS [PDebuggerSetInstrumentationBreakpointInstrumentation]
$creadList :: ReadS [PDebuggerSetInstrumentationBreakpointInstrumentation]
readsPrec :: Int -> ReadS PDebuggerSetInstrumentationBreakpointInstrumentation
$creadsPrec :: Int -> ReadS PDebuggerSetInstrumentationBreakpointInstrumentation
Read)
instance FromJSON PDebuggerSetInstrumentationBreakpointInstrumentation where
  parseJSON :: Value
-> Parser PDebuggerSetInstrumentationBreakpointInstrumentation
parseJSON = String
-> (RuntimeScriptId
    -> Parser PDebuggerSetInstrumentationBreakpointInstrumentation)
-> Value
-> Parser PDebuggerSetInstrumentationBreakpointInstrumentation
forall a.
String -> (RuntimeScriptId -> Parser a) -> Value -> Parser a
A.withText String
"PDebuggerSetInstrumentationBreakpointInstrumentation" ((RuntimeScriptId
  -> Parser PDebuggerSetInstrumentationBreakpointInstrumentation)
 -> Value
 -> Parser PDebuggerSetInstrumentationBreakpointInstrumentation)
-> (RuntimeScriptId
    -> Parser PDebuggerSetInstrumentationBreakpointInstrumentation)
-> Value
-> Parser PDebuggerSetInstrumentationBreakpointInstrumentation
forall a b. (a -> b) -> a -> b
$ \RuntimeScriptId
v -> case RuntimeScriptId
v of
    RuntimeScriptId
"beforeScriptExecution" -> PDebuggerSetInstrumentationBreakpointInstrumentation
-> Parser PDebuggerSetInstrumentationBreakpointInstrumentation
forall (f :: * -> *) a. Applicative f => a -> f a
pure PDebuggerSetInstrumentationBreakpointInstrumentation
PDebuggerSetInstrumentationBreakpointInstrumentationBeforeScriptExecution
    RuntimeScriptId
"beforeScriptWithSourceMapExecution" -> PDebuggerSetInstrumentationBreakpointInstrumentation
-> Parser PDebuggerSetInstrumentationBreakpointInstrumentation
forall (f :: * -> *) a. Applicative f => a -> f a
pure PDebuggerSetInstrumentationBreakpointInstrumentation
PDebuggerSetInstrumentationBreakpointInstrumentationBeforeScriptWithSourceMapExecution
    RuntimeScriptId
"_" -> String
-> Parser PDebuggerSetInstrumentationBreakpointInstrumentation
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse PDebuggerSetInstrumentationBreakpointInstrumentation"
instance ToJSON PDebuggerSetInstrumentationBreakpointInstrumentation where
  toJSON :: PDebuggerSetInstrumentationBreakpointInstrumentation -> Value
toJSON PDebuggerSetInstrumentationBreakpointInstrumentation
v = RuntimeScriptId -> Value
A.String (RuntimeScriptId -> Value) -> RuntimeScriptId -> Value
forall a b. (a -> b) -> a -> b
$ case PDebuggerSetInstrumentationBreakpointInstrumentation
v of
    PDebuggerSetInstrumentationBreakpointInstrumentation
PDebuggerSetInstrumentationBreakpointInstrumentationBeforeScriptExecution -> RuntimeScriptId
"beforeScriptExecution"
    PDebuggerSetInstrumentationBreakpointInstrumentation
PDebuggerSetInstrumentationBreakpointInstrumentationBeforeScriptWithSourceMapExecution -> RuntimeScriptId
"beforeScriptWithSourceMapExecution"
data PDebuggerSetInstrumentationBreakpoint = PDebuggerSetInstrumentationBreakpoint
  {
    -- | Instrumentation name.
    PDebuggerSetInstrumentationBreakpoint
-> PDebuggerSetInstrumentationBreakpointInstrumentation
pDebuggerSetInstrumentationBreakpointInstrumentation :: PDebuggerSetInstrumentationBreakpointInstrumentation
  }
  deriving (PDebuggerSetInstrumentationBreakpoint
-> PDebuggerSetInstrumentationBreakpoint -> Bool
(PDebuggerSetInstrumentationBreakpoint
 -> PDebuggerSetInstrumentationBreakpoint -> Bool)
-> (PDebuggerSetInstrumentationBreakpoint
    -> PDebuggerSetInstrumentationBreakpoint -> Bool)
-> Eq PDebuggerSetInstrumentationBreakpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetInstrumentationBreakpoint
-> PDebuggerSetInstrumentationBreakpoint -> Bool
$c/= :: PDebuggerSetInstrumentationBreakpoint
-> PDebuggerSetInstrumentationBreakpoint -> Bool
== :: PDebuggerSetInstrumentationBreakpoint
-> PDebuggerSetInstrumentationBreakpoint -> Bool
$c== :: PDebuggerSetInstrumentationBreakpoint
-> PDebuggerSetInstrumentationBreakpoint -> Bool
Eq, Int -> PDebuggerSetInstrumentationBreakpoint -> ShowS
[PDebuggerSetInstrumentationBreakpoint] -> ShowS
PDebuggerSetInstrumentationBreakpoint -> String
(Int -> PDebuggerSetInstrumentationBreakpoint -> ShowS)
-> (PDebuggerSetInstrumentationBreakpoint -> String)
-> ([PDebuggerSetInstrumentationBreakpoint] -> ShowS)
-> Show PDebuggerSetInstrumentationBreakpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetInstrumentationBreakpoint] -> ShowS
$cshowList :: [PDebuggerSetInstrumentationBreakpoint] -> ShowS
show :: PDebuggerSetInstrumentationBreakpoint -> String
$cshow :: PDebuggerSetInstrumentationBreakpoint -> String
showsPrec :: Int -> PDebuggerSetInstrumentationBreakpoint -> ShowS
$cshowsPrec :: Int -> PDebuggerSetInstrumentationBreakpoint -> ShowS
Show)
pDebuggerSetInstrumentationBreakpoint
  {-
  -- | Instrumentation name.
  -}
  :: PDebuggerSetInstrumentationBreakpointInstrumentation
  -> PDebuggerSetInstrumentationBreakpoint
pDebuggerSetInstrumentationBreakpoint :: PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpoint
pDebuggerSetInstrumentationBreakpoint
  PDebuggerSetInstrumentationBreakpointInstrumentation
arg_pDebuggerSetInstrumentationBreakpointInstrumentation
  = PDebuggerSetInstrumentationBreakpointInstrumentation
-> PDebuggerSetInstrumentationBreakpoint
PDebuggerSetInstrumentationBreakpoint
    PDebuggerSetInstrumentationBreakpointInstrumentation
arg_pDebuggerSetInstrumentationBreakpointInstrumentation
instance ToJSON PDebuggerSetInstrumentationBreakpoint where
  toJSON :: PDebuggerSetInstrumentationBreakpoint -> Value
toJSON PDebuggerSetInstrumentationBreakpoint
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"instrumentation" RuntimeScriptId
-> PDebuggerSetInstrumentationBreakpointInstrumentation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (PDebuggerSetInstrumentationBreakpointInstrumentation -> Pair)
-> Maybe PDebuggerSetInstrumentationBreakpointInstrumentation
-> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PDebuggerSetInstrumentationBreakpointInstrumentation
-> Maybe PDebuggerSetInstrumentationBreakpointInstrumentation
forall a. a -> Maybe a
Just (PDebuggerSetInstrumentationBreakpoint
-> PDebuggerSetInstrumentationBreakpointInstrumentation
pDebuggerSetInstrumentationBreakpointInstrumentation PDebuggerSetInstrumentationBreakpoint
p)
    ]
data DebuggerSetInstrumentationBreakpoint = DebuggerSetInstrumentationBreakpoint
  {
    -- | Id of the created breakpoint for further reference.
    DebuggerSetInstrumentationBreakpoint -> RuntimeScriptId
debuggerSetInstrumentationBreakpointBreakpointId :: DebuggerBreakpointId
  }
  deriving (DebuggerSetInstrumentationBreakpoint
-> DebuggerSetInstrumentationBreakpoint -> Bool
(DebuggerSetInstrumentationBreakpoint
 -> DebuggerSetInstrumentationBreakpoint -> Bool)
-> (DebuggerSetInstrumentationBreakpoint
    -> DebuggerSetInstrumentationBreakpoint -> Bool)
-> Eq DebuggerSetInstrumentationBreakpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerSetInstrumentationBreakpoint
-> DebuggerSetInstrumentationBreakpoint -> Bool
$c/= :: DebuggerSetInstrumentationBreakpoint
-> DebuggerSetInstrumentationBreakpoint -> Bool
== :: DebuggerSetInstrumentationBreakpoint
-> DebuggerSetInstrumentationBreakpoint -> Bool
$c== :: DebuggerSetInstrumentationBreakpoint
-> DebuggerSetInstrumentationBreakpoint -> Bool
Eq, Int -> DebuggerSetInstrumentationBreakpoint -> ShowS
[DebuggerSetInstrumentationBreakpoint] -> ShowS
DebuggerSetInstrumentationBreakpoint -> String
(Int -> DebuggerSetInstrumentationBreakpoint -> ShowS)
-> (DebuggerSetInstrumentationBreakpoint -> String)
-> ([DebuggerSetInstrumentationBreakpoint] -> ShowS)
-> Show DebuggerSetInstrumentationBreakpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerSetInstrumentationBreakpoint] -> ShowS
$cshowList :: [DebuggerSetInstrumentationBreakpoint] -> ShowS
show :: DebuggerSetInstrumentationBreakpoint -> String
$cshow :: DebuggerSetInstrumentationBreakpoint -> String
showsPrec :: Int -> DebuggerSetInstrumentationBreakpoint -> ShowS
$cshowsPrec :: Int -> DebuggerSetInstrumentationBreakpoint -> ShowS
Show)
instance FromJSON DebuggerSetInstrumentationBreakpoint where
  parseJSON :: Value -> Parser DebuggerSetInstrumentationBreakpoint
parseJSON = String
-> (Object -> Parser DebuggerSetInstrumentationBreakpoint)
-> Value
-> Parser DebuggerSetInstrumentationBreakpoint
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerSetInstrumentationBreakpoint" ((Object -> Parser DebuggerSetInstrumentationBreakpoint)
 -> Value -> Parser DebuggerSetInstrumentationBreakpoint)
-> (Object -> Parser DebuggerSetInstrumentationBreakpoint)
-> Value
-> Parser DebuggerSetInstrumentationBreakpoint
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeScriptId -> DebuggerSetInstrumentationBreakpoint
DebuggerSetInstrumentationBreakpoint
    (RuntimeScriptId -> DebuggerSetInstrumentationBreakpoint)
-> Parser RuntimeScriptId
-> Parser DebuggerSetInstrumentationBreakpoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"breakpointId"
instance Command PDebuggerSetInstrumentationBreakpoint where
  type CommandResponse PDebuggerSetInstrumentationBreakpoint = DebuggerSetInstrumentationBreakpoint
  commandName :: Proxy PDebuggerSetInstrumentationBreakpoint -> String
commandName Proxy PDebuggerSetInstrumentationBreakpoint
_ = String
"Debugger.setInstrumentationBreakpoint"

-- | Sets JavaScript breakpoint at given location specified either by URL or URL regex. Once this
--   command is issued, all existing parsed scripts will have breakpoints resolved and returned in
--   `locations` property. Further matching script parsing will result in subsequent
--   `breakpointResolved` events issued. This logical breakpoint will survive page reloads.

-- | Parameters of the 'Debugger.setBreakpointByUrl' command.
data PDebuggerSetBreakpointByUrl = PDebuggerSetBreakpointByUrl
  {
    -- | Line number to set breakpoint at.
    PDebuggerSetBreakpointByUrl -> Int
pDebuggerSetBreakpointByUrlLineNumber :: Int,
    -- | URL of the resources to set breakpoint on.
    PDebuggerSetBreakpointByUrl -> Maybe RuntimeScriptId
pDebuggerSetBreakpointByUrlUrl :: Maybe T.Text,
    -- | Regex pattern for the URLs of the resources to set breakpoints on. Either `url` or
    --   `urlRegex` must be specified.
    PDebuggerSetBreakpointByUrl -> Maybe RuntimeScriptId
pDebuggerSetBreakpointByUrlUrlRegex :: Maybe T.Text,
    -- | Script hash of the resources to set breakpoint on.
    PDebuggerSetBreakpointByUrl -> Maybe RuntimeScriptId
pDebuggerSetBreakpointByUrlScriptHash :: Maybe T.Text,
    -- | Offset in the line to set breakpoint at.
    PDebuggerSetBreakpointByUrl -> Maybe Int
pDebuggerSetBreakpointByUrlColumnNumber :: Maybe Int,
    -- | Expression to use as a breakpoint condition. When specified, debugger will only stop on the
    --   breakpoint if this expression evaluates to true.
    PDebuggerSetBreakpointByUrl -> Maybe RuntimeScriptId
pDebuggerSetBreakpointByUrlCondition :: Maybe T.Text
  }
  deriving (PDebuggerSetBreakpointByUrl -> PDebuggerSetBreakpointByUrl -> Bool
(PDebuggerSetBreakpointByUrl
 -> PDebuggerSetBreakpointByUrl -> Bool)
-> (PDebuggerSetBreakpointByUrl
    -> PDebuggerSetBreakpointByUrl -> Bool)
-> Eq PDebuggerSetBreakpointByUrl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetBreakpointByUrl -> PDebuggerSetBreakpointByUrl -> Bool
$c/= :: PDebuggerSetBreakpointByUrl -> PDebuggerSetBreakpointByUrl -> Bool
== :: PDebuggerSetBreakpointByUrl -> PDebuggerSetBreakpointByUrl -> Bool
$c== :: PDebuggerSetBreakpointByUrl -> PDebuggerSetBreakpointByUrl -> Bool
Eq, Int -> PDebuggerSetBreakpointByUrl -> ShowS
[PDebuggerSetBreakpointByUrl] -> ShowS
PDebuggerSetBreakpointByUrl -> String
(Int -> PDebuggerSetBreakpointByUrl -> ShowS)
-> (PDebuggerSetBreakpointByUrl -> String)
-> ([PDebuggerSetBreakpointByUrl] -> ShowS)
-> Show PDebuggerSetBreakpointByUrl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetBreakpointByUrl] -> ShowS
$cshowList :: [PDebuggerSetBreakpointByUrl] -> ShowS
show :: PDebuggerSetBreakpointByUrl -> String
$cshow :: PDebuggerSetBreakpointByUrl -> String
showsPrec :: Int -> PDebuggerSetBreakpointByUrl -> ShowS
$cshowsPrec :: Int -> PDebuggerSetBreakpointByUrl -> ShowS
Show)
pDebuggerSetBreakpointByUrl
  {-
  -- | Line number to set breakpoint at.
  -}
  :: Int
  -> PDebuggerSetBreakpointByUrl
pDebuggerSetBreakpointByUrl :: Int -> PDebuggerSetBreakpointByUrl
pDebuggerSetBreakpointByUrl
  Int
arg_pDebuggerSetBreakpointByUrlLineNumber
  = Int
-> Maybe RuntimeScriptId
-> Maybe RuntimeScriptId
-> Maybe RuntimeScriptId
-> Maybe Int
-> Maybe RuntimeScriptId
-> PDebuggerSetBreakpointByUrl
PDebuggerSetBreakpointByUrl
    Int
arg_pDebuggerSetBreakpointByUrlLineNumber
    Maybe RuntimeScriptId
forall a. Maybe a
Nothing
    Maybe RuntimeScriptId
forall a. Maybe a
Nothing
    Maybe RuntimeScriptId
forall a. Maybe a
Nothing
    Maybe Int
forall a. Maybe a
Nothing
    Maybe RuntimeScriptId
forall a. Maybe a
Nothing
instance ToJSON PDebuggerSetBreakpointByUrl where
  toJSON :: PDebuggerSetBreakpointByUrl -> Value
toJSON PDebuggerSetBreakpointByUrl
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"lineNumber" RuntimeScriptId -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (PDebuggerSetBreakpointByUrl -> Int
pDebuggerSetBreakpointByUrlLineNumber PDebuggerSetBreakpointByUrl
p),
    (RuntimeScriptId
"url" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerSetBreakpointByUrl -> Maybe RuntimeScriptId
pDebuggerSetBreakpointByUrlUrl PDebuggerSetBreakpointByUrl
p),
    (RuntimeScriptId
"urlRegex" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerSetBreakpointByUrl -> Maybe RuntimeScriptId
pDebuggerSetBreakpointByUrlUrlRegex PDebuggerSetBreakpointByUrl
p),
    (RuntimeScriptId
"scriptHash" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerSetBreakpointByUrl -> Maybe RuntimeScriptId
pDebuggerSetBreakpointByUrlScriptHash PDebuggerSetBreakpointByUrl
p),
    (RuntimeScriptId
"columnNumber" RuntimeScriptId -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerSetBreakpointByUrl -> Maybe Int
pDebuggerSetBreakpointByUrlColumnNumber PDebuggerSetBreakpointByUrl
p),
    (RuntimeScriptId
"condition" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerSetBreakpointByUrl -> Maybe RuntimeScriptId
pDebuggerSetBreakpointByUrlCondition PDebuggerSetBreakpointByUrl
p)
    ]
data DebuggerSetBreakpointByUrl = DebuggerSetBreakpointByUrl
  {
    -- | Id of the created breakpoint for further reference.
    DebuggerSetBreakpointByUrl -> RuntimeScriptId
debuggerSetBreakpointByUrlBreakpointId :: DebuggerBreakpointId,
    -- | List of the locations this breakpoint resolved into upon addition.
    DebuggerSetBreakpointByUrl -> [DebuggerLocation]
debuggerSetBreakpointByUrlLocations :: [DebuggerLocation]
  }
  deriving (DebuggerSetBreakpointByUrl -> DebuggerSetBreakpointByUrl -> Bool
(DebuggerSetBreakpointByUrl -> DebuggerSetBreakpointByUrl -> Bool)
-> (DebuggerSetBreakpointByUrl
    -> DebuggerSetBreakpointByUrl -> Bool)
-> Eq DebuggerSetBreakpointByUrl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerSetBreakpointByUrl -> DebuggerSetBreakpointByUrl -> Bool
$c/= :: DebuggerSetBreakpointByUrl -> DebuggerSetBreakpointByUrl -> Bool
== :: DebuggerSetBreakpointByUrl -> DebuggerSetBreakpointByUrl -> Bool
$c== :: DebuggerSetBreakpointByUrl -> DebuggerSetBreakpointByUrl -> Bool
Eq, Int -> DebuggerSetBreakpointByUrl -> ShowS
[DebuggerSetBreakpointByUrl] -> ShowS
DebuggerSetBreakpointByUrl -> String
(Int -> DebuggerSetBreakpointByUrl -> ShowS)
-> (DebuggerSetBreakpointByUrl -> String)
-> ([DebuggerSetBreakpointByUrl] -> ShowS)
-> Show DebuggerSetBreakpointByUrl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerSetBreakpointByUrl] -> ShowS
$cshowList :: [DebuggerSetBreakpointByUrl] -> ShowS
show :: DebuggerSetBreakpointByUrl -> String
$cshow :: DebuggerSetBreakpointByUrl -> String
showsPrec :: Int -> DebuggerSetBreakpointByUrl -> ShowS
$cshowsPrec :: Int -> DebuggerSetBreakpointByUrl -> ShowS
Show)
instance FromJSON DebuggerSetBreakpointByUrl where
  parseJSON :: Value -> Parser DebuggerSetBreakpointByUrl
parseJSON = String
-> (Object -> Parser DebuggerSetBreakpointByUrl)
-> Value
-> Parser DebuggerSetBreakpointByUrl
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerSetBreakpointByUrl" ((Object -> Parser DebuggerSetBreakpointByUrl)
 -> Value -> Parser DebuggerSetBreakpointByUrl)
-> (Object -> Parser DebuggerSetBreakpointByUrl)
-> Value
-> Parser DebuggerSetBreakpointByUrl
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeScriptId -> [DebuggerLocation] -> DebuggerSetBreakpointByUrl
DebuggerSetBreakpointByUrl
    (RuntimeScriptId
 -> [DebuggerLocation] -> DebuggerSetBreakpointByUrl)
-> Parser RuntimeScriptId
-> Parser ([DebuggerLocation] -> DebuggerSetBreakpointByUrl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"breakpointId"
    Parser ([DebuggerLocation] -> DebuggerSetBreakpointByUrl)
-> Parser [DebuggerLocation] -> Parser DebuggerSetBreakpointByUrl
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser [DebuggerLocation]
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"locations"
instance Command PDebuggerSetBreakpointByUrl where
  type CommandResponse PDebuggerSetBreakpointByUrl = DebuggerSetBreakpointByUrl
  commandName :: Proxy PDebuggerSetBreakpointByUrl -> String
commandName Proxy PDebuggerSetBreakpointByUrl
_ = String
"Debugger.setBreakpointByUrl"

-- | Sets JavaScript breakpoint before each call to the given function.
--   If another function was created from the same source as a given one,
--   calling it will also trigger the breakpoint.

-- | Parameters of the 'Debugger.setBreakpointOnFunctionCall' command.
data PDebuggerSetBreakpointOnFunctionCall = PDebuggerSetBreakpointOnFunctionCall
  {
    -- | Function object id.
    PDebuggerSetBreakpointOnFunctionCall -> RuntimeScriptId
pDebuggerSetBreakpointOnFunctionCallObjectId :: Runtime.RuntimeRemoteObjectId,
    -- | Expression to use as a breakpoint condition. When specified, debugger will
    --   stop on the breakpoint if this expression evaluates to true.
    PDebuggerSetBreakpointOnFunctionCall -> Maybe RuntimeScriptId
pDebuggerSetBreakpointOnFunctionCallCondition :: Maybe T.Text
  }
  deriving (PDebuggerSetBreakpointOnFunctionCall
-> PDebuggerSetBreakpointOnFunctionCall -> Bool
(PDebuggerSetBreakpointOnFunctionCall
 -> PDebuggerSetBreakpointOnFunctionCall -> Bool)
-> (PDebuggerSetBreakpointOnFunctionCall
    -> PDebuggerSetBreakpointOnFunctionCall -> Bool)
-> Eq PDebuggerSetBreakpointOnFunctionCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetBreakpointOnFunctionCall
-> PDebuggerSetBreakpointOnFunctionCall -> Bool
$c/= :: PDebuggerSetBreakpointOnFunctionCall
-> PDebuggerSetBreakpointOnFunctionCall -> Bool
== :: PDebuggerSetBreakpointOnFunctionCall
-> PDebuggerSetBreakpointOnFunctionCall -> Bool
$c== :: PDebuggerSetBreakpointOnFunctionCall
-> PDebuggerSetBreakpointOnFunctionCall -> Bool
Eq, Int -> PDebuggerSetBreakpointOnFunctionCall -> ShowS
[PDebuggerSetBreakpointOnFunctionCall] -> ShowS
PDebuggerSetBreakpointOnFunctionCall -> String
(Int -> PDebuggerSetBreakpointOnFunctionCall -> ShowS)
-> (PDebuggerSetBreakpointOnFunctionCall -> String)
-> ([PDebuggerSetBreakpointOnFunctionCall] -> ShowS)
-> Show PDebuggerSetBreakpointOnFunctionCall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetBreakpointOnFunctionCall] -> ShowS
$cshowList :: [PDebuggerSetBreakpointOnFunctionCall] -> ShowS
show :: PDebuggerSetBreakpointOnFunctionCall -> String
$cshow :: PDebuggerSetBreakpointOnFunctionCall -> String
showsPrec :: Int -> PDebuggerSetBreakpointOnFunctionCall -> ShowS
$cshowsPrec :: Int -> PDebuggerSetBreakpointOnFunctionCall -> ShowS
Show)
pDebuggerSetBreakpointOnFunctionCall
  {-
  -- | Function object id.
  -}
  :: Runtime.RuntimeRemoteObjectId
  -> PDebuggerSetBreakpointOnFunctionCall
pDebuggerSetBreakpointOnFunctionCall :: RuntimeScriptId -> PDebuggerSetBreakpointOnFunctionCall
pDebuggerSetBreakpointOnFunctionCall
  RuntimeScriptId
arg_pDebuggerSetBreakpointOnFunctionCallObjectId
  = RuntimeScriptId
-> Maybe RuntimeScriptId -> PDebuggerSetBreakpointOnFunctionCall
PDebuggerSetBreakpointOnFunctionCall
    RuntimeScriptId
arg_pDebuggerSetBreakpointOnFunctionCallObjectId
    Maybe RuntimeScriptId
forall a. Maybe a
Nothing
instance ToJSON PDebuggerSetBreakpointOnFunctionCall where
  toJSON :: PDebuggerSetBreakpointOnFunctionCall -> Value
toJSON PDebuggerSetBreakpointOnFunctionCall
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"objectId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerSetBreakpointOnFunctionCall -> RuntimeScriptId
pDebuggerSetBreakpointOnFunctionCallObjectId PDebuggerSetBreakpointOnFunctionCall
p),
    (RuntimeScriptId
"condition" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerSetBreakpointOnFunctionCall -> Maybe RuntimeScriptId
pDebuggerSetBreakpointOnFunctionCallCondition PDebuggerSetBreakpointOnFunctionCall
p)
    ]
data DebuggerSetBreakpointOnFunctionCall = DebuggerSetBreakpointOnFunctionCall
  {
    -- | Id of the created breakpoint for further reference.
    DebuggerSetBreakpointOnFunctionCall -> RuntimeScriptId
debuggerSetBreakpointOnFunctionCallBreakpointId :: DebuggerBreakpointId
  }
  deriving (DebuggerSetBreakpointOnFunctionCall
-> DebuggerSetBreakpointOnFunctionCall -> Bool
(DebuggerSetBreakpointOnFunctionCall
 -> DebuggerSetBreakpointOnFunctionCall -> Bool)
-> (DebuggerSetBreakpointOnFunctionCall
    -> DebuggerSetBreakpointOnFunctionCall -> Bool)
-> Eq DebuggerSetBreakpointOnFunctionCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerSetBreakpointOnFunctionCall
-> DebuggerSetBreakpointOnFunctionCall -> Bool
$c/= :: DebuggerSetBreakpointOnFunctionCall
-> DebuggerSetBreakpointOnFunctionCall -> Bool
== :: DebuggerSetBreakpointOnFunctionCall
-> DebuggerSetBreakpointOnFunctionCall -> Bool
$c== :: DebuggerSetBreakpointOnFunctionCall
-> DebuggerSetBreakpointOnFunctionCall -> Bool
Eq, Int -> DebuggerSetBreakpointOnFunctionCall -> ShowS
[DebuggerSetBreakpointOnFunctionCall] -> ShowS
DebuggerSetBreakpointOnFunctionCall -> String
(Int -> DebuggerSetBreakpointOnFunctionCall -> ShowS)
-> (DebuggerSetBreakpointOnFunctionCall -> String)
-> ([DebuggerSetBreakpointOnFunctionCall] -> ShowS)
-> Show DebuggerSetBreakpointOnFunctionCall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerSetBreakpointOnFunctionCall] -> ShowS
$cshowList :: [DebuggerSetBreakpointOnFunctionCall] -> ShowS
show :: DebuggerSetBreakpointOnFunctionCall -> String
$cshow :: DebuggerSetBreakpointOnFunctionCall -> String
showsPrec :: Int -> DebuggerSetBreakpointOnFunctionCall -> ShowS
$cshowsPrec :: Int -> DebuggerSetBreakpointOnFunctionCall -> ShowS
Show)
instance FromJSON DebuggerSetBreakpointOnFunctionCall where
  parseJSON :: Value -> Parser DebuggerSetBreakpointOnFunctionCall
parseJSON = String
-> (Object -> Parser DebuggerSetBreakpointOnFunctionCall)
-> Value
-> Parser DebuggerSetBreakpointOnFunctionCall
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerSetBreakpointOnFunctionCall" ((Object -> Parser DebuggerSetBreakpointOnFunctionCall)
 -> Value -> Parser DebuggerSetBreakpointOnFunctionCall)
-> (Object -> Parser DebuggerSetBreakpointOnFunctionCall)
-> Value
-> Parser DebuggerSetBreakpointOnFunctionCall
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeScriptId -> DebuggerSetBreakpointOnFunctionCall
DebuggerSetBreakpointOnFunctionCall
    (RuntimeScriptId -> DebuggerSetBreakpointOnFunctionCall)
-> Parser RuntimeScriptId
-> Parser DebuggerSetBreakpointOnFunctionCall
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser RuntimeScriptId
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"breakpointId"
instance Command PDebuggerSetBreakpointOnFunctionCall where
  type CommandResponse PDebuggerSetBreakpointOnFunctionCall = DebuggerSetBreakpointOnFunctionCall
  commandName :: Proxy PDebuggerSetBreakpointOnFunctionCall -> String
commandName Proxy PDebuggerSetBreakpointOnFunctionCall
_ = String
"Debugger.setBreakpointOnFunctionCall"

-- | Activates / deactivates all breakpoints on the page.

-- | Parameters of the 'Debugger.setBreakpointsActive' command.
data PDebuggerSetBreakpointsActive = PDebuggerSetBreakpointsActive
  {
    -- | New value for breakpoints active state.
    PDebuggerSetBreakpointsActive -> Bool
pDebuggerSetBreakpointsActiveActive :: Bool
  }
  deriving (PDebuggerSetBreakpointsActive
-> PDebuggerSetBreakpointsActive -> Bool
(PDebuggerSetBreakpointsActive
 -> PDebuggerSetBreakpointsActive -> Bool)
-> (PDebuggerSetBreakpointsActive
    -> PDebuggerSetBreakpointsActive -> Bool)
-> Eq PDebuggerSetBreakpointsActive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetBreakpointsActive
-> PDebuggerSetBreakpointsActive -> Bool
$c/= :: PDebuggerSetBreakpointsActive
-> PDebuggerSetBreakpointsActive -> Bool
== :: PDebuggerSetBreakpointsActive
-> PDebuggerSetBreakpointsActive -> Bool
$c== :: PDebuggerSetBreakpointsActive
-> PDebuggerSetBreakpointsActive -> Bool
Eq, Int -> PDebuggerSetBreakpointsActive -> ShowS
[PDebuggerSetBreakpointsActive] -> ShowS
PDebuggerSetBreakpointsActive -> String
(Int -> PDebuggerSetBreakpointsActive -> ShowS)
-> (PDebuggerSetBreakpointsActive -> String)
-> ([PDebuggerSetBreakpointsActive] -> ShowS)
-> Show PDebuggerSetBreakpointsActive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetBreakpointsActive] -> ShowS
$cshowList :: [PDebuggerSetBreakpointsActive] -> ShowS
show :: PDebuggerSetBreakpointsActive -> String
$cshow :: PDebuggerSetBreakpointsActive -> String
showsPrec :: Int -> PDebuggerSetBreakpointsActive -> ShowS
$cshowsPrec :: Int -> PDebuggerSetBreakpointsActive -> ShowS
Show)
pDebuggerSetBreakpointsActive
  {-
  -- | New value for breakpoints active state.
  -}
  :: Bool
  -> PDebuggerSetBreakpointsActive
pDebuggerSetBreakpointsActive :: Bool -> PDebuggerSetBreakpointsActive
pDebuggerSetBreakpointsActive
  Bool
arg_pDebuggerSetBreakpointsActiveActive
  = Bool -> PDebuggerSetBreakpointsActive
PDebuggerSetBreakpointsActive
    Bool
arg_pDebuggerSetBreakpointsActiveActive
instance ToJSON PDebuggerSetBreakpointsActive where
  toJSON :: PDebuggerSetBreakpointsActive -> Value
toJSON PDebuggerSetBreakpointsActive
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"active" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (PDebuggerSetBreakpointsActive -> Bool
pDebuggerSetBreakpointsActiveActive PDebuggerSetBreakpointsActive
p)
    ]
instance Command PDebuggerSetBreakpointsActive where
  type CommandResponse PDebuggerSetBreakpointsActive = ()
  commandName :: Proxy PDebuggerSetBreakpointsActive -> String
commandName Proxy PDebuggerSetBreakpointsActive
_ = String
"Debugger.setBreakpointsActive"
  fromJSON :: Proxy PDebuggerSetBreakpointsActive
-> Value -> Result (CommandResponse PDebuggerSetBreakpointsActive)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerSetBreakpointsActive -> Result ())
-> Proxy PDebuggerSetBreakpointsActive
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerSetBreakpointsActive -> ())
-> Proxy PDebuggerSetBreakpointsActive
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerSetBreakpointsActive -> ()
forall a b. a -> b -> a
const ()

-- | Defines pause on exceptions state. Can be set to stop on all exceptions, uncaught exceptions or
--   no exceptions. Initial pause on exceptions state is `none`.

-- | Parameters of the 'Debugger.setPauseOnExceptions' command.
data PDebuggerSetPauseOnExceptionsState = PDebuggerSetPauseOnExceptionsStateNone | PDebuggerSetPauseOnExceptionsStateUncaught | PDebuggerSetPauseOnExceptionsStateAll
  deriving (Eq PDebuggerSetPauseOnExceptionsState
Eq PDebuggerSetPauseOnExceptionsState
-> (PDebuggerSetPauseOnExceptionsState
    -> PDebuggerSetPauseOnExceptionsState -> Ordering)
-> (PDebuggerSetPauseOnExceptionsState
    -> PDebuggerSetPauseOnExceptionsState -> Bool)
-> (PDebuggerSetPauseOnExceptionsState
    -> PDebuggerSetPauseOnExceptionsState -> Bool)
-> (PDebuggerSetPauseOnExceptionsState
    -> PDebuggerSetPauseOnExceptionsState -> Bool)
-> (PDebuggerSetPauseOnExceptionsState
    -> PDebuggerSetPauseOnExceptionsState -> Bool)
-> (PDebuggerSetPauseOnExceptionsState
    -> PDebuggerSetPauseOnExceptionsState
    -> PDebuggerSetPauseOnExceptionsState)
-> (PDebuggerSetPauseOnExceptionsState
    -> PDebuggerSetPauseOnExceptionsState
    -> PDebuggerSetPauseOnExceptionsState)
-> Ord PDebuggerSetPauseOnExceptionsState
PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Bool
PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Ordering
PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState
$cmin :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState
max :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState
$cmax :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState
>= :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Bool
$c>= :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Bool
> :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Bool
$c> :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Bool
<= :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Bool
$c<= :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Bool
< :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Bool
$c< :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Bool
compare :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Ordering
$ccompare :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Ordering
$cp1Ord :: Eq PDebuggerSetPauseOnExceptionsState
Ord, PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Bool
(PDebuggerSetPauseOnExceptionsState
 -> PDebuggerSetPauseOnExceptionsState -> Bool)
-> (PDebuggerSetPauseOnExceptionsState
    -> PDebuggerSetPauseOnExceptionsState -> Bool)
-> Eq PDebuggerSetPauseOnExceptionsState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Bool
$c/= :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Bool
== :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Bool
$c== :: PDebuggerSetPauseOnExceptionsState
-> PDebuggerSetPauseOnExceptionsState -> Bool
Eq, Int -> PDebuggerSetPauseOnExceptionsState -> ShowS
[PDebuggerSetPauseOnExceptionsState] -> ShowS
PDebuggerSetPauseOnExceptionsState -> String
(Int -> PDebuggerSetPauseOnExceptionsState -> ShowS)
-> (PDebuggerSetPauseOnExceptionsState -> String)
-> ([PDebuggerSetPauseOnExceptionsState] -> ShowS)
-> Show PDebuggerSetPauseOnExceptionsState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetPauseOnExceptionsState] -> ShowS
$cshowList :: [PDebuggerSetPauseOnExceptionsState] -> ShowS
show :: PDebuggerSetPauseOnExceptionsState -> String
$cshow :: PDebuggerSetPauseOnExceptionsState -> String
showsPrec :: Int -> PDebuggerSetPauseOnExceptionsState -> ShowS
$cshowsPrec :: Int -> PDebuggerSetPauseOnExceptionsState -> ShowS
Show, ReadPrec [PDebuggerSetPauseOnExceptionsState]
ReadPrec PDebuggerSetPauseOnExceptionsState
Int -> ReadS PDebuggerSetPauseOnExceptionsState
ReadS [PDebuggerSetPauseOnExceptionsState]
(Int -> ReadS PDebuggerSetPauseOnExceptionsState)
-> ReadS [PDebuggerSetPauseOnExceptionsState]
-> ReadPrec PDebuggerSetPauseOnExceptionsState
-> ReadPrec [PDebuggerSetPauseOnExceptionsState]
-> Read PDebuggerSetPauseOnExceptionsState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PDebuggerSetPauseOnExceptionsState]
$creadListPrec :: ReadPrec [PDebuggerSetPauseOnExceptionsState]
readPrec :: ReadPrec PDebuggerSetPauseOnExceptionsState
$creadPrec :: ReadPrec PDebuggerSetPauseOnExceptionsState
readList :: ReadS [PDebuggerSetPauseOnExceptionsState]
$creadList :: ReadS [PDebuggerSetPauseOnExceptionsState]
readsPrec :: Int -> ReadS PDebuggerSetPauseOnExceptionsState
$creadsPrec :: Int -> ReadS PDebuggerSetPauseOnExceptionsState
Read)
instance FromJSON PDebuggerSetPauseOnExceptionsState where
  parseJSON :: Value -> Parser PDebuggerSetPauseOnExceptionsState
parseJSON = String
-> (RuntimeScriptId -> Parser PDebuggerSetPauseOnExceptionsState)
-> Value
-> Parser PDebuggerSetPauseOnExceptionsState
forall a.
String -> (RuntimeScriptId -> Parser a) -> Value -> Parser a
A.withText String
"PDebuggerSetPauseOnExceptionsState" ((RuntimeScriptId -> Parser PDebuggerSetPauseOnExceptionsState)
 -> Value -> Parser PDebuggerSetPauseOnExceptionsState)
-> (RuntimeScriptId -> Parser PDebuggerSetPauseOnExceptionsState)
-> Value
-> Parser PDebuggerSetPauseOnExceptionsState
forall a b. (a -> b) -> a -> b
$ \RuntimeScriptId
v -> case RuntimeScriptId
v of
    RuntimeScriptId
"none" -> PDebuggerSetPauseOnExceptionsState
-> Parser PDebuggerSetPauseOnExceptionsState
forall (f :: * -> *) a. Applicative f => a -> f a
pure PDebuggerSetPauseOnExceptionsState
PDebuggerSetPauseOnExceptionsStateNone
    RuntimeScriptId
"uncaught" -> PDebuggerSetPauseOnExceptionsState
-> Parser PDebuggerSetPauseOnExceptionsState
forall (f :: * -> *) a. Applicative f => a -> f a
pure PDebuggerSetPauseOnExceptionsState
PDebuggerSetPauseOnExceptionsStateUncaught
    RuntimeScriptId
"all" -> PDebuggerSetPauseOnExceptionsState
-> Parser PDebuggerSetPauseOnExceptionsState
forall (f :: * -> *) a. Applicative f => a -> f a
pure PDebuggerSetPauseOnExceptionsState
PDebuggerSetPauseOnExceptionsStateAll
    RuntimeScriptId
"_" -> String -> Parser PDebuggerSetPauseOnExceptionsState
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse PDebuggerSetPauseOnExceptionsState"
instance ToJSON PDebuggerSetPauseOnExceptionsState where
  toJSON :: PDebuggerSetPauseOnExceptionsState -> Value
toJSON PDebuggerSetPauseOnExceptionsState
v = RuntimeScriptId -> Value
A.String (RuntimeScriptId -> Value) -> RuntimeScriptId -> Value
forall a b. (a -> b) -> a -> b
$ case PDebuggerSetPauseOnExceptionsState
v of
    PDebuggerSetPauseOnExceptionsState
PDebuggerSetPauseOnExceptionsStateNone -> RuntimeScriptId
"none"
    PDebuggerSetPauseOnExceptionsState
PDebuggerSetPauseOnExceptionsStateUncaught -> RuntimeScriptId
"uncaught"
    PDebuggerSetPauseOnExceptionsState
PDebuggerSetPauseOnExceptionsStateAll -> RuntimeScriptId
"all"
data PDebuggerSetPauseOnExceptions = PDebuggerSetPauseOnExceptions
  {
    -- | Pause on exceptions mode.
    PDebuggerSetPauseOnExceptions -> PDebuggerSetPauseOnExceptionsState
pDebuggerSetPauseOnExceptionsState :: PDebuggerSetPauseOnExceptionsState
  }
  deriving (PDebuggerSetPauseOnExceptions
-> PDebuggerSetPauseOnExceptions -> Bool
(PDebuggerSetPauseOnExceptions
 -> PDebuggerSetPauseOnExceptions -> Bool)
-> (PDebuggerSetPauseOnExceptions
    -> PDebuggerSetPauseOnExceptions -> Bool)
-> Eq PDebuggerSetPauseOnExceptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetPauseOnExceptions
-> PDebuggerSetPauseOnExceptions -> Bool
$c/= :: PDebuggerSetPauseOnExceptions
-> PDebuggerSetPauseOnExceptions -> Bool
== :: PDebuggerSetPauseOnExceptions
-> PDebuggerSetPauseOnExceptions -> Bool
$c== :: PDebuggerSetPauseOnExceptions
-> PDebuggerSetPauseOnExceptions -> Bool
Eq, Int -> PDebuggerSetPauseOnExceptions -> ShowS
[PDebuggerSetPauseOnExceptions] -> ShowS
PDebuggerSetPauseOnExceptions -> String
(Int -> PDebuggerSetPauseOnExceptions -> ShowS)
-> (PDebuggerSetPauseOnExceptions -> String)
-> ([PDebuggerSetPauseOnExceptions] -> ShowS)
-> Show PDebuggerSetPauseOnExceptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetPauseOnExceptions] -> ShowS
$cshowList :: [PDebuggerSetPauseOnExceptions] -> ShowS
show :: PDebuggerSetPauseOnExceptions -> String
$cshow :: PDebuggerSetPauseOnExceptions -> String
showsPrec :: Int -> PDebuggerSetPauseOnExceptions -> ShowS
$cshowsPrec :: Int -> PDebuggerSetPauseOnExceptions -> ShowS
Show)
pDebuggerSetPauseOnExceptions
  {-
  -- | Pause on exceptions mode.
  -}
  :: PDebuggerSetPauseOnExceptionsState
  -> PDebuggerSetPauseOnExceptions
pDebuggerSetPauseOnExceptions :: PDebuggerSetPauseOnExceptionsState -> PDebuggerSetPauseOnExceptions
pDebuggerSetPauseOnExceptions
  PDebuggerSetPauseOnExceptionsState
arg_pDebuggerSetPauseOnExceptionsState
  = PDebuggerSetPauseOnExceptionsState -> PDebuggerSetPauseOnExceptions
PDebuggerSetPauseOnExceptions
    PDebuggerSetPauseOnExceptionsState
arg_pDebuggerSetPauseOnExceptionsState
instance ToJSON PDebuggerSetPauseOnExceptions where
  toJSON :: PDebuggerSetPauseOnExceptions -> Value
toJSON PDebuggerSetPauseOnExceptions
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"state" RuntimeScriptId -> PDebuggerSetPauseOnExceptionsState -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (PDebuggerSetPauseOnExceptionsState -> Pair)
-> Maybe PDebuggerSetPauseOnExceptionsState -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PDebuggerSetPauseOnExceptionsState
-> Maybe PDebuggerSetPauseOnExceptionsState
forall a. a -> Maybe a
Just (PDebuggerSetPauseOnExceptions -> PDebuggerSetPauseOnExceptionsState
pDebuggerSetPauseOnExceptionsState PDebuggerSetPauseOnExceptions
p)
    ]
instance Command PDebuggerSetPauseOnExceptions where
  type CommandResponse PDebuggerSetPauseOnExceptions = ()
  commandName :: Proxy PDebuggerSetPauseOnExceptions -> String
commandName Proxy PDebuggerSetPauseOnExceptions
_ = String
"Debugger.setPauseOnExceptions"
  fromJSON :: Proxy PDebuggerSetPauseOnExceptions
-> Value -> Result (CommandResponse PDebuggerSetPauseOnExceptions)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerSetPauseOnExceptions -> Result ())
-> Proxy PDebuggerSetPauseOnExceptions
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerSetPauseOnExceptions -> ())
-> Proxy PDebuggerSetPauseOnExceptions
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerSetPauseOnExceptions -> ()
forall a b. a -> b -> a
const ()

-- | Changes return value in top frame. Available only at return break position.

-- | Parameters of the 'Debugger.setReturnValue' command.
data PDebuggerSetReturnValue = PDebuggerSetReturnValue
  {
    -- | New return value.
    PDebuggerSetReturnValue -> RuntimeCallArgument
pDebuggerSetReturnValueNewValue :: Runtime.RuntimeCallArgument
  }
  deriving (PDebuggerSetReturnValue -> PDebuggerSetReturnValue -> Bool
(PDebuggerSetReturnValue -> PDebuggerSetReturnValue -> Bool)
-> (PDebuggerSetReturnValue -> PDebuggerSetReturnValue -> Bool)
-> Eq PDebuggerSetReturnValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetReturnValue -> PDebuggerSetReturnValue -> Bool
$c/= :: PDebuggerSetReturnValue -> PDebuggerSetReturnValue -> Bool
== :: PDebuggerSetReturnValue -> PDebuggerSetReturnValue -> Bool
$c== :: PDebuggerSetReturnValue -> PDebuggerSetReturnValue -> Bool
Eq, Int -> PDebuggerSetReturnValue -> ShowS
[PDebuggerSetReturnValue] -> ShowS
PDebuggerSetReturnValue -> String
(Int -> PDebuggerSetReturnValue -> ShowS)
-> (PDebuggerSetReturnValue -> String)
-> ([PDebuggerSetReturnValue] -> ShowS)
-> Show PDebuggerSetReturnValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetReturnValue] -> ShowS
$cshowList :: [PDebuggerSetReturnValue] -> ShowS
show :: PDebuggerSetReturnValue -> String
$cshow :: PDebuggerSetReturnValue -> String
showsPrec :: Int -> PDebuggerSetReturnValue -> ShowS
$cshowsPrec :: Int -> PDebuggerSetReturnValue -> ShowS
Show)
pDebuggerSetReturnValue
  {-
  -- | New return value.
  -}
  :: Runtime.RuntimeCallArgument
  -> PDebuggerSetReturnValue
pDebuggerSetReturnValue :: RuntimeCallArgument -> PDebuggerSetReturnValue
pDebuggerSetReturnValue
  RuntimeCallArgument
arg_pDebuggerSetReturnValueNewValue
  = RuntimeCallArgument -> PDebuggerSetReturnValue
PDebuggerSetReturnValue
    RuntimeCallArgument
arg_pDebuggerSetReturnValueNewValue
instance ToJSON PDebuggerSetReturnValue where
  toJSON :: PDebuggerSetReturnValue -> Value
toJSON PDebuggerSetReturnValue
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"newValue" RuntimeScriptId -> RuntimeCallArgument -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeCallArgument -> Pair)
-> Maybe RuntimeCallArgument -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeCallArgument -> Maybe RuntimeCallArgument
forall a. a -> Maybe a
Just (PDebuggerSetReturnValue -> RuntimeCallArgument
pDebuggerSetReturnValueNewValue PDebuggerSetReturnValue
p)
    ]
instance Command PDebuggerSetReturnValue where
  type CommandResponse PDebuggerSetReturnValue = ()
  commandName :: Proxy PDebuggerSetReturnValue -> String
commandName Proxy PDebuggerSetReturnValue
_ = String
"Debugger.setReturnValue"
  fromJSON :: Proxy PDebuggerSetReturnValue
-> Value -> Result (CommandResponse PDebuggerSetReturnValue)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerSetReturnValue -> Result ())
-> Proxy PDebuggerSetReturnValue
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerSetReturnValue -> ())
-> Proxy PDebuggerSetReturnValue
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerSetReturnValue -> ()
forall a b. a -> b -> a
const ()

-- | Edits JavaScript source live.
--   
--   In general, functions that are currently on the stack can not be edited with
--   a single exception: If the edited function is the top-most stack frame and
--   that is the only activation of that function on the stack. In this case
--   the live edit will be successful and a `Debugger.restartFrame` for the
--   top-most function is automatically triggered.

-- | Parameters of the 'Debugger.setScriptSource' command.
data PDebuggerSetScriptSource = PDebuggerSetScriptSource
  {
    -- | Id of the script to edit.
    PDebuggerSetScriptSource -> RuntimeScriptId
pDebuggerSetScriptSourceScriptId :: Runtime.RuntimeScriptId,
    -- | New content of the script.
    PDebuggerSetScriptSource -> RuntimeScriptId
pDebuggerSetScriptSourceScriptSource :: T.Text,
    -- | If true the change will not actually be applied. Dry run may be used to get result
    --   description without actually modifying the code.
    PDebuggerSetScriptSource -> Maybe Bool
pDebuggerSetScriptSourceDryRun :: Maybe Bool,
    -- | If true, then `scriptSource` is allowed to change the function on top of the stack
    --   as long as the top-most stack frame is the only activation of that function.
    PDebuggerSetScriptSource -> Maybe Bool
pDebuggerSetScriptSourceAllowTopFrameEditing :: Maybe Bool
  }
  deriving (PDebuggerSetScriptSource -> PDebuggerSetScriptSource -> Bool
(PDebuggerSetScriptSource -> PDebuggerSetScriptSource -> Bool)
-> (PDebuggerSetScriptSource -> PDebuggerSetScriptSource -> Bool)
-> Eq PDebuggerSetScriptSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetScriptSource -> PDebuggerSetScriptSource -> Bool
$c/= :: PDebuggerSetScriptSource -> PDebuggerSetScriptSource -> Bool
== :: PDebuggerSetScriptSource -> PDebuggerSetScriptSource -> Bool
$c== :: PDebuggerSetScriptSource -> PDebuggerSetScriptSource -> Bool
Eq, Int -> PDebuggerSetScriptSource -> ShowS
[PDebuggerSetScriptSource] -> ShowS
PDebuggerSetScriptSource -> String
(Int -> PDebuggerSetScriptSource -> ShowS)
-> (PDebuggerSetScriptSource -> String)
-> ([PDebuggerSetScriptSource] -> ShowS)
-> Show PDebuggerSetScriptSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetScriptSource] -> ShowS
$cshowList :: [PDebuggerSetScriptSource] -> ShowS
show :: PDebuggerSetScriptSource -> String
$cshow :: PDebuggerSetScriptSource -> String
showsPrec :: Int -> PDebuggerSetScriptSource -> ShowS
$cshowsPrec :: Int -> PDebuggerSetScriptSource -> ShowS
Show)
pDebuggerSetScriptSource
  {-
  -- | Id of the script to edit.
  -}
  :: Runtime.RuntimeScriptId
  {-
  -- | New content of the script.
  -}
  -> T.Text
  -> PDebuggerSetScriptSource
pDebuggerSetScriptSource :: RuntimeScriptId -> RuntimeScriptId -> PDebuggerSetScriptSource
pDebuggerSetScriptSource
  RuntimeScriptId
arg_pDebuggerSetScriptSourceScriptId
  RuntimeScriptId
arg_pDebuggerSetScriptSourceScriptSource
  = RuntimeScriptId
-> RuntimeScriptId
-> Maybe Bool
-> Maybe Bool
-> PDebuggerSetScriptSource
PDebuggerSetScriptSource
    RuntimeScriptId
arg_pDebuggerSetScriptSourceScriptId
    RuntimeScriptId
arg_pDebuggerSetScriptSourceScriptSource
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PDebuggerSetScriptSource where
  toJSON :: PDebuggerSetScriptSource -> Value
toJSON PDebuggerSetScriptSource
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"scriptId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerSetScriptSource -> RuntimeScriptId
pDebuggerSetScriptSourceScriptId PDebuggerSetScriptSource
p),
    (RuntimeScriptId
"scriptSource" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerSetScriptSource -> RuntimeScriptId
pDebuggerSetScriptSourceScriptSource PDebuggerSetScriptSource
p),
    (RuntimeScriptId
"dryRun" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerSetScriptSource -> Maybe Bool
pDebuggerSetScriptSourceDryRun PDebuggerSetScriptSource
p),
    (RuntimeScriptId
"allowTopFrameEditing" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerSetScriptSource -> Maybe Bool
pDebuggerSetScriptSourceAllowTopFrameEditing PDebuggerSetScriptSource
p)
    ]
data DebuggerSetScriptSourceStatus = DebuggerSetScriptSourceStatusOk | DebuggerSetScriptSourceStatusCompileError | DebuggerSetScriptSourceStatusBlockedByActiveGenerator | DebuggerSetScriptSourceStatusBlockedByActiveFunction
  deriving (Eq DebuggerSetScriptSourceStatus
Eq DebuggerSetScriptSourceStatus
-> (DebuggerSetScriptSourceStatus
    -> DebuggerSetScriptSourceStatus -> Ordering)
-> (DebuggerSetScriptSourceStatus
    -> DebuggerSetScriptSourceStatus -> Bool)
-> (DebuggerSetScriptSourceStatus
    -> DebuggerSetScriptSourceStatus -> Bool)
-> (DebuggerSetScriptSourceStatus
    -> DebuggerSetScriptSourceStatus -> Bool)
-> (DebuggerSetScriptSourceStatus
    -> DebuggerSetScriptSourceStatus -> Bool)
-> (DebuggerSetScriptSourceStatus
    -> DebuggerSetScriptSourceStatus -> DebuggerSetScriptSourceStatus)
-> (DebuggerSetScriptSourceStatus
    -> DebuggerSetScriptSourceStatus -> DebuggerSetScriptSourceStatus)
-> Ord DebuggerSetScriptSourceStatus
DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Bool
DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Ordering
DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> DebuggerSetScriptSourceStatus
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> DebuggerSetScriptSourceStatus
$cmin :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> DebuggerSetScriptSourceStatus
max :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> DebuggerSetScriptSourceStatus
$cmax :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> DebuggerSetScriptSourceStatus
>= :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Bool
$c>= :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Bool
> :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Bool
$c> :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Bool
<= :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Bool
$c<= :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Bool
< :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Bool
$c< :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Bool
compare :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Ordering
$ccompare :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Ordering
$cp1Ord :: Eq DebuggerSetScriptSourceStatus
Ord, DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Bool
(DebuggerSetScriptSourceStatus
 -> DebuggerSetScriptSourceStatus -> Bool)
-> (DebuggerSetScriptSourceStatus
    -> DebuggerSetScriptSourceStatus -> Bool)
-> Eq DebuggerSetScriptSourceStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Bool
$c/= :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Bool
== :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Bool
$c== :: DebuggerSetScriptSourceStatus
-> DebuggerSetScriptSourceStatus -> Bool
Eq, Int -> DebuggerSetScriptSourceStatus -> ShowS
[DebuggerSetScriptSourceStatus] -> ShowS
DebuggerSetScriptSourceStatus -> String
(Int -> DebuggerSetScriptSourceStatus -> ShowS)
-> (DebuggerSetScriptSourceStatus -> String)
-> ([DebuggerSetScriptSourceStatus] -> ShowS)
-> Show DebuggerSetScriptSourceStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerSetScriptSourceStatus] -> ShowS
$cshowList :: [DebuggerSetScriptSourceStatus] -> ShowS
show :: DebuggerSetScriptSourceStatus -> String
$cshow :: DebuggerSetScriptSourceStatus -> String
showsPrec :: Int -> DebuggerSetScriptSourceStatus -> ShowS
$cshowsPrec :: Int -> DebuggerSetScriptSourceStatus -> ShowS
Show, ReadPrec [DebuggerSetScriptSourceStatus]
ReadPrec DebuggerSetScriptSourceStatus
Int -> ReadS DebuggerSetScriptSourceStatus
ReadS [DebuggerSetScriptSourceStatus]
(Int -> ReadS DebuggerSetScriptSourceStatus)
-> ReadS [DebuggerSetScriptSourceStatus]
-> ReadPrec DebuggerSetScriptSourceStatus
-> ReadPrec [DebuggerSetScriptSourceStatus]
-> Read DebuggerSetScriptSourceStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DebuggerSetScriptSourceStatus]
$creadListPrec :: ReadPrec [DebuggerSetScriptSourceStatus]
readPrec :: ReadPrec DebuggerSetScriptSourceStatus
$creadPrec :: ReadPrec DebuggerSetScriptSourceStatus
readList :: ReadS [DebuggerSetScriptSourceStatus]
$creadList :: ReadS [DebuggerSetScriptSourceStatus]
readsPrec :: Int -> ReadS DebuggerSetScriptSourceStatus
$creadsPrec :: Int -> ReadS DebuggerSetScriptSourceStatus
Read)
instance FromJSON DebuggerSetScriptSourceStatus where
  parseJSON :: Value -> Parser DebuggerSetScriptSourceStatus
parseJSON = String
-> (RuntimeScriptId -> Parser DebuggerSetScriptSourceStatus)
-> Value
-> Parser DebuggerSetScriptSourceStatus
forall a.
String -> (RuntimeScriptId -> Parser a) -> Value -> Parser a
A.withText String
"DebuggerSetScriptSourceStatus" ((RuntimeScriptId -> Parser DebuggerSetScriptSourceStatus)
 -> Value -> Parser DebuggerSetScriptSourceStatus)
-> (RuntimeScriptId -> Parser DebuggerSetScriptSourceStatus)
-> Value
-> Parser DebuggerSetScriptSourceStatus
forall a b. (a -> b) -> a -> b
$ \RuntimeScriptId
v -> case RuntimeScriptId
v of
    RuntimeScriptId
"Ok" -> DebuggerSetScriptSourceStatus
-> Parser DebuggerSetScriptSourceStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerSetScriptSourceStatus
DebuggerSetScriptSourceStatusOk
    RuntimeScriptId
"CompileError" -> DebuggerSetScriptSourceStatus
-> Parser DebuggerSetScriptSourceStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerSetScriptSourceStatus
DebuggerSetScriptSourceStatusCompileError
    RuntimeScriptId
"BlockedByActiveGenerator" -> DebuggerSetScriptSourceStatus
-> Parser DebuggerSetScriptSourceStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerSetScriptSourceStatus
DebuggerSetScriptSourceStatusBlockedByActiveGenerator
    RuntimeScriptId
"BlockedByActiveFunction" -> DebuggerSetScriptSourceStatus
-> Parser DebuggerSetScriptSourceStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebuggerSetScriptSourceStatus
DebuggerSetScriptSourceStatusBlockedByActiveFunction
    RuntimeScriptId
"_" -> String -> Parser DebuggerSetScriptSourceStatus
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse DebuggerSetScriptSourceStatus"
instance ToJSON DebuggerSetScriptSourceStatus where
  toJSON :: DebuggerSetScriptSourceStatus -> Value
toJSON DebuggerSetScriptSourceStatus
v = RuntimeScriptId -> Value
A.String (RuntimeScriptId -> Value) -> RuntimeScriptId -> Value
forall a b. (a -> b) -> a -> b
$ case DebuggerSetScriptSourceStatus
v of
    DebuggerSetScriptSourceStatus
DebuggerSetScriptSourceStatusOk -> RuntimeScriptId
"Ok"
    DebuggerSetScriptSourceStatus
DebuggerSetScriptSourceStatusCompileError -> RuntimeScriptId
"CompileError"
    DebuggerSetScriptSourceStatus
DebuggerSetScriptSourceStatusBlockedByActiveGenerator -> RuntimeScriptId
"BlockedByActiveGenerator"
    DebuggerSetScriptSourceStatus
DebuggerSetScriptSourceStatusBlockedByActiveFunction -> RuntimeScriptId
"BlockedByActiveFunction"
data DebuggerSetScriptSource = DebuggerSetScriptSource
  {
    -- | Whether the operation was successful or not. Only `Ok` denotes a
    --   successful live edit while the other enum variants denote why
    --   the live edit failed.
    DebuggerSetScriptSource -> DebuggerSetScriptSourceStatus
debuggerSetScriptSourceStatus :: DebuggerSetScriptSourceStatus,
    -- | Exception details if any. Only present when `status` is `CompileError`.
    DebuggerSetScriptSource -> Maybe RuntimeExceptionDetails
debuggerSetScriptSourceExceptionDetails :: Maybe Runtime.RuntimeExceptionDetails
  }
  deriving (DebuggerSetScriptSource -> DebuggerSetScriptSource -> Bool
(DebuggerSetScriptSource -> DebuggerSetScriptSource -> Bool)
-> (DebuggerSetScriptSource -> DebuggerSetScriptSource -> Bool)
-> Eq DebuggerSetScriptSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebuggerSetScriptSource -> DebuggerSetScriptSource -> Bool
$c/= :: DebuggerSetScriptSource -> DebuggerSetScriptSource -> Bool
== :: DebuggerSetScriptSource -> DebuggerSetScriptSource -> Bool
$c== :: DebuggerSetScriptSource -> DebuggerSetScriptSource -> Bool
Eq, Int -> DebuggerSetScriptSource -> ShowS
[DebuggerSetScriptSource] -> ShowS
DebuggerSetScriptSource -> String
(Int -> DebuggerSetScriptSource -> ShowS)
-> (DebuggerSetScriptSource -> String)
-> ([DebuggerSetScriptSource] -> ShowS)
-> Show DebuggerSetScriptSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebuggerSetScriptSource] -> ShowS
$cshowList :: [DebuggerSetScriptSource] -> ShowS
show :: DebuggerSetScriptSource -> String
$cshow :: DebuggerSetScriptSource -> String
showsPrec :: Int -> DebuggerSetScriptSource -> ShowS
$cshowsPrec :: Int -> DebuggerSetScriptSource -> ShowS
Show)
instance FromJSON DebuggerSetScriptSource where
  parseJSON :: Value -> Parser DebuggerSetScriptSource
parseJSON = String
-> (Object -> Parser DebuggerSetScriptSource)
-> Value
-> Parser DebuggerSetScriptSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DebuggerSetScriptSource" ((Object -> Parser DebuggerSetScriptSource)
 -> Value -> Parser DebuggerSetScriptSource)
-> (Object -> Parser DebuggerSetScriptSource)
-> Value
-> Parser DebuggerSetScriptSource
forall a b. (a -> b) -> a -> b
$ \Object
o -> DebuggerSetScriptSourceStatus
-> Maybe RuntimeExceptionDetails -> DebuggerSetScriptSource
DebuggerSetScriptSource
    (DebuggerSetScriptSourceStatus
 -> Maybe RuntimeExceptionDetails -> DebuggerSetScriptSource)
-> Parser DebuggerSetScriptSourceStatus
-> Parser
     (Maybe RuntimeExceptionDetails -> DebuggerSetScriptSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> RuntimeScriptId -> Parser DebuggerSetScriptSourceStatus
forall a. FromJSON a => Object -> RuntimeScriptId -> Parser a
A..: RuntimeScriptId
"status"
    Parser (Maybe RuntimeExceptionDetails -> DebuggerSetScriptSource)
-> Parser (Maybe RuntimeExceptionDetails)
-> Parser DebuggerSetScriptSource
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> RuntimeScriptId -> Parser (Maybe RuntimeExceptionDetails)
forall a.
FromJSON a =>
Object -> RuntimeScriptId -> Parser (Maybe a)
A..:? RuntimeScriptId
"exceptionDetails"
instance Command PDebuggerSetScriptSource where
  type CommandResponse PDebuggerSetScriptSource = DebuggerSetScriptSource
  commandName :: Proxy PDebuggerSetScriptSource -> String
commandName Proxy PDebuggerSetScriptSource
_ = String
"Debugger.setScriptSource"

-- | Makes page not interrupt on any pauses (breakpoint, exception, dom exception etc).

-- | Parameters of the 'Debugger.setSkipAllPauses' command.
data PDebuggerSetSkipAllPauses = PDebuggerSetSkipAllPauses
  {
    -- | New value for skip pauses state.
    PDebuggerSetSkipAllPauses -> Bool
pDebuggerSetSkipAllPausesSkip :: Bool
  }
  deriving (PDebuggerSetSkipAllPauses -> PDebuggerSetSkipAllPauses -> Bool
(PDebuggerSetSkipAllPauses -> PDebuggerSetSkipAllPauses -> Bool)
-> (PDebuggerSetSkipAllPauses -> PDebuggerSetSkipAllPauses -> Bool)
-> Eq PDebuggerSetSkipAllPauses
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetSkipAllPauses -> PDebuggerSetSkipAllPauses -> Bool
$c/= :: PDebuggerSetSkipAllPauses -> PDebuggerSetSkipAllPauses -> Bool
== :: PDebuggerSetSkipAllPauses -> PDebuggerSetSkipAllPauses -> Bool
$c== :: PDebuggerSetSkipAllPauses -> PDebuggerSetSkipAllPauses -> Bool
Eq, Int -> PDebuggerSetSkipAllPauses -> ShowS
[PDebuggerSetSkipAllPauses] -> ShowS
PDebuggerSetSkipAllPauses -> String
(Int -> PDebuggerSetSkipAllPauses -> ShowS)
-> (PDebuggerSetSkipAllPauses -> String)
-> ([PDebuggerSetSkipAllPauses] -> ShowS)
-> Show PDebuggerSetSkipAllPauses
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetSkipAllPauses] -> ShowS
$cshowList :: [PDebuggerSetSkipAllPauses] -> ShowS
show :: PDebuggerSetSkipAllPauses -> String
$cshow :: PDebuggerSetSkipAllPauses -> String
showsPrec :: Int -> PDebuggerSetSkipAllPauses -> ShowS
$cshowsPrec :: Int -> PDebuggerSetSkipAllPauses -> ShowS
Show)
pDebuggerSetSkipAllPauses
  {-
  -- | New value for skip pauses state.
  -}
  :: Bool
  -> PDebuggerSetSkipAllPauses
pDebuggerSetSkipAllPauses :: Bool -> PDebuggerSetSkipAllPauses
pDebuggerSetSkipAllPauses
  Bool
arg_pDebuggerSetSkipAllPausesSkip
  = Bool -> PDebuggerSetSkipAllPauses
PDebuggerSetSkipAllPauses
    Bool
arg_pDebuggerSetSkipAllPausesSkip
instance ToJSON PDebuggerSetSkipAllPauses where
  toJSON :: PDebuggerSetSkipAllPauses -> Value
toJSON PDebuggerSetSkipAllPauses
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"skip" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (PDebuggerSetSkipAllPauses -> Bool
pDebuggerSetSkipAllPausesSkip PDebuggerSetSkipAllPauses
p)
    ]
instance Command PDebuggerSetSkipAllPauses where
  type CommandResponse PDebuggerSetSkipAllPauses = ()
  commandName :: Proxy PDebuggerSetSkipAllPauses -> String
commandName Proxy PDebuggerSetSkipAllPauses
_ = String
"Debugger.setSkipAllPauses"
  fromJSON :: Proxy PDebuggerSetSkipAllPauses
-> Value -> Result (CommandResponse PDebuggerSetSkipAllPauses)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerSetSkipAllPauses -> Result ())
-> Proxy PDebuggerSetSkipAllPauses
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerSetSkipAllPauses -> ())
-> Proxy PDebuggerSetSkipAllPauses
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerSetSkipAllPauses -> ()
forall a b. a -> b -> a
const ()

-- | Changes value of variable in a callframe. Object-based scopes are not supported and must be
--   mutated manually.

-- | Parameters of the 'Debugger.setVariableValue' command.
data PDebuggerSetVariableValue = PDebuggerSetVariableValue
  {
    -- | 0-based number of scope as was listed in scope chain. Only 'local', 'closure' and 'catch'
    --   scope types are allowed. Other scopes could be manipulated manually.
    PDebuggerSetVariableValue -> Int
pDebuggerSetVariableValueScopeNumber :: Int,
    -- | Variable name.
    PDebuggerSetVariableValue -> RuntimeScriptId
pDebuggerSetVariableValueVariableName :: T.Text,
    -- | New variable value.
    PDebuggerSetVariableValue -> RuntimeCallArgument
pDebuggerSetVariableValueNewValue :: Runtime.RuntimeCallArgument,
    -- | Id of callframe that holds variable.
    PDebuggerSetVariableValue -> RuntimeScriptId
pDebuggerSetVariableValueCallFrameId :: DebuggerCallFrameId
  }
  deriving (PDebuggerSetVariableValue -> PDebuggerSetVariableValue -> Bool
(PDebuggerSetVariableValue -> PDebuggerSetVariableValue -> Bool)
-> (PDebuggerSetVariableValue -> PDebuggerSetVariableValue -> Bool)
-> Eq PDebuggerSetVariableValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerSetVariableValue -> PDebuggerSetVariableValue -> Bool
$c/= :: PDebuggerSetVariableValue -> PDebuggerSetVariableValue -> Bool
== :: PDebuggerSetVariableValue -> PDebuggerSetVariableValue -> Bool
$c== :: PDebuggerSetVariableValue -> PDebuggerSetVariableValue -> Bool
Eq, Int -> PDebuggerSetVariableValue -> ShowS
[PDebuggerSetVariableValue] -> ShowS
PDebuggerSetVariableValue -> String
(Int -> PDebuggerSetVariableValue -> ShowS)
-> (PDebuggerSetVariableValue -> String)
-> ([PDebuggerSetVariableValue] -> ShowS)
-> Show PDebuggerSetVariableValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerSetVariableValue] -> ShowS
$cshowList :: [PDebuggerSetVariableValue] -> ShowS
show :: PDebuggerSetVariableValue -> String
$cshow :: PDebuggerSetVariableValue -> String
showsPrec :: Int -> PDebuggerSetVariableValue -> ShowS
$cshowsPrec :: Int -> PDebuggerSetVariableValue -> ShowS
Show)
pDebuggerSetVariableValue
  {-
  -- | 0-based number of scope as was listed in scope chain. Only 'local', 'closure' and 'catch'
  --   scope types are allowed. Other scopes could be manipulated manually.
  -}
  :: Int
  {-
  -- | Variable name.
  -}
  -> T.Text
  {-
  -- | New variable value.
  -}
  -> Runtime.RuntimeCallArgument
  {-
  -- | Id of callframe that holds variable.
  -}
  -> DebuggerCallFrameId
  -> PDebuggerSetVariableValue
pDebuggerSetVariableValue :: Int
-> RuntimeScriptId
-> RuntimeCallArgument
-> RuntimeScriptId
-> PDebuggerSetVariableValue
pDebuggerSetVariableValue
  Int
arg_pDebuggerSetVariableValueScopeNumber
  RuntimeScriptId
arg_pDebuggerSetVariableValueVariableName
  RuntimeCallArgument
arg_pDebuggerSetVariableValueNewValue
  RuntimeScriptId
arg_pDebuggerSetVariableValueCallFrameId
  = Int
-> RuntimeScriptId
-> RuntimeCallArgument
-> RuntimeScriptId
-> PDebuggerSetVariableValue
PDebuggerSetVariableValue
    Int
arg_pDebuggerSetVariableValueScopeNumber
    RuntimeScriptId
arg_pDebuggerSetVariableValueVariableName
    RuntimeCallArgument
arg_pDebuggerSetVariableValueNewValue
    RuntimeScriptId
arg_pDebuggerSetVariableValueCallFrameId
instance ToJSON PDebuggerSetVariableValue where
  toJSON :: PDebuggerSetVariableValue -> Value
toJSON PDebuggerSetVariableValue
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"scopeNumber" RuntimeScriptId -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (PDebuggerSetVariableValue -> Int
pDebuggerSetVariableValueScopeNumber PDebuggerSetVariableValue
p),
    (RuntimeScriptId
"variableName" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerSetVariableValue -> RuntimeScriptId
pDebuggerSetVariableValueVariableName PDebuggerSetVariableValue
p),
    (RuntimeScriptId
"newValue" RuntimeScriptId -> RuntimeCallArgument -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeCallArgument -> Pair)
-> Maybe RuntimeCallArgument -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeCallArgument -> Maybe RuntimeCallArgument
forall a. a -> Maybe a
Just (PDebuggerSetVariableValue -> RuntimeCallArgument
pDebuggerSetVariableValueNewValue PDebuggerSetVariableValue
p),
    (RuntimeScriptId
"callFrameId" RuntimeScriptId -> RuntimeScriptId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (RuntimeScriptId -> Pair) -> Maybe RuntimeScriptId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeScriptId -> Maybe RuntimeScriptId
forall a. a -> Maybe a
Just (PDebuggerSetVariableValue -> RuntimeScriptId
pDebuggerSetVariableValueCallFrameId PDebuggerSetVariableValue
p)
    ]
instance Command PDebuggerSetVariableValue where
  type CommandResponse PDebuggerSetVariableValue = ()
  commandName :: Proxy PDebuggerSetVariableValue -> String
commandName Proxy PDebuggerSetVariableValue
_ = String
"Debugger.setVariableValue"
  fromJSON :: Proxy PDebuggerSetVariableValue
-> Value -> Result (CommandResponse PDebuggerSetVariableValue)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerSetVariableValue -> Result ())
-> Proxy PDebuggerSetVariableValue
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerSetVariableValue -> ())
-> Proxy PDebuggerSetVariableValue
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerSetVariableValue -> ()
forall a b. a -> b -> a
const ()

-- | Steps into the function call.

-- | Parameters of the 'Debugger.stepInto' command.
data PDebuggerStepInto = PDebuggerStepInto
  {
    -- | Debugger will pause on the execution of the first async task which was scheduled
    --   before next pause.
    PDebuggerStepInto -> Maybe Bool
pDebuggerStepIntoBreakOnAsyncCall :: Maybe Bool,
    -- | The skipList specifies location ranges that should be skipped on step into.
    PDebuggerStepInto -> Maybe [DebuggerLocationRange]
pDebuggerStepIntoSkipList :: Maybe [DebuggerLocationRange]
  }
  deriving (PDebuggerStepInto -> PDebuggerStepInto -> Bool
(PDebuggerStepInto -> PDebuggerStepInto -> Bool)
-> (PDebuggerStepInto -> PDebuggerStepInto -> Bool)
-> Eq PDebuggerStepInto
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerStepInto -> PDebuggerStepInto -> Bool
$c/= :: PDebuggerStepInto -> PDebuggerStepInto -> Bool
== :: PDebuggerStepInto -> PDebuggerStepInto -> Bool
$c== :: PDebuggerStepInto -> PDebuggerStepInto -> Bool
Eq, Int -> PDebuggerStepInto -> ShowS
[PDebuggerStepInto] -> ShowS
PDebuggerStepInto -> String
(Int -> PDebuggerStepInto -> ShowS)
-> (PDebuggerStepInto -> String)
-> ([PDebuggerStepInto] -> ShowS)
-> Show PDebuggerStepInto
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerStepInto] -> ShowS
$cshowList :: [PDebuggerStepInto] -> ShowS
show :: PDebuggerStepInto -> String
$cshow :: PDebuggerStepInto -> String
showsPrec :: Int -> PDebuggerStepInto -> ShowS
$cshowsPrec :: Int -> PDebuggerStepInto -> ShowS
Show)
pDebuggerStepInto
  :: PDebuggerStepInto
pDebuggerStepInto :: PDebuggerStepInto
pDebuggerStepInto
  = Maybe Bool -> Maybe [DebuggerLocationRange] -> PDebuggerStepInto
PDebuggerStepInto
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe [DebuggerLocationRange]
forall a. Maybe a
Nothing
instance ToJSON PDebuggerStepInto where
  toJSON :: PDebuggerStepInto -> Value
toJSON PDebuggerStepInto
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"breakOnAsyncCall" RuntimeScriptId -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerStepInto -> Maybe Bool
pDebuggerStepIntoBreakOnAsyncCall PDebuggerStepInto
p),
    (RuntimeScriptId
"skipList" RuntimeScriptId -> [DebuggerLocationRange] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) ([DebuggerLocationRange] -> Pair)
-> Maybe [DebuggerLocationRange] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerStepInto -> Maybe [DebuggerLocationRange]
pDebuggerStepIntoSkipList PDebuggerStepInto
p)
    ]
instance Command PDebuggerStepInto where
  type CommandResponse PDebuggerStepInto = ()
  commandName :: Proxy PDebuggerStepInto -> String
commandName Proxy PDebuggerStepInto
_ = String
"Debugger.stepInto"
  fromJSON :: Proxy PDebuggerStepInto
-> Value -> Result (CommandResponse PDebuggerStepInto)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerStepInto -> Result ())
-> Proxy PDebuggerStepInto
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerStepInto -> ())
-> Proxy PDebuggerStepInto
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerStepInto -> ()
forall a b. a -> b -> a
const ()

-- | Steps out of the function call.

-- | Parameters of the 'Debugger.stepOut' command.
data PDebuggerStepOut = PDebuggerStepOut
  deriving (PDebuggerStepOut -> PDebuggerStepOut -> Bool
(PDebuggerStepOut -> PDebuggerStepOut -> Bool)
-> (PDebuggerStepOut -> PDebuggerStepOut -> Bool)
-> Eq PDebuggerStepOut
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerStepOut -> PDebuggerStepOut -> Bool
$c/= :: PDebuggerStepOut -> PDebuggerStepOut -> Bool
== :: PDebuggerStepOut -> PDebuggerStepOut -> Bool
$c== :: PDebuggerStepOut -> PDebuggerStepOut -> Bool
Eq, Int -> PDebuggerStepOut -> ShowS
[PDebuggerStepOut] -> ShowS
PDebuggerStepOut -> String
(Int -> PDebuggerStepOut -> ShowS)
-> (PDebuggerStepOut -> String)
-> ([PDebuggerStepOut] -> ShowS)
-> Show PDebuggerStepOut
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerStepOut] -> ShowS
$cshowList :: [PDebuggerStepOut] -> ShowS
show :: PDebuggerStepOut -> String
$cshow :: PDebuggerStepOut -> String
showsPrec :: Int -> PDebuggerStepOut -> ShowS
$cshowsPrec :: Int -> PDebuggerStepOut -> ShowS
Show)
pDebuggerStepOut
  :: PDebuggerStepOut
pDebuggerStepOut :: PDebuggerStepOut
pDebuggerStepOut
  = PDebuggerStepOut
PDebuggerStepOut
instance ToJSON PDebuggerStepOut where
  toJSON :: PDebuggerStepOut -> Value
toJSON PDebuggerStepOut
_ = Value
A.Null
instance Command PDebuggerStepOut where
  type CommandResponse PDebuggerStepOut = ()
  commandName :: Proxy PDebuggerStepOut -> String
commandName Proxy PDebuggerStepOut
_ = String
"Debugger.stepOut"
  fromJSON :: Proxy PDebuggerStepOut
-> Value -> Result (CommandResponse PDebuggerStepOut)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerStepOut -> Result ())
-> Proxy PDebuggerStepOut
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerStepOut -> ())
-> Proxy PDebuggerStepOut
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerStepOut -> ()
forall a b. a -> b -> a
const ()

-- | Steps over the statement.

-- | Parameters of the 'Debugger.stepOver' command.
data PDebuggerStepOver = PDebuggerStepOver
  {
    -- | The skipList specifies location ranges that should be skipped on step over.
    PDebuggerStepOver -> Maybe [DebuggerLocationRange]
pDebuggerStepOverSkipList :: Maybe [DebuggerLocationRange]
  }
  deriving (PDebuggerStepOver -> PDebuggerStepOver -> Bool
(PDebuggerStepOver -> PDebuggerStepOver -> Bool)
-> (PDebuggerStepOver -> PDebuggerStepOver -> Bool)
-> Eq PDebuggerStepOver
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDebuggerStepOver -> PDebuggerStepOver -> Bool
$c/= :: PDebuggerStepOver -> PDebuggerStepOver -> Bool
== :: PDebuggerStepOver -> PDebuggerStepOver -> Bool
$c== :: PDebuggerStepOver -> PDebuggerStepOver -> Bool
Eq, Int -> PDebuggerStepOver -> ShowS
[PDebuggerStepOver] -> ShowS
PDebuggerStepOver -> String
(Int -> PDebuggerStepOver -> ShowS)
-> (PDebuggerStepOver -> String)
-> ([PDebuggerStepOver] -> ShowS)
-> Show PDebuggerStepOver
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDebuggerStepOver] -> ShowS
$cshowList :: [PDebuggerStepOver] -> ShowS
show :: PDebuggerStepOver -> String
$cshow :: PDebuggerStepOver -> String
showsPrec :: Int -> PDebuggerStepOver -> ShowS
$cshowsPrec :: Int -> PDebuggerStepOver -> ShowS
Show)
pDebuggerStepOver
  :: PDebuggerStepOver
pDebuggerStepOver :: PDebuggerStepOver
pDebuggerStepOver
  = Maybe [DebuggerLocationRange] -> PDebuggerStepOver
PDebuggerStepOver
    Maybe [DebuggerLocationRange]
forall a. Maybe a
Nothing
instance ToJSON PDebuggerStepOver where
  toJSON :: PDebuggerStepOver -> Value
toJSON PDebuggerStepOver
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (RuntimeScriptId
"skipList" RuntimeScriptId -> [DebuggerLocationRange] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => RuntimeScriptId -> v -> kv
A..=) ([DebuggerLocationRange] -> Pair)
-> Maybe [DebuggerLocationRange] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDebuggerStepOver -> Maybe [DebuggerLocationRange]
pDebuggerStepOverSkipList PDebuggerStepOver
p)
    ]
instance Command PDebuggerStepOver where
  type CommandResponse PDebuggerStepOver = ()
  commandName :: Proxy PDebuggerStepOver -> String
commandName Proxy PDebuggerStepOver
_ = String
"Debugger.stepOver"
  fromJSON :: Proxy PDebuggerStepOver
-> Value -> Result (CommandResponse PDebuggerStepOver)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDebuggerStepOver -> Result ())
-> Proxy PDebuggerStepOver
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDebuggerStepOver -> ())
-> Proxy PDebuggerStepOver
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDebuggerStepOver -> ()
forall a b. a -> b -> a
const ()