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


{- |
= EventBreakpoints

EventBreakpoints permits setting breakpoints on particular operations and
events in targets that run JavaScript but do not have a DOM.
JavaScript execution will stop on these operations as if there was a regular
breakpoint set.
-}


module CDP.Domains.EventBreakpoints (module CDP.Domains.EventBreakpoints) 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




-- | Sets breakpoint on particular native event.

-- | Parameters of the 'EventBreakpoints.setInstrumentationBreakpoint' command.
data PEventBreakpointsSetInstrumentationBreakpoint = PEventBreakpointsSetInstrumentationBreakpoint
  {
    -- | Instrumentation name to stop on.
    PEventBreakpointsSetInstrumentationBreakpoint -> Text
pEventBreakpointsSetInstrumentationBreakpointEventName :: T.Text
  }
  deriving (PEventBreakpointsSetInstrumentationBreakpoint
-> PEventBreakpointsSetInstrumentationBreakpoint -> Bool
(PEventBreakpointsSetInstrumentationBreakpoint
 -> PEventBreakpointsSetInstrumentationBreakpoint -> Bool)
-> (PEventBreakpointsSetInstrumentationBreakpoint
    -> PEventBreakpointsSetInstrumentationBreakpoint -> Bool)
-> Eq PEventBreakpointsSetInstrumentationBreakpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PEventBreakpointsSetInstrumentationBreakpoint
-> PEventBreakpointsSetInstrumentationBreakpoint -> Bool
$c/= :: PEventBreakpointsSetInstrumentationBreakpoint
-> PEventBreakpointsSetInstrumentationBreakpoint -> Bool
== :: PEventBreakpointsSetInstrumentationBreakpoint
-> PEventBreakpointsSetInstrumentationBreakpoint -> Bool
$c== :: PEventBreakpointsSetInstrumentationBreakpoint
-> PEventBreakpointsSetInstrumentationBreakpoint -> Bool
Eq, Int -> PEventBreakpointsSetInstrumentationBreakpoint -> ShowS
[PEventBreakpointsSetInstrumentationBreakpoint] -> ShowS
PEventBreakpointsSetInstrumentationBreakpoint -> String
(Int -> PEventBreakpointsSetInstrumentationBreakpoint -> ShowS)
-> (PEventBreakpointsSetInstrumentationBreakpoint -> String)
-> ([PEventBreakpointsSetInstrumentationBreakpoint] -> ShowS)
-> Show PEventBreakpointsSetInstrumentationBreakpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PEventBreakpointsSetInstrumentationBreakpoint] -> ShowS
$cshowList :: [PEventBreakpointsSetInstrumentationBreakpoint] -> ShowS
show :: PEventBreakpointsSetInstrumentationBreakpoint -> String
$cshow :: PEventBreakpointsSetInstrumentationBreakpoint -> String
showsPrec :: Int -> PEventBreakpointsSetInstrumentationBreakpoint -> ShowS
$cshowsPrec :: Int -> PEventBreakpointsSetInstrumentationBreakpoint -> ShowS
Show)
pEventBreakpointsSetInstrumentationBreakpoint
  {-
  -- | Instrumentation name to stop on.
  -}
  :: T.Text
  -> PEventBreakpointsSetInstrumentationBreakpoint
pEventBreakpointsSetInstrumentationBreakpoint :: Text -> PEventBreakpointsSetInstrumentationBreakpoint
pEventBreakpointsSetInstrumentationBreakpoint
  Text
arg_pEventBreakpointsSetInstrumentationBreakpointEventName
  = Text -> PEventBreakpointsSetInstrumentationBreakpoint
PEventBreakpointsSetInstrumentationBreakpoint
    Text
arg_pEventBreakpointsSetInstrumentationBreakpointEventName
instance ToJSON PEventBreakpointsSetInstrumentationBreakpoint where
  toJSON :: PEventBreakpointsSetInstrumentationBreakpoint -> Value
toJSON PEventBreakpointsSetInstrumentationBreakpoint
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 [
    (Text
"eventName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PEventBreakpointsSetInstrumentationBreakpoint -> Text
pEventBreakpointsSetInstrumentationBreakpointEventName PEventBreakpointsSetInstrumentationBreakpoint
p)
    ]
instance Command PEventBreakpointsSetInstrumentationBreakpoint where
  type CommandResponse PEventBreakpointsSetInstrumentationBreakpoint = ()
  commandName :: Proxy PEventBreakpointsSetInstrumentationBreakpoint -> String
commandName Proxy PEventBreakpointsSetInstrumentationBreakpoint
_ = String
"EventBreakpoints.setInstrumentationBreakpoint"
  fromJSON :: Proxy PEventBreakpointsSetInstrumentationBreakpoint
-> Value
-> Result
     (CommandResponse PEventBreakpointsSetInstrumentationBreakpoint)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PEventBreakpointsSetInstrumentationBreakpoint
    -> Result ())
-> Proxy PEventBreakpointsSetInstrumentationBreakpoint
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PEventBreakpointsSetInstrumentationBreakpoint -> ())
-> Proxy PEventBreakpointsSetInstrumentationBreakpoint
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PEventBreakpointsSetInstrumentationBreakpoint -> ()
forall a b. a -> b -> a
const ()

-- | Removes breakpoint on particular native event.

-- | Parameters of the 'EventBreakpoints.removeInstrumentationBreakpoint' command.
data PEventBreakpointsRemoveInstrumentationBreakpoint = PEventBreakpointsRemoveInstrumentationBreakpoint
  {
    -- | Instrumentation name to stop on.
    PEventBreakpointsRemoveInstrumentationBreakpoint -> Text
pEventBreakpointsRemoveInstrumentationBreakpointEventName :: T.Text
  }
  deriving (PEventBreakpointsRemoveInstrumentationBreakpoint
-> PEventBreakpointsRemoveInstrumentationBreakpoint -> Bool
(PEventBreakpointsRemoveInstrumentationBreakpoint
 -> PEventBreakpointsRemoveInstrumentationBreakpoint -> Bool)
-> (PEventBreakpointsRemoveInstrumentationBreakpoint
    -> PEventBreakpointsRemoveInstrumentationBreakpoint -> Bool)
-> Eq PEventBreakpointsRemoveInstrumentationBreakpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PEventBreakpointsRemoveInstrumentationBreakpoint
-> PEventBreakpointsRemoveInstrumentationBreakpoint -> Bool
$c/= :: PEventBreakpointsRemoveInstrumentationBreakpoint
-> PEventBreakpointsRemoveInstrumentationBreakpoint -> Bool
== :: PEventBreakpointsRemoveInstrumentationBreakpoint
-> PEventBreakpointsRemoveInstrumentationBreakpoint -> Bool
$c== :: PEventBreakpointsRemoveInstrumentationBreakpoint
-> PEventBreakpointsRemoveInstrumentationBreakpoint -> Bool
Eq, Int -> PEventBreakpointsRemoveInstrumentationBreakpoint -> ShowS
[PEventBreakpointsRemoveInstrumentationBreakpoint] -> ShowS
PEventBreakpointsRemoveInstrumentationBreakpoint -> String
(Int -> PEventBreakpointsRemoveInstrumentationBreakpoint -> ShowS)
-> (PEventBreakpointsRemoveInstrumentationBreakpoint -> String)
-> ([PEventBreakpointsRemoveInstrumentationBreakpoint] -> ShowS)
-> Show PEventBreakpointsRemoveInstrumentationBreakpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PEventBreakpointsRemoveInstrumentationBreakpoint] -> ShowS
$cshowList :: [PEventBreakpointsRemoveInstrumentationBreakpoint] -> ShowS
show :: PEventBreakpointsRemoveInstrumentationBreakpoint -> String
$cshow :: PEventBreakpointsRemoveInstrumentationBreakpoint -> String
showsPrec :: Int -> PEventBreakpointsRemoveInstrumentationBreakpoint -> ShowS
$cshowsPrec :: Int -> PEventBreakpointsRemoveInstrumentationBreakpoint -> ShowS
Show)
pEventBreakpointsRemoveInstrumentationBreakpoint
  {-
  -- | Instrumentation name to stop on.
  -}
  :: T.Text
  -> PEventBreakpointsRemoveInstrumentationBreakpoint
pEventBreakpointsRemoveInstrumentationBreakpoint :: Text -> PEventBreakpointsRemoveInstrumentationBreakpoint
pEventBreakpointsRemoveInstrumentationBreakpoint
  Text
arg_pEventBreakpointsRemoveInstrumentationBreakpointEventName
  = Text -> PEventBreakpointsRemoveInstrumentationBreakpoint
PEventBreakpointsRemoveInstrumentationBreakpoint
    Text
arg_pEventBreakpointsRemoveInstrumentationBreakpointEventName
instance ToJSON PEventBreakpointsRemoveInstrumentationBreakpoint where
  toJSON :: PEventBreakpointsRemoveInstrumentationBreakpoint -> Value
toJSON PEventBreakpointsRemoveInstrumentationBreakpoint
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 [
    (Text
"eventName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PEventBreakpointsRemoveInstrumentationBreakpoint -> Text
pEventBreakpointsRemoveInstrumentationBreakpointEventName PEventBreakpointsRemoveInstrumentationBreakpoint
p)
    ]
instance Command PEventBreakpointsRemoveInstrumentationBreakpoint where
  type CommandResponse PEventBreakpointsRemoveInstrumentationBreakpoint = ()
  commandName :: Proxy PEventBreakpointsRemoveInstrumentationBreakpoint -> String
commandName Proxy PEventBreakpointsRemoveInstrumentationBreakpoint
_ = String
"EventBreakpoints.removeInstrumentationBreakpoint"
  fromJSON :: Proxy PEventBreakpointsRemoveInstrumentationBreakpoint
-> Value
-> Result
     (CommandResponse PEventBreakpointsRemoveInstrumentationBreakpoint)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PEventBreakpointsRemoveInstrumentationBreakpoint
    -> Result ())
-> Proxy PEventBreakpointsRemoveInstrumentationBreakpoint
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PEventBreakpointsRemoveInstrumentationBreakpoint -> ())
-> Proxy PEventBreakpointsRemoveInstrumentationBreakpoint
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PEventBreakpointsRemoveInstrumentationBreakpoint -> ()
forall a b. a -> b -> a
const ()