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


{- |
= Inspector

-}


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




-- | Type of the 'Inspector.detached' event.
data InspectorDetached = InspectorDetached
  {
    -- | The reason why connection has been terminated.
    InspectorDetached -> Text
inspectorDetachedReason :: T.Text
  }
  deriving (InspectorDetached -> InspectorDetached -> Bool
(InspectorDetached -> InspectorDetached -> Bool)
-> (InspectorDetached -> InspectorDetached -> Bool)
-> Eq InspectorDetached
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InspectorDetached -> InspectorDetached -> Bool
$c/= :: InspectorDetached -> InspectorDetached -> Bool
== :: InspectorDetached -> InspectorDetached -> Bool
$c== :: InspectorDetached -> InspectorDetached -> Bool
Eq, Int -> InspectorDetached -> ShowS
[InspectorDetached] -> ShowS
InspectorDetached -> String
(Int -> InspectorDetached -> ShowS)
-> (InspectorDetached -> String)
-> ([InspectorDetached] -> ShowS)
-> Show InspectorDetached
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InspectorDetached] -> ShowS
$cshowList :: [InspectorDetached] -> ShowS
show :: InspectorDetached -> String
$cshow :: InspectorDetached -> String
showsPrec :: Int -> InspectorDetached -> ShowS
$cshowsPrec :: Int -> InspectorDetached -> ShowS
Show)
instance FromJSON InspectorDetached where
  parseJSON :: Value -> Parser InspectorDetached
parseJSON = String
-> (Object -> Parser InspectorDetached)
-> Value
-> Parser InspectorDetached
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"InspectorDetached" ((Object -> Parser InspectorDetached)
 -> Value -> Parser InspectorDetached)
-> (Object -> Parser InspectorDetached)
-> Value
-> Parser InspectorDetached
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> InspectorDetached
InspectorDetached
    (Text -> InspectorDetached)
-> Parser Text -> Parser InspectorDetached
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"reason"
instance Event InspectorDetached where
  eventName :: Proxy InspectorDetached -> String
eventName Proxy InspectorDetached
_ = String
"Inspector.detached"

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

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

-- | Disables inspector domain notifications.

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

-- | Enables inspector domain notifications.

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