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


{- |
= Browser

The Browser domain defines methods and events for browser managing.
= Target

Supports additional targets discovery and allows to attach to them.
-}


module CDP.Domains.BrowserTarget (module CDP.Domains.BrowserTarget) 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.DOMPageNetworkEmulationSecurity as DOMPageNetworkEmulationSecurity


-- | Type 'Browser.BrowserContextID'.
type BrowserBrowserContextID = T.Text

-- | Type 'Browser.WindowID'.
type BrowserWindowID = Int

-- | Type 'Browser.WindowState'.
--   The state of the browser window.
data BrowserWindowState = BrowserWindowStateNormal | BrowserWindowStateMinimized | BrowserWindowStateMaximized | BrowserWindowStateFullscreen
  deriving (Eq BrowserWindowState
Eq BrowserWindowState
-> (BrowserWindowState -> BrowserWindowState -> Ordering)
-> (BrowserWindowState -> BrowserWindowState -> Bool)
-> (BrowserWindowState -> BrowserWindowState -> Bool)
-> (BrowserWindowState -> BrowserWindowState -> Bool)
-> (BrowserWindowState -> BrowserWindowState -> Bool)
-> (BrowserWindowState -> BrowserWindowState -> BrowserWindowState)
-> (BrowserWindowState -> BrowserWindowState -> BrowserWindowState)
-> Ord BrowserWindowState
BrowserWindowState -> BrowserWindowState -> Bool
BrowserWindowState -> BrowserWindowState -> Ordering
BrowserWindowState -> BrowserWindowState -> BrowserWindowState
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 :: BrowserWindowState -> BrowserWindowState -> BrowserWindowState
$cmin :: BrowserWindowState -> BrowserWindowState -> BrowserWindowState
max :: BrowserWindowState -> BrowserWindowState -> BrowserWindowState
$cmax :: BrowserWindowState -> BrowserWindowState -> BrowserWindowState
>= :: BrowserWindowState -> BrowserWindowState -> Bool
$c>= :: BrowserWindowState -> BrowserWindowState -> Bool
> :: BrowserWindowState -> BrowserWindowState -> Bool
$c> :: BrowserWindowState -> BrowserWindowState -> Bool
<= :: BrowserWindowState -> BrowserWindowState -> Bool
$c<= :: BrowserWindowState -> BrowserWindowState -> Bool
< :: BrowserWindowState -> BrowserWindowState -> Bool
$c< :: BrowserWindowState -> BrowserWindowState -> Bool
compare :: BrowserWindowState -> BrowserWindowState -> Ordering
$ccompare :: BrowserWindowState -> BrowserWindowState -> Ordering
$cp1Ord :: Eq BrowserWindowState
Ord, BrowserWindowState -> BrowserWindowState -> Bool
(BrowserWindowState -> BrowserWindowState -> Bool)
-> (BrowserWindowState -> BrowserWindowState -> Bool)
-> Eq BrowserWindowState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserWindowState -> BrowserWindowState -> Bool
$c/= :: BrowserWindowState -> BrowserWindowState -> Bool
== :: BrowserWindowState -> BrowserWindowState -> Bool
$c== :: BrowserWindowState -> BrowserWindowState -> Bool
Eq, Int -> BrowserWindowState -> ShowS
[BrowserWindowState] -> ShowS
BrowserWindowState -> String
(Int -> BrowserWindowState -> ShowS)
-> (BrowserWindowState -> String)
-> ([BrowserWindowState] -> ShowS)
-> Show BrowserWindowState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserWindowState] -> ShowS
$cshowList :: [BrowserWindowState] -> ShowS
show :: BrowserWindowState -> String
$cshow :: BrowserWindowState -> String
showsPrec :: Int -> BrowserWindowState -> ShowS
$cshowsPrec :: Int -> BrowserWindowState -> ShowS
Show, ReadPrec [BrowserWindowState]
ReadPrec BrowserWindowState
Int -> ReadS BrowserWindowState
ReadS [BrowserWindowState]
(Int -> ReadS BrowserWindowState)
-> ReadS [BrowserWindowState]
-> ReadPrec BrowserWindowState
-> ReadPrec [BrowserWindowState]
-> Read BrowserWindowState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BrowserWindowState]
$creadListPrec :: ReadPrec [BrowserWindowState]
readPrec :: ReadPrec BrowserWindowState
$creadPrec :: ReadPrec BrowserWindowState
readList :: ReadS [BrowserWindowState]
$creadList :: ReadS [BrowserWindowState]
readsPrec :: Int -> ReadS BrowserWindowState
$creadsPrec :: Int -> ReadS BrowserWindowState
Read)
instance FromJSON BrowserWindowState where
  parseJSON :: Value -> Parser BrowserWindowState
parseJSON = String
-> (Text -> Parser BrowserWindowState)
-> Value
-> Parser BrowserWindowState
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"BrowserWindowState" ((Text -> Parser BrowserWindowState)
 -> Value -> Parser BrowserWindowState)
-> (Text -> Parser BrowserWindowState)
-> Value
-> Parser BrowserWindowState
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"normal" -> BrowserWindowState -> Parser BrowserWindowState
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserWindowState
BrowserWindowStateNormal
    Text
"minimized" -> BrowserWindowState -> Parser BrowserWindowState
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserWindowState
BrowserWindowStateMinimized
    Text
"maximized" -> BrowserWindowState -> Parser BrowserWindowState
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserWindowState
BrowserWindowStateMaximized
    Text
"fullscreen" -> BrowserWindowState -> Parser BrowserWindowState
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserWindowState
BrowserWindowStateFullscreen
    Text
"_" -> String -> Parser BrowserWindowState
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse BrowserWindowState"
instance ToJSON BrowserWindowState where
  toJSON :: BrowserWindowState -> Value
toJSON BrowserWindowState
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case BrowserWindowState
v of
    BrowserWindowState
BrowserWindowStateNormal -> Text
"normal"
    BrowserWindowState
BrowserWindowStateMinimized -> Text
"minimized"
    BrowserWindowState
BrowserWindowStateMaximized -> Text
"maximized"
    BrowserWindowState
BrowserWindowStateFullscreen -> Text
"fullscreen"

-- | Type 'Browser.Bounds'.
--   Browser window bounds information
data BrowserBounds = BrowserBounds
  {
    -- | The offset from the left edge of the screen to the window in pixels.
    BrowserBounds -> Maybe Int
browserBoundsLeft :: Maybe Int,
    -- | The offset from the top edge of the screen to the window in pixels.
    BrowserBounds -> Maybe Int
browserBoundsTop :: Maybe Int,
    -- | The window width in pixels.
    BrowserBounds -> Maybe Int
browserBoundsWidth :: Maybe Int,
    -- | The window height in pixels.
    BrowserBounds -> Maybe Int
browserBoundsHeight :: Maybe Int,
    -- | The window state. Default to normal.
    BrowserBounds -> Maybe BrowserWindowState
browserBoundsWindowState :: Maybe BrowserWindowState
  }
  deriving (BrowserBounds -> BrowserBounds -> Bool
(BrowserBounds -> BrowserBounds -> Bool)
-> (BrowserBounds -> BrowserBounds -> Bool) -> Eq BrowserBounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserBounds -> BrowserBounds -> Bool
$c/= :: BrowserBounds -> BrowserBounds -> Bool
== :: BrowserBounds -> BrowserBounds -> Bool
$c== :: BrowserBounds -> BrowserBounds -> Bool
Eq, Int -> BrowserBounds -> ShowS
[BrowserBounds] -> ShowS
BrowserBounds -> String
(Int -> BrowserBounds -> ShowS)
-> (BrowserBounds -> String)
-> ([BrowserBounds] -> ShowS)
-> Show BrowserBounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserBounds] -> ShowS
$cshowList :: [BrowserBounds] -> ShowS
show :: BrowserBounds -> String
$cshow :: BrowserBounds -> String
showsPrec :: Int -> BrowserBounds -> ShowS
$cshowsPrec :: Int -> BrowserBounds -> ShowS
Show)
instance FromJSON BrowserBounds where
  parseJSON :: Value -> Parser BrowserBounds
parseJSON = String
-> (Object -> Parser BrowserBounds)
-> Value
-> Parser BrowserBounds
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BrowserBounds" ((Object -> Parser BrowserBounds) -> Value -> Parser BrowserBounds)
-> (Object -> Parser BrowserBounds)
-> Value
-> Parser BrowserBounds
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe BrowserWindowState
-> BrowserBounds
BrowserBounds
    (Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe BrowserWindowState
 -> BrowserBounds)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe BrowserWindowState
      -> BrowserBounds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"left"
    Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe BrowserWindowState
   -> BrowserBounds)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int -> Maybe BrowserWindowState -> BrowserBounds)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"top"
    Parser
  (Maybe Int
   -> Maybe Int -> Maybe BrowserWindowState -> BrowserBounds)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Maybe BrowserWindowState -> BrowserBounds)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"width"
    Parser (Maybe Int -> Maybe BrowserWindowState -> BrowserBounds)
-> Parser (Maybe Int)
-> Parser (Maybe BrowserWindowState -> BrowserBounds)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"height"
    Parser (Maybe BrowserWindowState -> BrowserBounds)
-> Parser (Maybe BrowserWindowState) -> Parser BrowserBounds
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe BrowserWindowState)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"windowState"
instance ToJSON BrowserBounds where
  toJSON :: BrowserBounds -> Value
toJSON BrowserBounds
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
"left" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BrowserBounds -> Maybe Int
browserBoundsLeft BrowserBounds
p),
    (Text
"top" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BrowserBounds -> Maybe Int
browserBoundsTop BrowserBounds
p),
    (Text
"width" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BrowserBounds -> Maybe Int
browserBoundsWidth BrowserBounds
p),
    (Text
"height" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BrowserBounds -> Maybe Int
browserBoundsHeight BrowserBounds
p),
    (Text
"windowState" Text -> BrowserWindowState -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (BrowserWindowState -> Pair)
-> Maybe BrowserWindowState -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BrowserBounds -> Maybe BrowserWindowState
browserBoundsWindowState BrowserBounds
p)
    ]

-- | Type 'Browser.PermissionType'.
data BrowserPermissionType = BrowserPermissionTypeAccessibilityEvents | BrowserPermissionTypeAudioCapture | BrowserPermissionTypeBackgroundSync | BrowserPermissionTypeBackgroundFetch | BrowserPermissionTypeClipboardReadWrite | BrowserPermissionTypeClipboardSanitizedWrite | BrowserPermissionTypeDisplayCapture | BrowserPermissionTypeDurableStorage | BrowserPermissionTypeFlash | BrowserPermissionTypeGeolocation | BrowserPermissionTypeMidi | BrowserPermissionTypeMidiSysex | BrowserPermissionTypeNfc | BrowserPermissionTypeNotifications | BrowserPermissionTypePaymentHandler | BrowserPermissionTypePeriodicBackgroundSync | BrowserPermissionTypeProtectedMediaIdentifier | BrowserPermissionTypeSensors | BrowserPermissionTypeVideoCapture | BrowserPermissionTypeVideoCapturePanTiltZoom | BrowserPermissionTypeIdleDetection | BrowserPermissionTypeWakeLockScreen | BrowserPermissionTypeWakeLockSystem
  deriving (Eq BrowserPermissionType
Eq BrowserPermissionType
-> (BrowserPermissionType -> BrowserPermissionType -> Ordering)
-> (BrowserPermissionType -> BrowserPermissionType -> Bool)
-> (BrowserPermissionType -> BrowserPermissionType -> Bool)
-> (BrowserPermissionType -> BrowserPermissionType -> Bool)
-> (BrowserPermissionType -> BrowserPermissionType -> Bool)
-> (BrowserPermissionType
    -> BrowserPermissionType -> BrowserPermissionType)
-> (BrowserPermissionType
    -> BrowserPermissionType -> BrowserPermissionType)
-> Ord BrowserPermissionType
BrowserPermissionType -> BrowserPermissionType -> Bool
BrowserPermissionType -> BrowserPermissionType -> Ordering
BrowserPermissionType
-> BrowserPermissionType -> BrowserPermissionType
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 :: BrowserPermissionType
-> BrowserPermissionType -> BrowserPermissionType
$cmin :: BrowserPermissionType
-> BrowserPermissionType -> BrowserPermissionType
max :: BrowserPermissionType
-> BrowserPermissionType -> BrowserPermissionType
$cmax :: BrowserPermissionType
-> BrowserPermissionType -> BrowserPermissionType
>= :: BrowserPermissionType -> BrowserPermissionType -> Bool
$c>= :: BrowserPermissionType -> BrowserPermissionType -> Bool
> :: BrowserPermissionType -> BrowserPermissionType -> Bool
$c> :: BrowserPermissionType -> BrowserPermissionType -> Bool
<= :: BrowserPermissionType -> BrowserPermissionType -> Bool
$c<= :: BrowserPermissionType -> BrowserPermissionType -> Bool
< :: BrowserPermissionType -> BrowserPermissionType -> Bool
$c< :: BrowserPermissionType -> BrowserPermissionType -> Bool
compare :: BrowserPermissionType -> BrowserPermissionType -> Ordering
$ccompare :: BrowserPermissionType -> BrowserPermissionType -> Ordering
$cp1Ord :: Eq BrowserPermissionType
Ord, BrowserPermissionType -> BrowserPermissionType -> Bool
(BrowserPermissionType -> BrowserPermissionType -> Bool)
-> (BrowserPermissionType -> BrowserPermissionType -> Bool)
-> Eq BrowserPermissionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserPermissionType -> BrowserPermissionType -> Bool
$c/= :: BrowserPermissionType -> BrowserPermissionType -> Bool
== :: BrowserPermissionType -> BrowserPermissionType -> Bool
$c== :: BrowserPermissionType -> BrowserPermissionType -> Bool
Eq, Int -> BrowserPermissionType -> ShowS
[BrowserPermissionType] -> ShowS
BrowserPermissionType -> String
(Int -> BrowserPermissionType -> ShowS)
-> (BrowserPermissionType -> String)
-> ([BrowserPermissionType] -> ShowS)
-> Show BrowserPermissionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserPermissionType] -> ShowS
$cshowList :: [BrowserPermissionType] -> ShowS
show :: BrowserPermissionType -> String
$cshow :: BrowserPermissionType -> String
showsPrec :: Int -> BrowserPermissionType -> ShowS
$cshowsPrec :: Int -> BrowserPermissionType -> ShowS
Show, ReadPrec [BrowserPermissionType]
ReadPrec BrowserPermissionType
Int -> ReadS BrowserPermissionType
ReadS [BrowserPermissionType]
(Int -> ReadS BrowserPermissionType)
-> ReadS [BrowserPermissionType]
-> ReadPrec BrowserPermissionType
-> ReadPrec [BrowserPermissionType]
-> Read BrowserPermissionType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BrowserPermissionType]
$creadListPrec :: ReadPrec [BrowserPermissionType]
readPrec :: ReadPrec BrowserPermissionType
$creadPrec :: ReadPrec BrowserPermissionType
readList :: ReadS [BrowserPermissionType]
$creadList :: ReadS [BrowserPermissionType]
readsPrec :: Int -> ReadS BrowserPermissionType
$creadsPrec :: Int -> ReadS BrowserPermissionType
Read)
instance FromJSON BrowserPermissionType where
  parseJSON :: Value -> Parser BrowserPermissionType
parseJSON = String
-> (Text -> Parser BrowserPermissionType)
-> Value
-> Parser BrowserPermissionType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"BrowserPermissionType" ((Text -> Parser BrowserPermissionType)
 -> Value -> Parser BrowserPermissionType)
-> (Text -> Parser BrowserPermissionType)
-> Value
-> Parser BrowserPermissionType
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"accessibilityEvents" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeAccessibilityEvents
    Text
"audioCapture" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeAudioCapture
    Text
"backgroundSync" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeBackgroundSync
    Text
"backgroundFetch" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeBackgroundFetch
    Text
"clipboardReadWrite" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeClipboardReadWrite
    Text
"clipboardSanitizedWrite" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeClipboardSanitizedWrite
    Text
"displayCapture" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeDisplayCapture
    Text
"durableStorage" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeDurableStorage
    Text
"flash" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeFlash
    Text
"geolocation" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeGeolocation
    Text
"midi" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeMidi
    Text
"midiSysex" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeMidiSysex
    Text
"nfc" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeNfc
    Text
"notifications" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeNotifications
    Text
"paymentHandler" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypePaymentHandler
    Text
"periodicBackgroundSync" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypePeriodicBackgroundSync
    Text
"protectedMediaIdentifier" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeProtectedMediaIdentifier
    Text
"sensors" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeSensors
    Text
"videoCapture" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeVideoCapture
    Text
"videoCapturePanTiltZoom" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeVideoCapturePanTiltZoom
    Text
"idleDetection" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeIdleDetection
    Text
"wakeLockScreen" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeWakeLockScreen
    Text
"wakeLockSystem" -> BrowserPermissionType -> Parser BrowserPermissionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionType
BrowserPermissionTypeWakeLockSystem
    Text
"_" -> String -> Parser BrowserPermissionType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse BrowserPermissionType"
instance ToJSON BrowserPermissionType where
  toJSON :: BrowserPermissionType -> Value
toJSON BrowserPermissionType
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case BrowserPermissionType
v of
    BrowserPermissionType
BrowserPermissionTypeAccessibilityEvents -> Text
"accessibilityEvents"
    BrowserPermissionType
BrowserPermissionTypeAudioCapture -> Text
"audioCapture"
    BrowserPermissionType
BrowserPermissionTypeBackgroundSync -> Text
"backgroundSync"
    BrowserPermissionType
BrowserPermissionTypeBackgroundFetch -> Text
"backgroundFetch"
    BrowserPermissionType
BrowserPermissionTypeClipboardReadWrite -> Text
"clipboardReadWrite"
    BrowserPermissionType
BrowserPermissionTypeClipboardSanitizedWrite -> Text
"clipboardSanitizedWrite"
    BrowserPermissionType
BrowserPermissionTypeDisplayCapture -> Text
"displayCapture"
    BrowserPermissionType
BrowserPermissionTypeDurableStorage -> Text
"durableStorage"
    BrowserPermissionType
BrowserPermissionTypeFlash -> Text
"flash"
    BrowserPermissionType
BrowserPermissionTypeGeolocation -> Text
"geolocation"
    BrowserPermissionType
BrowserPermissionTypeMidi -> Text
"midi"
    BrowserPermissionType
BrowserPermissionTypeMidiSysex -> Text
"midiSysex"
    BrowserPermissionType
BrowserPermissionTypeNfc -> Text
"nfc"
    BrowserPermissionType
BrowserPermissionTypeNotifications -> Text
"notifications"
    BrowserPermissionType
BrowserPermissionTypePaymentHandler -> Text
"paymentHandler"
    BrowserPermissionType
BrowserPermissionTypePeriodicBackgroundSync -> Text
"periodicBackgroundSync"
    BrowserPermissionType
BrowserPermissionTypeProtectedMediaIdentifier -> Text
"protectedMediaIdentifier"
    BrowserPermissionType
BrowserPermissionTypeSensors -> Text
"sensors"
    BrowserPermissionType
BrowserPermissionTypeVideoCapture -> Text
"videoCapture"
    BrowserPermissionType
BrowserPermissionTypeVideoCapturePanTiltZoom -> Text
"videoCapturePanTiltZoom"
    BrowserPermissionType
BrowserPermissionTypeIdleDetection -> Text
"idleDetection"
    BrowserPermissionType
BrowserPermissionTypeWakeLockScreen -> Text
"wakeLockScreen"
    BrowserPermissionType
BrowserPermissionTypeWakeLockSystem -> Text
"wakeLockSystem"

-- | Type 'Browser.PermissionSetting'.
data BrowserPermissionSetting = BrowserPermissionSettingGranted | BrowserPermissionSettingDenied | BrowserPermissionSettingPrompt
  deriving (Eq BrowserPermissionSetting
Eq BrowserPermissionSetting
-> (BrowserPermissionSetting
    -> BrowserPermissionSetting -> Ordering)
-> (BrowserPermissionSetting -> BrowserPermissionSetting -> Bool)
-> (BrowserPermissionSetting -> BrowserPermissionSetting -> Bool)
-> (BrowserPermissionSetting -> BrowserPermissionSetting -> Bool)
-> (BrowserPermissionSetting -> BrowserPermissionSetting -> Bool)
-> (BrowserPermissionSetting
    -> BrowserPermissionSetting -> BrowserPermissionSetting)
-> (BrowserPermissionSetting
    -> BrowserPermissionSetting -> BrowserPermissionSetting)
-> Ord BrowserPermissionSetting
BrowserPermissionSetting -> BrowserPermissionSetting -> Bool
BrowserPermissionSetting -> BrowserPermissionSetting -> Ordering
BrowserPermissionSetting
-> BrowserPermissionSetting -> BrowserPermissionSetting
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 :: BrowserPermissionSetting
-> BrowserPermissionSetting -> BrowserPermissionSetting
$cmin :: BrowserPermissionSetting
-> BrowserPermissionSetting -> BrowserPermissionSetting
max :: BrowserPermissionSetting
-> BrowserPermissionSetting -> BrowserPermissionSetting
$cmax :: BrowserPermissionSetting
-> BrowserPermissionSetting -> BrowserPermissionSetting
>= :: BrowserPermissionSetting -> BrowserPermissionSetting -> Bool
$c>= :: BrowserPermissionSetting -> BrowserPermissionSetting -> Bool
> :: BrowserPermissionSetting -> BrowserPermissionSetting -> Bool
$c> :: BrowserPermissionSetting -> BrowserPermissionSetting -> Bool
<= :: BrowserPermissionSetting -> BrowserPermissionSetting -> Bool
$c<= :: BrowserPermissionSetting -> BrowserPermissionSetting -> Bool
< :: BrowserPermissionSetting -> BrowserPermissionSetting -> Bool
$c< :: BrowserPermissionSetting -> BrowserPermissionSetting -> Bool
compare :: BrowserPermissionSetting -> BrowserPermissionSetting -> Ordering
$ccompare :: BrowserPermissionSetting -> BrowserPermissionSetting -> Ordering
$cp1Ord :: Eq BrowserPermissionSetting
Ord, BrowserPermissionSetting -> BrowserPermissionSetting -> Bool
(BrowserPermissionSetting -> BrowserPermissionSetting -> Bool)
-> (BrowserPermissionSetting -> BrowserPermissionSetting -> Bool)
-> Eq BrowserPermissionSetting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserPermissionSetting -> BrowserPermissionSetting -> Bool
$c/= :: BrowserPermissionSetting -> BrowserPermissionSetting -> Bool
== :: BrowserPermissionSetting -> BrowserPermissionSetting -> Bool
$c== :: BrowserPermissionSetting -> BrowserPermissionSetting -> Bool
Eq, Int -> BrowserPermissionSetting -> ShowS
[BrowserPermissionSetting] -> ShowS
BrowserPermissionSetting -> String
(Int -> BrowserPermissionSetting -> ShowS)
-> (BrowserPermissionSetting -> String)
-> ([BrowserPermissionSetting] -> ShowS)
-> Show BrowserPermissionSetting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserPermissionSetting] -> ShowS
$cshowList :: [BrowserPermissionSetting] -> ShowS
show :: BrowserPermissionSetting -> String
$cshow :: BrowserPermissionSetting -> String
showsPrec :: Int -> BrowserPermissionSetting -> ShowS
$cshowsPrec :: Int -> BrowserPermissionSetting -> ShowS
Show, ReadPrec [BrowserPermissionSetting]
ReadPrec BrowserPermissionSetting
Int -> ReadS BrowserPermissionSetting
ReadS [BrowserPermissionSetting]
(Int -> ReadS BrowserPermissionSetting)
-> ReadS [BrowserPermissionSetting]
-> ReadPrec BrowserPermissionSetting
-> ReadPrec [BrowserPermissionSetting]
-> Read BrowserPermissionSetting
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BrowserPermissionSetting]
$creadListPrec :: ReadPrec [BrowserPermissionSetting]
readPrec :: ReadPrec BrowserPermissionSetting
$creadPrec :: ReadPrec BrowserPermissionSetting
readList :: ReadS [BrowserPermissionSetting]
$creadList :: ReadS [BrowserPermissionSetting]
readsPrec :: Int -> ReadS BrowserPermissionSetting
$creadsPrec :: Int -> ReadS BrowserPermissionSetting
Read)
instance FromJSON BrowserPermissionSetting where
  parseJSON :: Value -> Parser BrowserPermissionSetting
parseJSON = String
-> (Text -> Parser BrowserPermissionSetting)
-> Value
-> Parser BrowserPermissionSetting
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"BrowserPermissionSetting" ((Text -> Parser BrowserPermissionSetting)
 -> Value -> Parser BrowserPermissionSetting)
-> (Text -> Parser BrowserPermissionSetting)
-> Value
-> Parser BrowserPermissionSetting
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"granted" -> BrowserPermissionSetting -> Parser BrowserPermissionSetting
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionSetting
BrowserPermissionSettingGranted
    Text
"denied" -> BrowserPermissionSetting -> Parser BrowserPermissionSetting
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionSetting
BrowserPermissionSettingDenied
    Text
"prompt" -> BrowserPermissionSetting -> Parser BrowserPermissionSetting
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserPermissionSetting
BrowserPermissionSettingPrompt
    Text
"_" -> String -> Parser BrowserPermissionSetting
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse BrowserPermissionSetting"
instance ToJSON BrowserPermissionSetting where
  toJSON :: BrowserPermissionSetting -> Value
toJSON BrowserPermissionSetting
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case BrowserPermissionSetting
v of
    BrowserPermissionSetting
BrowserPermissionSettingGranted -> Text
"granted"
    BrowserPermissionSetting
BrowserPermissionSettingDenied -> Text
"denied"
    BrowserPermissionSetting
BrowserPermissionSettingPrompt -> Text
"prompt"

-- | Type 'Browser.PermissionDescriptor'.
--   Definition of PermissionDescriptor defined in the Permissions API:
--   https://w3c.github.io/permissions/#dictdef-permissiondescriptor.
data BrowserPermissionDescriptor = BrowserPermissionDescriptor
  {
    -- | Name of permission.
    --   See https://cs.chromium.org/chromium/src/third_party/blink/renderer/modules/permissions/permission_descriptor.idl for valid permission names.
    BrowserPermissionDescriptor -> Text
browserPermissionDescriptorName :: T.Text,
    -- | For "midi" permission, may also specify sysex control.
    BrowserPermissionDescriptor -> Maybe Bool
browserPermissionDescriptorSysex :: Maybe Bool,
    -- | For "push" permission, may specify userVisibleOnly.
    --   Note that userVisibleOnly = true is the only currently supported type.
    BrowserPermissionDescriptor -> Maybe Bool
browserPermissionDescriptorUserVisibleOnly :: Maybe Bool,
    -- | For "clipboard" permission, may specify allowWithoutSanitization.
    BrowserPermissionDescriptor -> Maybe Bool
browserPermissionDescriptorAllowWithoutSanitization :: Maybe Bool,
    -- | For "camera" permission, may specify panTiltZoom.
    BrowserPermissionDescriptor -> Maybe Bool
browserPermissionDescriptorPanTiltZoom :: Maybe Bool
  }
  deriving (BrowserPermissionDescriptor -> BrowserPermissionDescriptor -> Bool
(BrowserPermissionDescriptor
 -> BrowserPermissionDescriptor -> Bool)
-> (BrowserPermissionDescriptor
    -> BrowserPermissionDescriptor -> Bool)
-> Eq BrowserPermissionDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserPermissionDescriptor -> BrowserPermissionDescriptor -> Bool
$c/= :: BrowserPermissionDescriptor -> BrowserPermissionDescriptor -> Bool
== :: BrowserPermissionDescriptor -> BrowserPermissionDescriptor -> Bool
$c== :: BrowserPermissionDescriptor -> BrowserPermissionDescriptor -> Bool
Eq, Int -> BrowserPermissionDescriptor -> ShowS
[BrowserPermissionDescriptor] -> ShowS
BrowserPermissionDescriptor -> String
(Int -> BrowserPermissionDescriptor -> ShowS)
-> (BrowserPermissionDescriptor -> String)
-> ([BrowserPermissionDescriptor] -> ShowS)
-> Show BrowserPermissionDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserPermissionDescriptor] -> ShowS
$cshowList :: [BrowserPermissionDescriptor] -> ShowS
show :: BrowserPermissionDescriptor -> String
$cshow :: BrowserPermissionDescriptor -> String
showsPrec :: Int -> BrowserPermissionDescriptor -> ShowS
$cshowsPrec :: Int -> BrowserPermissionDescriptor -> ShowS
Show)
instance FromJSON BrowserPermissionDescriptor where
  parseJSON :: Value -> Parser BrowserPermissionDescriptor
parseJSON = String
-> (Object -> Parser BrowserPermissionDescriptor)
-> Value
-> Parser BrowserPermissionDescriptor
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BrowserPermissionDescriptor" ((Object -> Parser BrowserPermissionDescriptor)
 -> Value -> Parser BrowserPermissionDescriptor)
-> (Object -> Parser BrowserPermissionDescriptor)
-> Value
-> Parser BrowserPermissionDescriptor
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> BrowserPermissionDescriptor
BrowserPermissionDescriptor
    (Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> BrowserPermissionDescriptor)
-> Parser Text
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> BrowserPermissionDescriptor)
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
"name"
    Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> BrowserPermissionDescriptor)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool -> Maybe Bool -> BrowserPermissionDescriptor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"sysex"
    Parser
  (Maybe Bool
   -> Maybe Bool -> Maybe Bool -> BrowserPermissionDescriptor)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> Maybe Bool -> BrowserPermissionDescriptor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"userVisibleOnly"
    Parser (Maybe Bool -> Maybe Bool -> BrowserPermissionDescriptor)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> BrowserPermissionDescriptor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"allowWithoutSanitization"
    Parser (Maybe Bool -> BrowserPermissionDescriptor)
-> Parser (Maybe Bool) -> Parser BrowserPermissionDescriptor
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"panTiltZoom"
instance ToJSON BrowserPermissionDescriptor where
  toJSON :: BrowserPermissionDescriptor -> Value
toJSON BrowserPermissionDescriptor
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
"name" 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 (BrowserPermissionDescriptor -> Text
browserPermissionDescriptorName BrowserPermissionDescriptor
p),
    (Text
"sysex" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BrowserPermissionDescriptor -> Maybe Bool
browserPermissionDescriptorSysex BrowserPermissionDescriptor
p),
    (Text
"userVisibleOnly" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BrowserPermissionDescriptor -> Maybe Bool
browserPermissionDescriptorUserVisibleOnly BrowserPermissionDescriptor
p),
    (Text
"allowWithoutSanitization" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BrowserPermissionDescriptor -> Maybe Bool
browserPermissionDescriptorAllowWithoutSanitization BrowserPermissionDescriptor
p),
    (Text
"panTiltZoom" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BrowserPermissionDescriptor -> Maybe Bool
browserPermissionDescriptorPanTiltZoom BrowserPermissionDescriptor
p)
    ]

-- | Type 'Browser.BrowserCommandId'.
--   Browser command ids used by executeBrowserCommand.
data BrowserBrowserCommandId = BrowserBrowserCommandIdOpenTabSearch | BrowserBrowserCommandIdCloseTabSearch
  deriving (Eq BrowserBrowserCommandId
Eq BrowserBrowserCommandId
-> (BrowserBrowserCommandId -> BrowserBrowserCommandId -> Ordering)
-> (BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool)
-> (BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool)
-> (BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool)
-> (BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool)
-> (BrowserBrowserCommandId
    -> BrowserBrowserCommandId -> BrowserBrowserCommandId)
-> (BrowserBrowserCommandId
    -> BrowserBrowserCommandId -> BrowserBrowserCommandId)
-> Ord BrowserBrowserCommandId
BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool
BrowserBrowserCommandId -> BrowserBrowserCommandId -> Ordering
BrowserBrowserCommandId
-> BrowserBrowserCommandId -> BrowserBrowserCommandId
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 :: BrowserBrowserCommandId
-> BrowserBrowserCommandId -> BrowserBrowserCommandId
$cmin :: BrowserBrowserCommandId
-> BrowserBrowserCommandId -> BrowserBrowserCommandId
max :: BrowserBrowserCommandId
-> BrowserBrowserCommandId -> BrowserBrowserCommandId
$cmax :: BrowserBrowserCommandId
-> BrowserBrowserCommandId -> BrowserBrowserCommandId
>= :: BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool
$c>= :: BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool
> :: BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool
$c> :: BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool
<= :: BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool
$c<= :: BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool
< :: BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool
$c< :: BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool
compare :: BrowserBrowserCommandId -> BrowserBrowserCommandId -> Ordering
$ccompare :: BrowserBrowserCommandId -> BrowserBrowserCommandId -> Ordering
$cp1Ord :: Eq BrowserBrowserCommandId
Ord, BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool
(BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool)
-> (BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool)
-> Eq BrowserBrowserCommandId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool
$c/= :: BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool
== :: BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool
$c== :: BrowserBrowserCommandId -> BrowserBrowserCommandId -> Bool
Eq, Int -> BrowserBrowserCommandId -> ShowS
[BrowserBrowserCommandId] -> ShowS
BrowserBrowserCommandId -> String
(Int -> BrowserBrowserCommandId -> ShowS)
-> (BrowserBrowserCommandId -> String)
-> ([BrowserBrowserCommandId] -> ShowS)
-> Show BrowserBrowserCommandId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserBrowserCommandId] -> ShowS
$cshowList :: [BrowserBrowserCommandId] -> ShowS
show :: BrowserBrowserCommandId -> String
$cshow :: BrowserBrowserCommandId -> String
showsPrec :: Int -> BrowserBrowserCommandId -> ShowS
$cshowsPrec :: Int -> BrowserBrowserCommandId -> ShowS
Show, ReadPrec [BrowserBrowserCommandId]
ReadPrec BrowserBrowserCommandId
Int -> ReadS BrowserBrowserCommandId
ReadS [BrowserBrowserCommandId]
(Int -> ReadS BrowserBrowserCommandId)
-> ReadS [BrowserBrowserCommandId]
-> ReadPrec BrowserBrowserCommandId
-> ReadPrec [BrowserBrowserCommandId]
-> Read BrowserBrowserCommandId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BrowserBrowserCommandId]
$creadListPrec :: ReadPrec [BrowserBrowserCommandId]
readPrec :: ReadPrec BrowserBrowserCommandId
$creadPrec :: ReadPrec BrowserBrowserCommandId
readList :: ReadS [BrowserBrowserCommandId]
$creadList :: ReadS [BrowserBrowserCommandId]
readsPrec :: Int -> ReadS BrowserBrowserCommandId
$creadsPrec :: Int -> ReadS BrowserBrowserCommandId
Read)
instance FromJSON BrowserBrowserCommandId where
  parseJSON :: Value -> Parser BrowserBrowserCommandId
parseJSON = String
-> (Text -> Parser BrowserBrowserCommandId)
-> Value
-> Parser BrowserBrowserCommandId
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"BrowserBrowserCommandId" ((Text -> Parser BrowserBrowserCommandId)
 -> Value -> Parser BrowserBrowserCommandId)
-> (Text -> Parser BrowserBrowserCommandId)
-> Value
-> Parser BrowserBrowserCommandId
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"openTabSearch" -> BrowserBrowserCommandId -> Parser BrowserBrowserCommandId
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserBrowserCommandId
BrowserBrowserCommandIdOpenTabSearch
    Text
"closeTabSearch" -> BrowserBrowserCommandId -> Parser BrowserBrowserCommandId
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserBrowserCommandId
BrowserBrowserCommandIdCloseTabSearch
    Text
"_" -> String -> Parser BrowserBrowserCommandId
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse BrowserBrowserCommandId"
instance ToJSON BrowserBrowserCommandId where
  toJSON :: BrowserBrowserCommandId -> Value
toJSON BrowserBrowserCommandId
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case BrowserBrowserCommandId
v of
    BrowserBrowserCommandId
BrowserBrowserCommandIdOpenTabSearch -> Text
"openTabSearch"
    BrowserBrowserCommandId
BrowserBrowserCommandIdCloseTabSearch -> Text
"closeTabSearch"

-- | Type 'Browser.Bucket'.
--   Chrome histogram bucket.
data BrowserBucket = BrowserBucket
  {
    -- | Minimum value (inclusive).
    BrowserBucket -> Int
browserBucketLow :: Int,
    -- | Maximum value (exclusive).
    BrowserBucket -> Int
browserBucketHigh :: Int,
    -- | Number of samples.
    BrowserBucket -> Int
browserBucketCount :: Int
  }
  deriving (BrowserBucket -> BrowserBucket -> Bool
(BrowserBucket -> BrowserBucket -> Bool)
-> (BrowserBucket -> BrowserBucket -> Bool) -> Eq BrowserBucket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserBucket -> BrowserBucket -> Bool
$c/= :: BrowserBucket -> BrowserBucket -> Bool
== :: BrowserBucket -> BrowserBucket -> Bool
$c== :: BrowserBucket -> BrowserBucket -> Bool
Eq, Int -> BrowserBucket -> ShowS
[BrowserBucket] -> ShowS
BrowserBucket -> String
(Int -> BrowserBucket -> ShowS)
-> (BrowserBucket -> String)
-> ([BrowserBucket] -> ShowS)
-> Show BrowserBucket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserBucket] -> ShowS
$cshowList :: [BrowserBucket] -> ShowS
show :: BrowserBucket -> String
$cshow :: BrowserBucket -> String
showsPrec :: Int -> BrowserBucket -> ShowS
$cshowsPrec :: Int -> BrowserBucket -> ShowS
Show)
instance FromJSON BrowserBucket where
  parseJSON :: Value -> Parser BrowserBucket
parseJSON = String
-> (Object -> Parser BrowserBucket)
-> Value
-> Parser BrowserBucket
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BrowserBucket" ((Object -> Parser BrowserBucket) -> Value -> Parser BrowserBucket)
-> (Object -> Parser BrowserBucket)
-> Value
-> Parser BrowserBucket
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Int -> Int -> BrowserBucket
BrowserBucket
    (Int -> Int -> Int -> BrowserBucket)
-> Parser Int -> Parser (Int -> Int -> BrowserBucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"low"
    Parser (Int -> Int -> BrowserBucket)
-> Parser Int -> Parser (Int -> BrowserBucket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"high"
    Parser (Int -> BrowserBucket) -> Parser Int -> Parser BrowserBucket
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"count"
instance ToJSON BrowserBucket where
  toJSON :: BrowserBucket -> Value
toJSON BrowserBucket
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
"low" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (BrowserBucket -> Int
browserBucketLow BrowserBucket
p),
    (Text
"high" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (BrowserBucket -> Int
browserBucketHigh BrowserBucket
p),
    (Text
"count" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (BrowserBucket -> Int
browserBucketCount BrowserBucket
p)
    ]

-- | Type 'Browser.Histogram'.
--   Chrome histogram.
data BrowserHistogram = BrowserHistogram
  {
    -- | Name.
    BrowserHistogram -> Text
browserHistogramName :: T.Text,
    -- | Sum of sample values.
    BrowserHistogram -> Int
browserHistogramSum :: Int,
    -- | Total number of samples.
    BrowserHistogram -> Int
browserHistogramCount :: Int,
    -- | Buckets.
    BrowserHistogram -> [BrowserBucket]
browserHistogramBuckets :: [BrowserBucket]
  }
  deriving (BrowserHistogram -> BrowserHistogram -> Bool
(BrowserHistogram -> BrowserHistogram -> Bool)
-> (BrowserHistogram -> BrowserHistogram -> Bool)
-> Eq BrowserHistogram
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserHistogram -> BrowserHistogram -> Bool
$c/= :: BrowserHistogram -> BrowserHistogram -> Bool
== :: BrowserHistogram -> BrowserHistogram -> Bool
$c== :: BrowserHistogram -> BrowserHistogram -> Bool
Eq, Int -> BrowserHistogram -> ShowS
[BrowserHistogram] -> ShowS
BrowserHistogram -> String
(Int -> BrowserHistogram -> ShowS)
-> (BrowserHistogram -> String)
-> ([BrowserHistogram] -> ShowS)
-> Show BrowserHistogram
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserHistogram] -> ShowS
$cshowList :: [BrowserHistogram] -> ShowS
show :: BrowserHistogram -> String
$cshow :: BrowserHistogram -> String
showsPrec :: Int -> BrowserHistogram -> ShowS
$cshowsPrec :: Int -> BrowserHistogram -> ShowS
Show)
instance FromJSON BrowserHistogram where
  parseJSON :: Value -> Parser BrowserHistogram
parseJSON = String
-> (Object -> Parser BrowserHistogram)
-> Value
-> Parser BrowserHistogram
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BrowserHistogram" ((Object -> Parser BrowserHistogram)
 -> Value -> Parser BrowserHistogram)
-> (Object -> Parser BrowserHistogram)
-> Value
-> Parser BrowserHistogram
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Int -> Int -> [BrowserBucket] -> BrowserHistogram
BrowserHistogram
    (Text -> Int -> Int -> [BrowserBucket] -> BrowserHistogram)
-> Parser Text
-> Parser (Int -> Int -> [BrowserBucket] -> BrowserHistogram)
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
"name"
    Parser (Int -> Int -> [BrowserBucket] -> BrowserHistogram)
-> Parser Int
-> Parser (Int -> [BrowserBucket] -> BrowserHistogram)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"sum"
    Parser (Int -> [BrowserBucket] -> BrowserHistogram)
-> Parser Int -> Parser ([BrowserBucket] -> BrowserHistogram)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"count"
    Parser ([BrowserBucket] -> BrowserHistogram)
-> Parser [BrowserBucket] -> Parser BrowserHistogram
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [BrowserBucket]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"buckets"
instance ToJSON BrowserHistogram where
  toJSON :: BrowserHistogram -> Value
toJSON BrowserHistogram
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
"name" 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 (BrowserHistogram -> Text
browserHistogramName BrowserHistogram
p),
    (Text
"sum" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (BrowserHistogram -> Int
browserHistogramSum BrowserHistogram
p),
    (Text
"count" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (BrowserHistogram -> Int
browserHistogramCount BrowserHistogram
p),
    (Text
"buckets" Text -> [BrowserBucket] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([BrowserBucket] -> Pair) -> Maybe [BrowserBucket] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BrowserBucket] -> Maybe [BrowserBucket]
forall a. a -> Maybe a
Just (BrowserHistogram -> [BrowserBucket]
browserHistogramBuckets BrowserHistogram
p)
    ]

-- | Type of the 'Browser.downloadWillBegin' event.
data BrowserDownloadWillBegin = BrowserDownloadWillBegin
  {
    -- | Id of the frame that caused the download to begin.
    BrowserDownloadWillBegin -> Text
browserDownloadWillBeginFrameId :: DOMPageNetworkEmulationSecurity.PageFrameId,
    -- | Global unique identifier of the download.
    BrowserDownloadWillBegin -> Text
browserDownloadWillBeginGuid :: T.Text,
    -- | URL of the resource being downloaded.
    BrowserDownloadWillBegin -> Text
browserDownloadWillBeginUrl :: T.Text,
    -- | Suggested file name of the resource (the actual name of the file saved on disk may differ).
    BrowserDownloadWillBegin -> Text
browserDownloadWillBeginSuggestedFilename :: T.Text
  }
  deriving (BrowserDownloadWillBegin -> BrowserDownloadWillBegin -> Bool
(BrowserDownloadWillBegin -> BrowserDownloadWillBegin -> Bool)
-> (BrowserDownloadWillBegin -> BrowserDownloadWillBegin -> Bool)
-> Eq BrowserDownloadWillBegin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserDownloadWillBegin -> BrowserDownloadWillBegin -> Bool
$c/= :: BrowserDownloadWillBegin -> BrowserDownloadWillBegin -> Bool
== :: BrowserDownloadWillBegin -> BrowserDownloadWillBegin -> Bool
$c== :: BrowserDownloadWillBegin -> BrowserDownloadWillBegin -> Bool
Eq, Int -> BrowserDownloadWillBegin -> ShowS
[BrowserDownloadWillBegin] -> ShowS
BrowserDownloadWillBegin -> String
(Int -> BrowserDownloadWillBegin -> ShowS)
-> (BrowserDownloadWillBegin -> String)
-> ([BrowserDownloadWillBegin] -> ShowS)
-> Show BrowserDownloadWillBegin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserDownloadWillBegin] -> ShowS
$cshowList :: [BrowserDownloadWillBegin] -> ShowS
show :: BrowserDownloadWillBegin -> String
$cshow :: BrowserDownloadWillBegin -> String
showsPrec :: Int -> BrowserDownloadWillBegin -> ShowS
$cshowsPrec :: Int -> BrowserDownloadWillBegin -> ShowS
Show)
instance FromJSON BrowserDownloadWillBegin where
  parseJSON :: Value -> Parser BrowserDownloadWillBegin
parseJSON = String
-> (Object -> Parser BrowserDownloadWillBegin)
-> Value
-> Parser BrowserDownloadWillBegin
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BrowserDownloadWillBegin" ((Object -> Parser BrowserDownloadWillBegin)
 -> Value -> Parser BrowserDownloadWillBegin)
-> (Object -> Parser BrowserDownloadWillBegin)
-> Value
-> Parser BrowserDownloadWillBegin
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Text -> Text -> BrowserDownloadWillBegin
BrowserDownloadWillBegin
    (Text -> Text -> Text -> Text -> BrowserDownloadWillBegin)
-> Parser Text
-> Parser (Text -> Text -> Text -> BrowserDownloadWillBegin)
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
"frameId"
    Parser (Text -> Text -> Text -> BrowserDownloadWillBegin)
-> Parser Text -> Parser (Text -> Text -> BrowserDownloadWillBegin)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"guid"
    Parser (Text -> Text -> BrowserDownloadWillBegin)
-> Parser Text -> Parser (Text -> BrowserDownloadWillBegin)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"url"
    Parser (Text -> BrowserDownloadWillBegin)
-> Parser Text -> Parser BrowserDownloadWillBegin
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"suggestedFilename"
instance Event BrowserDownloadWillBegin where
  eventName :: Proxy BrowserDownloadWillBegin -> String
eventName Proxy BrowserDownloadWillBegin
_ = String
"Browser.downloadWillBegin"

-- | Type of the 'Browser.downloadProgress' event.
data BrowserDownloadProgressState = BrowserDownloadProgressStateInProgress | BrowserDownloadProgressStateCompleted | BrowserDownloadProgressStateCanceled
  deriving (Eq BrowserDownloadProgressState
Eq BrowserDownloadProgressState
-> (BrowserDownloadProgressState
    -> BrowserDownloadProgressState -> Ordering)
-> (BrowserDownloadProgressState
    -> BrowserDownloadProgressState -> Bool)
-> (BrowserDownloadProgressState
    -> BrowserDownloadProgressState -> Bool)
-> (BrowserDownloadProgressState
    -> BrowserDownloadProgressState -> Bool)
-> (BrowserDownloadProgressState
    -> BrowserDownloadProgressState -> Bool)
-> (BrowserDownloadProgressState
    -> BrowserDownloadProgressState -> BrowserDownloadProgressState)
-> (BrowserDownloadProgressState
    -> BrowserDownloadProgressState -> BrowserDownloadProgressState)
-> Ord BrowserDownloadProgressState
BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Bool
BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Ordering
BrowserDownloadProgressState
-> BrowserDownloadProgressState -> BrowserDownloadProgressState
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 :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> BrowserDownloadProgressState
$cmin :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> BrowserDownloadProgressState
max :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> BrowserDownloadProgressState
$cmax :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> BrowserDownloadProgressState
>= :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Bool
$c>= :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Bool
> :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Bool
$c> :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Bool
<= :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Bool
$c<= :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Bool
< :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Bool
$c< :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Bool
compare :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Ordering
$ccompare :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Ordering
$cp1Ord :: Eq BrowserDownloadProgressState
Ord, BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Bool
(BrowserDownloadProgressState
 -> BrowserDownloadProgressState -> Bool)
-> (BrowserDownloadProgressState
    -> BrowserDownloadProgressState -> Bool)
-> Eq BrowserDownloadProgressState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Bool
$c/= :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Bool
== :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Bool
$c== :: BrowserDownloadProgressState
-> BrowserDownloadProgressState -> Bool
Eq, Int -> BrowserDownloadProgressState -> ShowS
[BrowserDownloadProgressState] -> ShowS
BrowserDownloadProgressState -> String
(Int -> BrowserDownloadProgressState -> ShowS)
-> (BrowserDownloadProgressState -> String)
-> ([BrowserDownloadProgressState] -> ShowS)
-> Show BrowserDownloadProgressState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserDownloadProgressState] -> ShowS
$cshowList :: [BrowserDownloadProgressState] -> ShowS
show :: BrowserDownloadProgressState -> String
$cshow :: BrowserDownloadProgressState -> String
showsPrec :: Int -> BrowserDownloadProgressState -> ShowS
$cshowsPrec :: Int -> BrowserDownloadProgressState -> ShowS
Show, ReadPrec [BrowserDownloadProgressState]
ReadPrec BrowserDownloadProgressState
Int -> ReadS BrowserDownloadProgressState
ReadS [BrowserDownloadProgressState]
(Int -> ReadS BrowserDownloadProgressState)
-> ReadS [BrowserDownloadProgressState]
-> ReadPrec BrowserDownloadProgressState
-> ReadPrec [BrowserDownloadProgressState]
-> Read BrowserDownloadProgressState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BrowserDownloadProgressState]
$creadListPrec :: ReadPrec [BrowserDownloadProgressState]
readPrec :: ReadPrec BrowserDownloadProgressState
$creadPrec :: ReadPrec BrowserDownloadProgressState
readList :: ReadS [BrowserDownloadProgressState]
$creadList :: ReadS [BrowserDownloadProgressState]
readsPrec :: Int -> ReadS BrowserDownloadProgressState
$creadsPrec :: Int -> ReadS BrowserDownloadProgressState
Read)
instance FromJSON BrowserDownloadProgressState where
  parseJSON :: Value -> Parser BrowserDownloadProgressState
parseJSON = String
-> (Text -> Parser BrowserDownloadProgressState)
-> Value
-> Parser BrowserDownloadProgressState
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"BrowserDownloadProgressState" ((Text -> Parser BrowserDownloadProgressState)
 -> Value -> Parser BrowserDownloadProgressState)
-> (Text -> Parser BrowserDownloadProgressState)
-> Value
-> Parser BrowserDownloadProgressState
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"inProgress" -> BrowserDownloadProgressState -> Parser BrowserDownloadProgressState
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserDownloadProgressState
BrowserDownloadProgressStateInProgress
    Text
"completed" -> BrowserDownloadProgressState -> Parser BrowserDownloadProgressState
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserDownloadProgressState
BrowserDownloadProgressStateCompleted
    Text
"canceled" -> BrowserDownloadProgressState -> Parser BrowserDownloadProgressState
forall (f :: * -> *) a. Applicative f => a -> f a
pure BrowserDownloadProgressState
BrowserDownloadProgressStateCanceled
    Text
"_" -> String -> Parser BrowserDownloadProgressState
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse BrowserDownloadProgressState"
instance ToJSON BrowserDownloadProgressState where
  toJSON :: BrowserDownloadProgressState -> Value
toJSON BrowserDownloadProgressState
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case BrowserDownloadProgressState
v of
    BrowserDownloadProgressState
BrowserDownloadProgressStateInProgress -> Text
"inProgress"
    BrowserDownloadProgressState
BrowserDownloadProgressStateCompleted -> Text
"completed"
    BrowserDownloadProgressState
BrowserDownloadProgressStateCanceled -> Text
"canceled"
data BrowserDownloadProgress = BrowserDownloadProgress
  {
    -- | Global unique identifier of the download.
    BrowserDownloadProgress -> Text
browserDownloadProgressGuid :: T.Text,
    -- | Total expected bytes to download.
    BrowserDownloadProgress -> Double
browserDownloadProgressTotalBytes :: Double,
    -- | Total bytes received.
    BrowserDownloadProgress -> Double
browserDownloadProgressReceivedBytes :: Double,
    -- | Download status.
    BrowserDownloadProgress -> BrowserDownloadProgressState
browserDownloadProgressState :: BrowserDownloadProgressState
  }
  deriving (BrowserDownloadProgress -> BrowserDownloadProgress -> Bool
(BrowserDownloadProgress -> BrowserDownloadProgress -> Bool)
-> (BrowserDownloadProgress -> BrowserDownloadProgress -> Bool)
-> Eq BrowserDownloadProgress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserDownloadProgress -> BrowserDownloadProgress -> Bool
$c/= :: BrowserDownloadProgress -> BrowserDownloadProgress -> Bool
== :: BrowserDownloadProgress -> BrowserDownloadProgress -> Bool
$c== :: BrowserDownloadProgress -> BrowserDownloadProgress -> Bool
Eq, Int -> BrowserDownloadProgress -> ShowS
[BrowserDownloadProgress] -> ShowS
BrowserDownloadProgress -> String
(Int -> BrowserDownloadProgress -> ShowS)
-> (BrowserDownloadProgress -> String)
-> ([BrowserDownloadProgress] -> ShowS)
-> Show BrowserDownloadProgress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserDownloadProgress] -> ShowS
$cshowList :: [BrowserDownloadProgress] -> ShowS
show :: BrowserDownloadProgress -> String
$cshow :: BrowserDownloadProgress -> String
showsPrec :: Int -> BrowserDownloadProgress -> ShowS
$cshowsPrec :: Int -> BrowserDownloadProgress -> ShowS
Show)
instance FromJSON BrowserDownloadProgress where
  parseJSON :: Value -> Parser BrowserDownloadProgress
parseJSON = String
-> (Object -> Parser BrowserDownloadProgress)
-> Value
-> Parser BrowserDownloadProgress
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BrowserDownloadProgress" ((Object -> Parser BrowserDownloadProgress)
 -> Value -> Parser BrowserDownloadProgress)
-> (Object -> Parser BrowserDownloadProgress)
-> Value
-> Parser BrowserDownloadProgress
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Double
-> Double
-> BrowserDownloadProgressState
-> BrowserDownloadProgress
BrowserDownloadProgress
    (Text
 -> Double
 -> Double
 -> BrowserDownloadProgressState
 -> BrowserDownloadProgress)
-> Parser Text
-> Parser
     (Double
      -> Double
      -> BrowserDownloadProgressState
      -> BrowserDownloadProgress)
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
"guid"
    Parser
  (Double
   -> Double
   -> BrowserDownloadProgressState
   -> BrowserDownloadProgress)
-> Parser Double
-> Parser
     (Double -> BrowserDownloadProgressState -> BrowserDownloadProgress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"totalBytes"
    Parser
  (Double -> BrowserDownloadProgressState -> BrowserDownloadProgress)
-> Parser Double
-> Parser (BrowserDownloadProgressState -> BrowserDownloadProgress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"receivedBytes"
    Parser (BrowserDownloadProgressState -> BrowserDownloadProgress)
-> Parser BrowserDownloadProgressState
-> Parser BrowserDownloadProgress
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser BrowserDownloadProgressState
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"state"
instance Event BrowserDownloadProgress where
  eventName :: Proxy BrowserDownloadProgress -> String
eventName Proxy BrowserDownloadProgress
_ = String
"Browser.downloadProgress"

-- | Set permission settings for given origin.

-- | Parameters of the 'Browser.setPermission' command.
data PBrowserSetPermission = PBrowserSetPermission
  {
    -- | Descriptor of permission to override.
    PBrowserSetPermission -> BrowserPermissionDescriptor
pBrowserSetPermissionPermission :: BrowserPermissionDescriptor,
    -- | Setting of the permission.
    PBrowserSetPermission -> BrowserPermissionSetting
pBrowserSetPermissionSetting :: BrowserPermissionSetting,
    -- | Origin the permission applies to, all origins if not specified.
    PBrowserSetPermission -> Maybe Text
pBrowserSetPermissionOrigin :: Maybe T.Text,
    -- | Context to override. When omitted, default browser context is used.
    PBrowserSetPermission -> Maybe Text
pBrowserSetPermissionBrowserContextId :: Maybe BrowserBrowserContextID
  }
  deriving (PBrowserSetPermission -> PBrowserSetPermission -> Bool
(PBrowserSetPermission -> PBrowserSetPermission -> Bool)
-> (PBrowserSetPermission -> PBrowserSetPermission -> Bool)
-> Eq PBrowserSetPermission
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserSetPermission -> PBrowserSetPermission -> Bool
$c/= :: PBrowserSetPermission -> PBrowserSetPermission -> Bool
== :: PBrowserSetPermission -> PBrowserSetPermission -> Bool
$c== :: PBrowserSetPermission -> PBrowserSetPermission -> Bool
Eq, Int -> PBrowserSetPermission -> ShowS
[PBrowserSetPermission] -> ShowS
PBrowserSetPermission -> String
(Int -> PBrowserSetPermission -> ShowS)
-> (PBrowserSetPermission -> String)
-> ([PBrowserSetPermission] -> ShowS)
-> Show PBrowserSetPermission
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserSetPermission] -> ShowS
$cshowList :: [PBrowserSetPermission] -> ShowS
show :: PBrowserSetPermission -> String
$cshow :: PBrowserSetPermission -> String
showsPrec :: Int -> PBrowserSetPermission -> ShowS
$cshowsPrec :: Int -> PBrowserSetPermission -> ShowS
Show)
pBrowserSetPermission
  {-
  -- | Descriptor of permission to override.
  -}
  :: BrowserPermissionDescriptor
  {-
  -- | Setting of the permission.
  -}
  -> BrowserPermissionSetting
  -> PBrowserSetPermission
pBrowserSetPermission :: BrowserPermissionDescriptor
-> BrowserPermissionSetting -> PBrowserSetPermission
pBrowserSetPermission
  BrowserPermissionDescriptor
arg_pBrowserSetPermissionPermission
  BrowserPermissionSetting
arg_pBrowserSetPermissionSetting
  = BrowserPermissionDescriptor
-> BrowserPermissionSetting
-> Maybe Text
-> Maybe Text
-> PBrowserSetPermission
PBrowserSetPermission
    BrowserPermissionDescriptor
arg_pBrowserSetPermissionPermission
    BrowserPermissionSetting
arg_pBrowserSetPermissionSetting
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PBrowserSetPermission where
  toJSON :: PBrowserSetPermission -> Value
toJSON PBrowserSetPermission
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
"permission" Text -> BrowserPermissionDescriptor -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (BrowserPermissionDescriptor -> Pair)
-> Maybe BrowserPermissionDescriptor -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BrowserPermissionDescriptor -> Maybe BrowserPermissionDescriptor
forall a. a -> Maybe a
Just (PBrowserSetPermission -> BrowserPermissionDescriptor
pBrowserSetPermissionPermission PBrowserSetPermission
p),
    (Text
"setting" Text -> BrowserPermissionSetting -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (BrowserPermissionSetting -> Pair)
-> Maybe BrowserPermissionSetting -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BrowserPermissionSetting -> Maybe BrowserPermissionSetting
forall a. a -> Maybe a
Just (PBrowserSetPermission -> BrowserPermissionSetting
pBrowserSetPermissionSetting PBrowserSetPermission
p),
    (Text
"origin" 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
<$> (PBrowserSetPermission -> Maybe Text
pBrowserSetPermissionOrigin PBrowserSetPermission
p),
    (Text
"browserContextId" 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
<$> (PBrowserSetPermission -> Maybe Text
pBrowserSetPermissionBrowserContextId PBrowserSetPermission
p)
    ]
instance Command PBrowserSetPermission where
  type CommandResponse PBrowserSetPermission = ()
  commandName :: Proxy PBrowserSetPermission -> String
commandName Proxy PBrowserSetPermission
_ = String
"Browser.setPermission"
  fromJSON :: Proxy PBrowserSetPermission
-> Value -> Result (CommandResponse PBrowserSetPermission)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PBrowserSetPermission -> Result ())
-> Proxy PBrowserSetPermission
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PBrowserSetPermission -> ())
-> Proxy PBrowserSetPermission
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PBrowserSetPermission -> ()
forall a b. a -> b -> a
const ()

-- | Grant specific permissions to the given origin and reject all others.

-- | Parameters of the 'Browser.grantPermissions' command.
data PBrowserGrantPermissions = PBrowserGrantPermissions
  {
    PBrowserGrantPermissions -> [BrowserPermissionType]
pBrowserGrantPermissionsPermissions :: [BrowserPermissionType],
    -- | Origin the permission applies to, all origins if not specified.
    PBrowserGrantPermissions -> Maybe Text
pBrowserGrantPermissionsOrigin :: Maybe T.Text,
    -- | BrowserContext to override permissions. When omitted, default browser context is used.
    PBrowserGrantPermissions -> Maybe Text
pBrowserGrantPermissionsBrowserContextId :: Maybe BrowserBrowserContextID
  }
  deriving (PBrowserGrantPermissions -> PBrowserGrantPermissions -> Bool
(PBrowserGrantPermissions -> PBrowserGrantPermissions -> Bool)
-> (PBrowserGrantPermissions -> PBrowserGrantPermissions -> Bool)
-> Eq PBrowserGrantPermissions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserGrantPermissions -> PBrowserGrantPermissions -> Bool
$c/= :: PBrowserGrantPermissions -> PBrowserGrantPermissions -> Bool
== :: PBrowserGrantPermissions -> PBrowserGrantPermissions -> Bool
$c== :: PBrowserGrantPermissions -> PBrowserGrantPermissions -> Bool
Eq, Int -> PBrowserGrantPermissions -> ShowS
[PBrowserGrantPermissions] -> ShowS
PBrowserGrantPermissions -> String
(Int -> PBrowserGrantPermissions -> ShowS)
-> (PBrowserGrantPermissions -> String)
-> ([PBrowserGrantPermissions] -> ShowS)
-> Show PBrowserGrantPermissions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserGrantPermissions] -> ShowS
$cshowList :: [PBrowserGrantPermissions] -> ShowS
show :: PBrowserGrantPermissions -> String
$cshow :: PBrowserGrantPermissions -> String
showsPrec :: Int -> PBrowserGrantPermissions -> ShowS
$cshowsPrec :: Int -> PBrowserGrantPermissions -> ShowS
Show)
pBrowserGrantPermissions
  :: [BrowserPermissionType]
  -> PBrowserGrantPermissions
pBrowserGrantPermissions :: [BrowserPermissionType] -> PBrowserGrantPermissions
pBrowserGrantPermissions
  [BrowserPermissionType]
arg_pBrowserGrantPermissionsPermissions
  = [BrowserPermissionType]
-> Maybe Text -> Maybe Text -> PBrowserGrantPermissions
PBrowserGrantPermissions
    [BrowserPermissionType]
arg_pBrowserGrantPermissionsPermissions
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PBrowserGrantPermissions where
  toJSON :: PBrowserGrantPermissions -> Value
toJSON PBrowserGrantPermissions
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
"permissions" Text -> [BrowserPermissionType] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([BrowserPermissionType] -> Pair)
-> Maybe [BrowserPermissionType] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BrowserPermissionType] -> Maybe [BrowserPermissionType]
forall a. a -> Maybe a
Just (PBrowserGrantPermissions -> [BrowserPermissionType]
pBrowserGrantPermissionsPermissions PBrowserGrantPermissions
p),
    (Text
"origin" 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
<$> (PBrowserGrantPermissions -> Maybe Text
pBrowserGrantPermissionsOrigin PBrowserGrantPermissions
p),
    (Text
"browserContextId" 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
<$> (PBrowserGrantPermissions -> Maybe Text
pBrowserGrantPermissionsBrowserContextId PBrowserGrantPermissions
p)
    ]
instance Command PBrowserGrantPermissions where
  type CommandResponse PBrowserGrantPermissions = ()
  commandName :: Proxy PBrowserGrantPermissions -> String
commandName Proxy PBrowserGrantPermissions
_ = String
"Browser.grantPermissions"
  fromJSON :: Proxy PBrowserGrantPermissions
-> Value -> Result (CommandResponse PBrowserGrantPermissions)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PBrowserGrantPermissions -> Result ())
-> Proxy PBrowserGrantPermissions
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PBrowserGrantPermissions -> ())
-> Proxy PBrowserGrantPermissions
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PBrowserGrantPermissions -> ()
forall a b. a -> b -> a
const ()

-- | Reset all permission management for all origins.

-- | Parameters of the 'Browser.resetPermissions' command.
data PBrowserResetPermissions = PBrowserResetPermissions
  {
    -- | BrowserContext to reset permissions. When omitted, default browser context is used.
    PBrowserResetPermissions -> Maybe Text
pBrowserResetPermissionsBrowserContextId :: Maybe BrowserBrowserContextID
  }
  deriving (PBrowserResetPermissions -> PBrowserResetPermissions -> Bool
(PBrowserResetPermissions -> PBrowserResetPermissions -> Bool)
-> (PBrowserResetPermissions -> PBrowserResetPermissions -> Bool)
-> Eq PBrowserResetPermissions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserResetPermissions -> PBrowserResetPermissions -> Bool
$c/= :: PBrowserResetPermissions -> PBrowserResetPermissions -> Bool
== :: PBrowserResetPermissions -> PBrowserResetPermissions -> Bool
$c== :: PBrowserResetPermissions -> PBrowserResetPermissions -> Bool
Eq, Int -> PBrowserResetPermissions -> ShowS
[PBrowserResetPermissions] -> ShowS
PBrowserResetPermissions -> String
(Int -> PBrowserResetPermissions -> ShowS)
-> (PBrowserResetPermissions -> String)
-> ([PBrowserResetPermissions] -> ShowS)
-> Show PBrowserResetPermissions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserResetPermissions] -> ShowS
$cshowList :: [PBrowserResetPermissions] -> ShowS
show :: PBrowserResetPermissions -> String
$cshow :: PBrowserResetPermissions -> String
showsPrec :: Int -> PBrowserResetPermissions -> ShowS
$cshowsPrec :: Int -> PBrowserResetPermissions -> ShowS
Show)
pBrowserResetPermissions
  :: PBrowserResetPermissions
pBrowserResetPermissions :: PBrowserResetPermissions
pBrowserResetPermissions
  = Maybe Text -> PBrowserResetPermissions
PBrowserResetPermissions
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PBrowserResetPermissions where
  toJSON :: PBrowserResetPermissions -> Value
toJSON PBrowserResetPermissions
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
"browserContextId" 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
<$> (PBrowserResetPermissions -> Maybe Text
pBrowserResetPermissionsBrowserContextId PBrowserResetPermissions
p)
    ]
instance Command PBrowserResetPermissions where
  type CommandResponse PBrowserResetPermissions = ()
  commandName :: Proxy PBrowserResetPermissions -> String
commandName Proxy PBrowserResetPermissions
_ = String
"Browser.resetPermissions"
  fromJSON :: Proxy PBrowserResetPermissions
-> Value -> Result (CommandResponse PBrowserResetPermissions)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PBrowserResetPermissions -> Result ())
-> Proxy PBrowserResetPermissions
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PBrowserResetPermissions -> ())
-> Proxy PBrowserResetPermissions
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PBrowserResetPermissions -> ()
forall a b. a -> b -> a
const ()

-- | Set the behavior when downloading a file.

-- | Parameters of the 'Browser.setDownloadBehavior' command.
data PBrowserSetDownloadBehaviorBehavior = PBrowserSetDownloadBehaviorBehaviorDeny | PBrowserSetDownloadBehaviorBehaviorAllow | PBrowserSetDownloadBehaviorBehaviorAllowAndName | PBrowserSetDownloadBehaviorBehaviorDefault
  deriving (Eq PBrowserSetDownloadBehaviorBehavior
Eq PBrowserSetDownloadBehaviorBehavior
-> (PBrowserSetDownloadBehaviorBehavior
    -> PBrowserSetDownloadBehaviorBehavior -> Ordering)
-> (PBrowserSetDownloadBehaviorBehavior
    -> PBrowserSetDownloadBehaviorBehavior -> Bool)
-> (PBrowserSetDownloadBehaviorBehavior
    -> PBrowserSetDownloadBehaviorBehavior -> Bool)
-> (PBrowserSetDownloadBehaviorBehavior
    -> PBrowserSetDownloadBehaviorBehavior -> Bool)
-> (PBrowserSetDownloadBehaviorBehavior
    -> PBrowserSetDownloadBehaviorBehavior -> Bool)
-> (PBrowserSetDownloadBehaviorBehavior
    -> PBrowserSetDownloadBehaviorBehavior
    -> PBrowserSetDownloadBehaviorBehavior)
-> (PBrowserSetDownloadBehaviorBehavior
    -> PBrowserSetDownloadBehaviorBehavior
    -> PBrowserSetDownloadBehaviorBehavior)
-> Ord PBrowserSetDownloadBehaviorBehavior
PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Bool
PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Ordering
PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior
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 :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior
$cmin :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior
max :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior
$cmax :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior
>= :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Bool
$c>= :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Bool
> :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Bool
$c> :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Bool
<= :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Bool
$c<= :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Bool
< :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Bool
$c< :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Bool
compare :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Ordering
$ccompare :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Ordering
$cp1Ord :: Eq PBrowserSetDownloadBehaviorBehavior
Ord, PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Bool
(PBrowserSetDownloadBehaviorBehavior
 -> PBrowserSetDownloadBehaviorBehavior -> Bool)
-> (PBrowserSetDownloadBehaviorBehavior
    -> PBrowserSetDownloadBehaviorBehavior -> Bool)
-> Eq PBrowserSetDownloadBehaviorBehavior
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Bool
$c/= :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Bool
== :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Bool
$c== :: PBrowserSetDownloadBehaviorBehavior
-> PBrowserSetDownloadBehaviorBehavior -> Bool
Eq, Int -> PBrowserSetDownloadBehaviorBehavior -> ShowS
[PBrowserSetDownloadBehaviorBehavior] -> ShowS
PBrowserSetDownloadBehaviorBehavior -> String
(Int -> PBrowserSetDownloadBehaviorBehavior -> ShowS)
-> (PBrowserSetDownloadBehaviorBehavior -> String)
-> ([PBrowserSetDownloadBehaviorBehavior] -> ShowS)
-> Show PBrowserSetDownloadBehaviorBehavior
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserSetDownloadBehaviorBehavior] -> ShowS
$cshowList :: [PBrowserSetDownloadBehaviorBehavior] -> ShowS
show :: PBrowserSetDownloadBehaviorBehavior -> String
$cshow :: PBrowserSetDownloadBehaviorBehavior -> String
showsPrec :: Int -> PBrowserSetDownloadBehaviorBehavior -> ShowS
$cshowsPrec :: Int -> PBrowserSetDownloadBehaviorBehavior -> ShowS
Show, ReadPrec [PBrowserSetDownloadBehaviorBehavior]
ReadPrec PBrowserSetDownloadBehaviorBehavior
Int -> ReadS PBrowserSetDownloadBehaviorBehavior
ReadS [PBrowserSetDownloadBehaviorBehavior]
(Int -> ReadS PBrowserSetDownloadBehaviorBehavior)
-> ReadS [PBrowserSetDownloadBehaviorBehavior]
-> ReadPrec PBrowserSetDownloadBehaviorBehavior
-> ReadPrec [PBrowserSetDownloadBehaviorBehavior]
-> Read PBrowserSetDownloadBehaviorBehavior
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PBrowserSetDownloadBehaviorBehavior]
$creadListPrec :: ReadPrec [PBrowserSetDownloadBehaviorBehavior]
readPrec :: ReadPrec PBrowserSetDownloadBehaviorBehavior
$creadPrec :: ReadPrec PBrowserSetDownloadBehaviorBehavior
readList :: ReadS [PBrowserSetDownloadBehaviorBehavior]
$creadList :: ReadS [PBrowserSetDownloadBehaviorBehavior]
readsPrec :: Int -> ReadS PBrowserSetDownloadBehaviorBehavior
$creadsPrec :: Int -> ReadS PBrowserSetDownloadBehaviorBehavior
Read)
instance FromJSON PBrowserSetDownloadBehaviorBehavior where
  parseJSON :: Value -> Parser PBrowserSetDownloadBehaviorBehavior
parseJSON = String
-> (Text -> Parser PBrowserSetDownloadBehaviorBehavior)
-> Value
-> Parser PBrowserSetDownloadBehaviorBehavior
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"PBrowserSetDownloadBehaviorBehavior" ((Text -> Parser PBrowserSetDownloadBehaviorBehavior)
 -> Value -> Parser PBrowserSetDownloadBehaviorBehavior)
-> (Text -> Parser PBrowserSetDownloadBehaviorBehavior)
-> Value
-> Parser PBrowserSetDownloadBehaviorBehavior
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"deny" -> PBrowserSetDownloadBehaviorBehavior
-> Parser PBrowserSetDownloadBehaviorBehavior
forall (f :: * -> *) a. Applicative f => a -> f a
pure PBrowserSetDownloadBehaviorBehavior
PBrowserSetDownloadBehaviorBehaviorDeny
    Text
"allow" -> PBrowserSetDownloadBehaviorBehavior
-> Parser PBrowserSetDownloadBehaviorBehavior
forall (f :: * -> *) a. Applicative f => a -> f a
pure PBrowserSetDownloadBehaviorBehavior
PBrowserSetDownloadBehaviorBehaviorAllow
    Text
"allowAndName" -> PBrowserSetDownloadBehaviorBehavior
-> Parser PBrowserSetDownloadBehaviorBehavior
forall (f :: * -> *) a. Applicative f => a -> f a
pure PBrowserSetDownloadBehaviorBehavior
PBrowserSetDownloadBehaviorBehaviorAllowAndName
    Text
"default" -> PBrowserSetDownloadBehaviorBehavior
-> Parser PBrowserSetDownloadBehaviorBehavior
forall (f :: * -> *) a. Applicative f => a -> f a
pure PBrowserSetDownloadBehaviorBehavior
PBrowserSetDownloadBehaviorBehaviorDefault
    Text
"_" -> String -> Parser PBrowserSetDownloadBehaviorBehavior
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse PBrowserSetDownloadBehaviorBehavior"
instance ToJSON PBrowserSetDownloadBehaviorBehavior where
  toJSON :: PBrowserSetDownloadBehaviorBehavior -> Value
toJSON PBrowserSetDownloadBehaviorBehavior
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case PBrowserSetDownloadBehaviorBehavior
v of
    PBrowserSetDownloadBehaviorBehavior
PBrowserSetDownloadBehaviorBehaviorDeny -> Text
"deny"
    PBrowserSetDownloadBehaviorBehavior
PBrowserSetDownloadBehaviorBehaviorAllow -> Text
"allow"
    PBrowserSetDownloadBehaviorBehavior
PBrowserSetDownloadBehaviorBehaviorAllowAndName -> Text
"allowAndName"
    PBrowserSetDownloadBehaviorBehavior
PBrowserSetDownloadBehaviorBehaviorDefault -> Text
"default"
data PBrowserSetDownloadBehavior = PBrowserSetDownloadBehavior
  {
    -- | Whether to allow all or deny all download requests, or use default Chrome behavior if
    --   available (otherwise deny). |allowAndName| allows download and names files according to
    --   their dowmload guids.
    PBrowserSetDownloadBehavior -> PBrowserSetDownloadBehaviorBehavior
pBrowserSetDownloadBehaviorBehavior :: PBrowserSetDownloadBehaviorBehavior,
    -- | BrowserContext to set download behavior. When omitted, default browser context is used.
    PBrowserSetDownloadBehavior -> Maybe Text
pBrowserSetDownloadBehaviorBrowserContextId :: Maybe BrowserBrowserContextID,
    -- | The default path to save downloaded files to. This is required if behavior is set to 'allow'
    --   or 'allowAndName'.
    PBrowserSetDownloadBehavior -> Maybe Text
pBrowserSetDownloadBehaviorDownloadPath :: Maybe T.Text,
    -- | Whether to emit download events (defaults to false).
    PBrowserSetDownloadBehavior -> Maybe Bool
pBrowserSetDownloadBehaviorEventsEnabled :: Maybe Bool
  }
  deriving (PBrowserSetDownloadBehavior -> PBrowserSetDownloadBehavior -> Bool
(PBrowserSetDownloadBehavior
 -> PBrowserSetDownloadBehavior -> Bool)
-> (PBrowserSetDownloadBehavior
    -> PBrowserSetDownloadBehavior -> Bool)
-> Eq PBrowserSetDownloadBehavior
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserSetDownloadBehavior -> PBrowserSetDownloadBehavior -> Bool
$c/= :: PBrowserSetDownloadBehavior -> PBrowserSetDownloadBehavior -> Bool
== :: PBrowserSetDownloadBehavior -> PBrowserSetDownloadBehavior -> Bool
$c== :: PBrowserSetDownloadBehavior -> PBrowserSetDownloadBehavior -> Bool
Eq, Int -> PBrowserSetDownloadBehavior -> ShowS
[PBrowserSetDownloadBehavior] -> ShowS
PBrowserSetDownloadBehavior -> String
(Int -> PBrowserSetDownloadBehavior -> ShowS)
-> (PBrowserSetDownloadBehavior -> String)
-> ([PBrowserSetDownloadBehavior] -> ShowS)
-> Show PBrowserSetDownloadBehavior
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserSetDownloadBehavior] -> ShowS
$cshowList :: [PBrowserSetDownloadBehavior] -> ShowS
show :: PBrowserSetDownloadBehavior -> String
$cshow :: PBrowserSetDownloadBehavior -> String
showsPrec :: Int -> PBrowserSetDownloadBehavior -> ShowS
$cshowsPrec :: Int -> PBrowserSetDownloadBehavior -> ShowS
Show)
pBrowserSetDownloadBehavior
  {-
  -- | Whether to allow all or deny all download requests, or use default Chrome behavior if
  --   available (otherwise deny). |allowAndName| allows download and names files according to
  --   their dowmload guids.
  -}
  :: PBrowserSetDownloadBehaviorBehavior
  -> PBrowserSetDownloadBehavior
pBrowserSetDownloadBehavior :: PBrowserSetDownloadBehaviorBehavior -> PBrowserSetDownloadBehavior
pBrowserSetDownloadBehavior
  PBrowserSetDownloadBehaviorBehavior
arg_pBrowserSetDownloadBehaviorBehavior
  = PBrowserSetDownloadBehaviorBehavior
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> PBrowserSetDownloadBehavior
PBrowserSetDownloadBehavior
    PBrowserSetDownloadBehaviorBehavior
arg_pBrowserSetDownloadBehaviorBehavior
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PBrowserSetDownloadBehavior where
  toJSON :: PBrowserSetDownloadBehavior -> Value
toJSON PBrowserSetDownloadBehavior
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
"behavior" Text -> PBrowserSetDownloadBehaviorBehavior -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (PBrowserSetDownloadBehaviorBehavior -> Pair)
-> Maybe PBrowserSetDownloadBehaviorBehavior -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PBrowserSetDownloadBehaviorBehavior
-> Maybe PBrowserSetDownloadBehaviorBehavior
forall a. a -> Maybe a
Just (PBrowserSetDownloadBehavior -> PBrowserSetDownloadBehaviorBehavior
pBrowserSetDownloadBehaviorBehavior PBrowserSetDownloadBehavior
p),
    (Text
"browserContextId" 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
<$> (PBrowserSetDownloadBehavior -> Maybe Text
pBrowserSetDownloadBehaviorBrowserContextId PBrowserSetDownloadBehavior
p),
    (Text
"downloadPath" 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
<$> (PBrowserSetDownloadBehavior -> Maybe Text
pBrowserSetDownloadBehaviorDownloadPath PBrowserSetDownloadBehavior
p),
    (Text
"eventsEnabled" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PBrowserSetDownloadBehavior -> Maybe Bool
pBrowserSetDownloadBehaviorEventsEnabled PBrowserSetDownloadBehavior
p)
    ]
instance Command PBrowserSetDownloadBehavior where
  type CommandResponse PBrowserSetDownloadBehavior = ()
  commandName :: Proxy PBrowserSetDownloadBehavior -> String
commandName Proxy PBrowserSetDownloadBehavior
_ = String
"Browser.setDownloadBehavior"
  fromJSON :: Proxy PBrowserSetDownloadBehavior
-> Value -> Result (CommandResponse PBrowserSetDownloadBehavior)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PBrowserSetDownloadBehavior -> Result ())
-> Proxy PBrowserSetDownloadBehavior
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PBrowserSetDownloadBehavior -> ())
-> Proxy PBrowserSetDownloadBehavior
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PBrowserSetDownloadBehavior -> ()
forall a b. a -> b -> a
const ()

-- | Cancel a download if in progress

-- | Parameters of the 'Browser.cancelDownload' command.
data PBrowserCancelDownload = PBrowserCancelDownload
  {
    -- | Global unique identifier of the download.
    PBrowserCancelDownload -> Text
pBrowserCancelDownloadGuid :: T.Text,
    -- | BrowserContext to perform the action in. When omitted, default browser context is used.
    PBrowserCancelDownload -> Maybe Text
pBrowserCancelDownloadBrowserContextId :: Maybe BrowserBrowserContextID
  }
  deriving (PBrowserCancelDownload -> PBrowserCancelDownload -> Bool
(PBrowserCancelDownload -> PBrowserCancelDownload -> Bool)
-> (PBrowserCancelDownload -> PBrowserCancelDownload -> Bool)
-> Eq PBrowserCancelDownload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserCancelDownload -> PBrowserCancelDownload -> Bool
$c/= :: PBrowserCancelDownload -> PBrowserCancelDownload -> Bool
== :: PBrowserCancelDownload -> PBrowserCancelDownload -> Bool
$c== :: PBrowserCancelDownload -> PBrowserCancelDownload -> Bool
Eq, Int -> PBrowserCancelDownload -> ShowS
[PBrowserCancelDownload] -> ShowS
PBrowserCancelDownload -> String
(Int -> PBrowserCancelDownload -> ShowS)
-> (PBrowserCancelDownload -> String)
-> ([PBrowserCancelDownload] -> ShowS)
-> Show PBrowserCancelDownload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserCancelDownload] -> ShowS
$cshowList :: [PBrowserCancelDownload] -> ShowS
show :: PBrowserCancelDownload -> String
$cshow :: PBrowserCancelDownload -> String
showsPrec :: Int -> PBrowserCancelDownload -> ShowS
$cshowsPrec :: Int -> PBrowserCancelDownload -> ShowS
Show)
pBrowserCancelDownload
  {-
  -- | Global unique identifier of the download.
  -}
  :: T.Text
  -> PBrowserCancelDownload
pBrowserCancelDownload :: Text -> PBrowserCancelDownload
pBrowserCancelDownload
  Text
arg_pBrowserCancelDownloadGuid
  = Text -> Maybe Text -> PBrowserCancelDownload
PBrowserCancelDownload
    Text
arg_pBrowserCancelDownloadGuid
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PBrowserCancelDownload where
  toJSON :: PBrowserCancelDownload -> Value
toJSON PBrowserCancelDownload
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
"guid" 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 (PBrowserCancelDownload -> Text
pBrowserCancelDownloadGuid PBrowserCancelDownload
p),
    (Text
"browserContextId" 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
<$> (PBrowserCancelDownload -> Maybe Text
pBrowserCancelDownloadBrowserContextId PBrowserCancelDownload
p)
    ]
instance Command PBrowserCancelDownload where
  type CommandResponse PBrowserCancelDownload = ()
  commandName :: Proxy PBrowserCancelDownload -> String
commandName Proxy PBrowserCancelDownload
_ = String
"Browser.cancelDownload"
  fromJSON :: Proxy PBrowserCancelDownload
-> Value -> Result (CommandResponse PBrowserCancelDownload)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PBrowserCancelDownload -> Result ())
-> Proxy PBrowserCancelDownload
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PBrowserCancelDownload -> ())
-> Proxy PBrowserCancelDownload
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PBrowserCancelDownload -> ()
forall a b. a -> b -> a
const ()

-- | Close browser gracefully.

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

-- | Crashes browser on the main thread.

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

-- | Crashes GPU process.

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

-- | Returns version information.

-- | Parameters of the 'Browser.getVersion' command.
data PBrowserGetVersion = PBrowserGetVersion
  deriving (PBrowserGetVersion -> PBrowserGetVersion -> Bool
(PBrowserGetVersion -> PBrowserGetVersion -> Bool)
-> (PBrowserGetVersion -> PBrowserGetVersion -> Bool)
-> Eq PBrowserGetVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserGetVersion -> PBrowserGetVersion -> Bool
$c/= :: PBrowserGetVersion -> PBrowserGetVersion -> Bool
== :: PBrowserGetVersion -> PBrowserGetVersion -> Bool
$c== :: PBrowserGetVersion -> PBrowserGetVersion -> Bool
Eq, Int -> PBrowserGetVersion -> ShowS
[PBrowserGetVersion] -> ShowS
PBrowserGetVersion -> String
(Int -> PBrowserGetVersion -> ShowS)
-> (PBrowserGetVersion -> String)
-> ([PBrowserGetVersion] -> ShowS)
-> Show PBrowserGetVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserGetVersion] -> ShowS
$cshowList :: [PBrowserGetVersion] -> ShowS
show :: PBrowserGetVersion -> String
$cshow :: PBrowserGetVersion -> String
showsPrec :: Int -> PBrowserGetVersion -> ShowS
$cshowsPrec :: Int -> PBrowserGetVersion -> ShowS
Show)
pBrowserGetVersion
  :: PBrowserGetVersion
pBrowserGetVersion :: PBrowserGetVersion
pBrowserGetVersion
  = PBrowserGetVersion
PBrowserGetVersion
instance ToJSON PBrowserGetVersion where
  toJSON :: PBrowserGetVersion -> Value
toJSON PBrowserGetVersion
_ = Value
A.Null
data BrowserGetVersion = BrowserGetVersion
  {
    -- | Protocol version.
    BrowserGetVersion -> Text
browserGetVersionProtocolVersion :: T.Text,
    -- | Product name.
    BrowserGetVersion -> Text
browserGetVersionProduct :: T.Text,
    -- | Product revision.
    BrowserGetVersion -> Text
browserGetVersionRevision :: T.Text,
    -- | User-Agent.
    BrowserGetVersion -> Text
browserGetVersionUserAgent :: T.Text,
    -- | V8 version.
    BrowserGetVersion -> Text
browserGetVersionJsVersion :: T.Text
  }
  deriving (BrowserGetVersion -> BrowserGetVersion -> Bool
(BrowserGetVersion -> BrowserGetVersion -> Bool)
-> (BrowserGetVersion -> BrowserGetVersion -> Bool)
-> Eq BrowserGetVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserGetVersion -> BrowserGetVersion -> Bool
$c/= :: BrowserGetVersion -> BrowserGetVersion -> Bool
== :: BrowserGetVersion -> BrowserGetVersion -> Bool
$c== :: BrowserGetVersion -> BrowserGetVersion -> Bool
Eq, Int -> BrowserGetVersion -> ShowS
[BrowserGetVersion] -> ShowS
BrowserGetVersion -> String
(Int -> BrowserGetVersion -> ShowS)
-> (BrowserGetVersion -> String)
-> ([BrowserGetVersion] -> ShowS)
-> Show BrowserGetVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserGetVersion] -> ShowS
$cshowList :: [BrowserGetVersion] -> ShowS
show :: BrowserGetVersion -> String
$cshow :: BrowserGetVersion -> String
showsPrec :: Int -> BrowserGetVersion -> ShowS
$cshowsPrec :: Int -> BrowserGetVersion -> ShowS
Show)
instance FromJSON BrowserGetVersion where
  parseJSON :: Value -> Parser BrowserGetVersion
parseJSON = String
-> (Object -> Parser BrowserGetVersion)
-> Value
-> Parser BrowserGetVersion
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BrowserGetVersion" ((Object -> Parser BrowserGetVersion)
 -> Value -> Parser BrowserGetVersion)
-> (Object -> Parser BrowserGetVersion)
-> Value
-> Parser BrowserGetVersion
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Text -> Text -> Text -> BrowserGetVersion
BrowserGetVersion
    (Text -> Text -> Text -> Text -> Text -> BrowserGetVersion)
-> Parser Text
-> Parser (Text -> Text -> Text -> Text -> BrowserGetVersion)
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
"protocolVersion"
    Parser (Text -> Text -> Text -> Text -> BrowserGetVersion)
-> Parser Text
-> Parser (Text -> Text -> Text -> BrowserGetVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"product"
    Parser (Text -> Text -> Text -> BrowserGetVersion)
-> Parser Text -> Parser (Text -> Text -> BrowserGetVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"revision"
    Parser (Text -> Text -> BrowserGetVersion)
-> Parser Text -> Parser (Text -> BrowserGetVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"userAgent"
    Parser (Text -> BrowserGetVersion)
-> Parser Text -> Parser BrowserGetVersion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"jsVersion"
instance Command PBrowserGetVersion where
  type CommandResponse PBrowserGetVersion = BrowserGetVersion
  commandName :: Proxy PBrowserGetVersion -> String
commandName Proxy PBrowserGetVersion
_ = String
"Browser.getVersion"

-- | Returns the command line switches for the browser process if, and only if
--   --enable-automation is on the commandline.

-- | Parameters of the 'Browser.getBrowserCommandLine' command.
data PBrowserGetBrowserCommandLine = PBrowserGetBrowserCommandLine
  deriving (PBrowserGetBrowserCommandLine
-> PBrowserGetBrowserCommandLine -> Bool
(PBrowserGetBrowserCommandLine
 -> PBrowserGetBrowserCommandLine -> Bool)
-> (PBrowserGetBrowserCommandLine
    -> PBrowserGetBrowserCommandLine -> Bool)
-> Eq PBrowserGetBrowserCommandLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserGetBrowserCommandLine
-> PBrowserGetBrowserCommandLine -> Bool
$c/= :: PBrowserGetBrowserCommandLine
-> PBrowserGetBrowserCommandLine -> Bool
== :: PBrowserGetBrowserCommandLine
-> PBrowserGetBrowserCommandLine -> Bool
$c== :: PBrowserGetBrowserCommandLine
-> PBrowserGetBrowserCommandLine -> Bool
Eq, Int -> PBrowserGetBrowserCommandLine -> ShowS
[PBrowserGetBrowserCommandLine] -> ShowS
PBrowserGetBrowserCommandLine -> String
(Int -> PBrowserGetBrowserCommandLine -> ShowS)
-> (PBrowserGetBrowserCommandLine -> String)
-> ([PBrowserGetBrowserCommandLine] -> ShowS)
-> Show PBrowserGetBrowserCommandLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserGetBrowserCommandLine] -> ShowS
$cshowList :: [PBrowserGetBrowserCommandLine] -> ShowS
show :: PBrowserGetBrowserCommandLine -> String
$cshow :: PBrowserGetBrowserCommandLine -> String
showsPrec :: Int -> PBrowserGetBrowserCommandLine -> ShowS
$cshowsPrec :: Int -> PBrowserGetBrowserCommandLine -> ShowS
Show)
pBrowserGetBrowserCommandLine
  :: PBrowserGetBrowserCommandLine
pBrowserGetBrowserCommandLine :: PBrowserGetBrowserCommandLine
pBrowserGetBrowserCommandLine
  = PBrowserGetBrowserCommandLine
PBrowserGetBrowserCommandLine
instance ToJSON PBrowserGetBrowserCommandLine where
  toJSON :: PBrowserGetBrowserCommandLine -> Value
toJSON PBrowserGetBrowserCommandLine
_ = Value
A.Null
data BrowserGetBrowserCommandLine = BrowserGetBrowserCommandLine
  {
    -- | Commandline parameters
    BrowserGetBrowserCommandLine -> [Text]
browserGetBrowserCommandLineArguments :: [T.Text]
  }
  deriving (BrowserGetBrowserCommandLine
-> BrowserGetBrowserCommandLine -> Bool
(BrowserGetBrowserCommandLine
 -> BrowserGetBrowserCommandLine -> Bool)
-> (BrowserGetBrowserCommandLine
    -> BrowserGetBrowserCommandLine -> Bool)
-> Eq BrowserGetBrowserCommandLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserGetBrowserCommandLine
-> BrowserGetBrowserCommandLine -> Bool
$c/= :: BrowserGetBrowserCommandLine
-> BrowserGetBrowserCommandLine -> Bool
== :: BrowserGetBrowserCommandLine
-> BrowserGetBrowserCommandLine -> Bool
$c== :: BrowserGetBrowserCommandLine
-> BrowserGetBrowserCommandLine -> Bool
Eq, Int -> BrowserGetBrowserCommandLine -> ShowS
[BrowserGetBrowserCommandLine] -> ShowS
BrowserGetBrowserCommandLine -> String
(Int -> BrowserGetBrowserCommandLine -> ShowS)
-> (BrowserGetBrowserCommandLine -> String)
-> ([BrowserGetBrowserCommandLine] -> ShowS)
-> Show BrowserGetBrowserCommandLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserGetBrowserCommandLine] -> ShowS
$cshowList :: [BrowserGetBrowserCommandLine] -> ShowS
show :: BrowserGetBrowserCommandLine -> String
$cshow :: BrowserGetBrowserCommandLine -> String
showsPrec :: Int -> BrowserGetBrowserCommandLine -> ShowS
$cshowsPrec :: Int -> BrowserGetBrowserCommandLine -> ShowS
Show)
instance FromJSON BrowserGetBrowserCommandLine where
  parseJSON :: Value -> Parser BrowserGetBrowserCommandLine
parseJSON = String
-> (Object -> Parser BrowserGetBrowserCommandLine)
-> Value
-> Parser BrowserGetBrowserCommandLine
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BrowserGetBrowserCommandLine" ((Object -> Parser BrowserGetBrowserCommandLine)
 -> Value -> Parser BrowserGetBrowserCommandLine)
-> (Object -> Parser BrowserGetBrowserCommandLine)
-> Value
-> Parser BrowserGetBrowserCommandLine
forall a b. (a -> b) -> a -> b
$ \Object
o -> [Text] -> BrowserGetBrowserCommandLine
BrowserGetBrowserCommandLine
    ([Text] -> BrowserGetBrowserCommandLine)
-> Parser [Text] -> Parser BrowserGetBrowserCommandLine
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
"arguments"
instance Command PBrowserGetBrowserCommandLine where
  type CommandResponse PBrowserGetBrowserCommandLine = BrowserGetBrowserCommandLine
  commandName :: Proxy PBrowserGetBrowserCommandLine -> String
commandName Proxy PBrowserGetBrowserCommandLine
_ = String
"Browser.getBrowserCommandLine"

-- | Get Chrome histograms.

-- | Parameters of the 'Browser.getHistograms' command.
data PBrowserGetHistograms = PBrowserGetHistograms
  {
    -- | Requested substring in name. Only histograms which have query as a
    --   substring in their name are extracted. An empty or absent query returns
    --   all histograms.
    PBrowserGetHistograms -> Maybe Text
pBrowserGetHistogramsQuery :: Maybe T.Text,
    -- | If true, retrieve delta since last call.
    PBrowserGetHistograms -> Maybe Bool
pBrowserGetHistogramsDelta :: Maybe Bool
  }
  deriving (PBrowserGetHistograms -> PBrowserGetHistograms -> Bool
(PBrowserGetHistograms -> PBrowserGetHistograms -> Bool)
-> (PBrowserGetHistograms -> PBrowserGetHistograms -> Bool)
-> Eq PBrowserGetHistograms
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserGetHistograms -> PBrowserGetHistograms -> Bool
$c/= :: PBrowserGetHistograms -> PBrowserGetHistograms -> Bool
== :: PBrowserGetHistograms -> PBrowserGetHistograms -> Bool
$c== :: PBrowserGetHistograms -> PBrowserGetHistograms -> Bool
Eq, Int -> PBrowserGetHistograms -> ShowS
[PBrowserGetHistograms] -> ShowS
PBrowserGetHistograms -> String
(Int -> PBrowserGetHistograms -> ShowS)
-> (PBrowserGetHistograms -> String)
-> ([PBrowserGetHistograms] -> ShowS)
-> Show PBrowserGetHistograms
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserGetHistograms] -> ShowS
$cshowList :: [PBrowserGetHistograms] -> ShowS
show :: PBrowserGetHistograms -> String
$cshow :: PBrowserGetHistograms -> String
showsPrec :: Int -> PBrowserGetHistograms -> ShowS
$cshowsPrec :: Int -> PBrowserGetHistograms -> ShowS
Show)
pBrowserGetHistograms
  :: PBrowserGetHistograms
pBrowserGetHistograms :: PBrowserGetHistograms
pBrowserGetHistograms
  = Maybe Text -> Maybe Bool -> PBrowserGetHistograms
PBrowserGetHistograms
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PBrowserGetHistograms where
  toJSON :: PBrowserGetHistograms -> Value
toJSON PBrowserGetHistograms
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
"query" 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
<$> (PBrowserGetHistograms -> Maybe Text
pBrowserGetHistogramsQuery PBrowserGetHistograms
p),
    (Text
"delta" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PBrowserGetHistograms -> Maybe Bool
pBrowserGetHistogramsDelta PBrowserGetHistograms
p)
    ]
data BrowserGetHistograms = BrowserGetHistograms
  {
    -- | Histograms.
    BrowserGetHistograms -> [BrowserHistogram]
browserGetHistogramsHistograms :: [BrowserHistogram]
  }
  deriving (BrowserGetHistograms -> BrowserGetHistograms -> Bool
(BrowserGetHistograms -> BrowserGetHistograms -> Bool)
-> (BrowserGetHistograms -> BrowserGetHistograms -> Bool)
-> Eq BrowserGetHistograms
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserGetHistograms -> BrowserGetHistograms -> Bool
$c/= :: BrowserGetHistograms -> BrowserGetHistograms -> Bool
== :: BrowserGetHistograms -> BrowserGetHistograms -> Bool
$c== :: BrowserGetHistograms -> BrowserGetHistograms -> Bool
Eq, Int -> BrowserGetHistograms -> ShowS
[BrowserGetHistograms] -> ShowS
BrowserGetHistograms -> String
(Int -> BrowserGetHistograms -> ShowS)
-> (BrowserGetHistograms -> String)
-> ([BrowserGetHistograms] -> ShowS)
-> Show BrowserGetHistograms
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserGetHistograms] -> ShowS
$cshowList :: [BrowserGetHistograms] -> ShowS
show :: BrowserGetHistograms -> String
$cshow :: BrowserGetHistograms -> String
showsPrec :: Int -> BrowserGetHistograms -> ShowS
$cshowsPrec :: Int -> BrowserGetHistograms -> ShowS
Show)
instance FromJSON BrowserGetHistograms where
  parseJSON :: Value -> Parser BrowserGetHistograms
parseJSON = String
-> (Object -> Parser BrowserGetHistograms)
-> Value
-> Parser BrowserGetHistograms
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BrowserGetHistograms" ((Object -> Parser BrowserGetHistograms)
 -> Value -> Parser BrowserGetHistograms)
-> (Object -> Parser BrowserGetHistograms)
-> Value
-> Parser BrowserGetHistograms
forall a b. (a -> b) -> a -> b
$ \Object
o -> [BrowserHistogram] -> BrowserGetHistograms
BrowserGetHistograms
    ([BrowserHistogram] -> BrowserGetHistograms)
-> Parser [BrowserHistogram] -> Parser BrowserGetHistograms
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [BrowserHistogram]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"histograms"
instance Command PBrowserGetHistograms where
  type CommandResponse PBrowserGetHistograms = BrowserGetHistograms
  commandName :: Proxy PBrowserGetHistograms -> String
commandName Proxy PBrowserGetHistograms
_ = String
"Browser.getHistograms"

-- | Get a Chrome histogram by name.

-- | Parameters of the 'Browser.getHistogram' command.
data PBrowserGetHistogram = PBrowserGetHistogram
  {
    -- | Requested histogram name.
    PBrowserGetHistogram -> Text
pBrowserGetHistogramName :: T.Text,
    -- | If true, retrieve delta since last call.
    PBrowserGetHistogram -> Maybe Bool
pBrowserGetHistogramDelta :: Maybe Bool
  }
  deriving (PBrowserGetHistogram -> PBrowserGetHistogram -> Bool
(PBrowserGetHistogram -> PBrowserGetHistogram -> Bool)
-> (PBrowserGetHistogram -> PBrowserGetHistogram -> Bool)
-> Eq PBrowserGetHistogram
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserGetHistogram -> PBrowserGetHistogram -> Bool
$c/= :: PBrowserGetHistogram -> PBrowserGetHistogram -> Bool
== :: PBrowserGetHistogram -> PBrowserGetHistogram -> Bool
$c== :: PBrowserGetHistogram -> PBrowserGetHistogram -> Bool
Eq, Int -> PBrowserGetHistogram -> ShowS
[PBrowserGetHistogram] -> ShowS
PBrowserGetHistogram -> String
(Int -> PBrowserGetHistogram -> ShowS)
-> (PBrowserGetHistogram -> String)
-> ([PBrowserGetHistogram] -> ShowS)
-> Show PBrowserGetHistogram
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserGetHistogram] -> ShowS
$cshowList :: [PBrowserGetHistogram] -> ShowS
show :: PBrowserGetHistogram -> String
$cshow :: PBrowserGetHistogram -> String
showsPrec :: Int -> PBrowserGetHistogram -> ShowS
$cshowsPrec :: Int -> PBrowserGetHistogram -> ShowS
Show)
pBrowserGetHistogram
  {-
  -- | Requested histogram name.
  -}
  :: T.Text
  -> PBrowserGetHistogram
pBrowserGetHistogram :: Text -> PBrowserGetHistogram
pBrowserGetHistogram
  Text
arg_pBrowserGetHistogramName
  = Text -> Maybe Bool -> PBrowserGetHistogram
PBrowserGetHistogram
    Text
arg_pBrowserGetHistogramName
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PBrowserGetHistogram where
  toJSON :: PBrowserGetHistogram -> Value
toJSON PBrowserGetHistogram
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
"name" 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 (PBrowserGetHistogram -> Text
pBrowserGetHistogramName PBrowserGetHistogram
p),
    (Text
"delta" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PBrowserGetHistogram -> Maybe Bool
pBrowserGetHistogramDelta PBrowserGetHistogram
p)
    ]
data BrowserGetHistogram = BrowserGetHistogram
  {
    -- | Histogram.
    BrowserGetHistogram -> BrowserHistogram
browserGetHistogramHistogram :: BrowserHistogram
  }
  deriving (BrowserGetHistogram -> BrowserGetHistogram -> Bool
(BrowserGetHistogram -> BrowserGetHistogram -> Bool)
-> (BrowserGetHistogram -> BrowserGetHistogram -> Bool)
-> Eq BrowserGetHistogram
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserGetHistogram -> BrowserGetHistogram -> Bool
$c/= :: BrowserGetHistogram -> BrowserGetHistogram -> Bool
== :: BrowserGetHistogram -> BrowserGetHistogram -> Bool
$c== :: BrowserGetHistogram -> BrowserGetHistogram -> Bool
Eq, Int -> BrowserGetHistogram -> ShowS
[BrowserGetHistogram] -> ShowS
BrowserGetHistogram -> String
(Int -> BrowserGetHistogram -> ShowS)
-> (BrowserGetHistogram -> String)
-> ([BrowserGetHistogram] -> ShowS)
-> Show BrowserGetHistogram
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserGetHistogram] -> ShowS
$cshowList :: [BrowserGetHistogram] -> ShowS
show :: BrowserGetHistogram -> String
$cshow :: BrowserGetHistogram -> String
showsPrec :: Int -> BrowserGetHistogram -> ShowS
$cshowsPrec :: Int -> BrowserGetHistogram -> ShowS
Show)
instance FromJSON BrowserGetHistogram where
  parseJSON :: Value -> Parser BrowserGetHistogram
parseJSON = String
-> (Object -> Parser BrowserGetHistogram)
-> Value
-> Parser BrowserGetHistogram
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BrowserGetHistogram" ((Object -> Parser BrowserGetHistogram)
 -> Value -> Parser BrowserGetHistogram)
-> (Object -> Parser BrowserGetHistogram)
-> Value
-> Parser BrowserGetHistogram
forall a b. (a -> b) -> a -> b
$ \Object
o -> BrowserHistogram -> BrowserGetHistogram
BrowserGetHistogram
    (BrowserHistogram -> BrowserGetHistogram)
-> Parser BrowserHistogram -> Parser BrowserGetHistogram
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser BrowserHistogram
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"histogram"
instance Command PBrowserGetHistogram where
  type CommandResponse PBrowserGetHistogram = BrowserGetHistogram
  commandName :: Proxy PBrowserGetHistogram -> String
commandName Proxy PBrowserGetHistogram
_ = String
"Browser.getHistogram"

-- | Get position and size of the browser window.

-- | Parameters of the 'Browser.getWindowBounds' command.
data PBrowserGetWindowBounds = PBrowserGetWindowBounds
  {
    -- | Browser window id.
    PBrowserGetWindowBounds -> Int
pBrowserGetWindowBoundsWindowId :: BrowserWindowID
  }
  deriving (PBrowserGetWindowBounds -> PBrowserGetWindowBounds -> Bool
(PBrowserGetWindowBounds -> PBrowserGetWindowBounds -> Bool)
-> (PBrowserGetWindowBounds -> PBrowserGetWindowBounds -> Bool)
-> Eq PBrowserGetWindowBounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserGetWindowBounds -> PBrowserGetWindowBounds -> Bool
$c/= :: PBrowserGetWindowBounds -> PBrowserGetWindowBounds -> Bool
== :: PBrowserGetWindowBounds -> PBrowserGetWindowBounds -> Bool
$c== :: PBrowserGetWindowBounds -> PBrowserGetWindowBounds -> Bool
Eq, Int -> PBrowserGetWindowBounds -> ShowS
[PBrowserGetWindowBounds] -> ShowS
PBrowserGetWindowBounds -> String
(Int -> PBrowserGetWindowBounds -> ShowS)
-> (PBrowserGetWindowBounds -> String)
-> ([PBrowserGetWindowBounds] -> ShowS)
-> Show PBrowserGetWindowBounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserGetWindowBounds] -> ShowS
$cshowList :: [PBrowserGetWindowBounds] -> ShowS
show :: PBrowserGetWindowBounds -> String
$cshow :: PBrowserGetWindowBounds -> String
showsPrec :: Int -> PBrowserGetWindowBounds -> ShowS
$cshowsPrec :: Int -> PBrowserGetWindowBounds -> ShowS
Show)
pBrowserGetWindowBounds
  {-
  -- | Browser window id.
  -}
  :: BrowserWindowID
  -> PBrowserGetWindowBounds
pBrowserGetWindowBounds :: Int -> PBrowserGetWindowBounds
pBrowserGetWindowBounds
  Int
arg_pBrowserGetWindowBoundsWindowId
  = Int -> PBrowserGetWindowBounds
PBrowserGetWindowBounds
    Int
arg_pBrowserGetWindowBoundsWindowId
instance ToJSON PBrowserGetWindowBounds where
  toJSON :: PBrowserGetWindowBounds -> Value
toJSON PBrowserGetWindowBounds
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
"windowId" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (PBrowserGetWindowBounds -> Int
pBrowserGetWindowBoundsWindowId PBrowserGetWindowBounds
p)
    ]
data BrowserGetWindowBounds = BrowserGetWindowBounds
  {
    -- | Bounds information of the window. When window state is 'minimized', the restored window
    --   position and size are returned.
    BrowserGetWindowBounds -> BrowserBounds
browserGetWindowBoundsBounds :: BrowserBounds
  }
  deriving (BrowserGetWindowBounds -> BrowserGetWindowBounds -> Bool
(BrowserGetWindowBounds -> BrowserGetWindowBounds -> Bool)
-> (BrowserGetWindowBounds -> BrowserGetWindowBounds -> Bool)
-> Eq BrowserGetWindowBounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserGetWindowBounds -> BrowserGetWindowBounds -> Bool
$c/= :: BrowserGetWindowBounds -> BrowserGetWindowBounds -> Bool
== :: BrowserGetWindowBounds -> BrowserGetWindowBounds -> Bool
$c== :: BrowserGetWindowBounds -> BrowserGetWindowBounds -> Bool
Eq, Int -> BrowserGetWindowBounds -> ShowS
[BrowserGetWindowBounds] -> ShowS
BrowserGetWindowBounds -> String
(Int -> BrowserGetWindowBounds -> ShowS)
-> (BrowserGetWindowBounds -> String)
-> ([BrowserGetWindowBounds] -> ShowS)
-> Show BrowserGetWindowBounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserGetWindowBounds] -> ShowS
$cshowList :: [BrowserGetWindowBounds] -> ShowS
show :: BrowserGetWindowBounds -> String
$cshow :: BrowserGetWindowBounds -> String
showsPrec :: Int -> BrowserGetWindowBounds -> ShowS
$cshowsPrec :: Int -> BrowserGetWindowBounds -> ShowS
Show)
instance FromJSON BrowserGetWindowBounds where
  parseJSON :: Value -> Parser BrowserGetWindowBounds
parseJSON = String
-> (Object -> Parser BrowserGetWindowBounds)
-> Value
-> Parser BrowserGetWindowBounds
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BrowserGetWindowBounds" ((Object -> Parser BrowserGetWindowBounds)
 -> Value -> Parser BrowserGetWindowBounds)
-> (Object -> Parser BrowserGetWindowBounds)
-> Value
-> Parser BrowserGetWindowBounds
forall a b. (a -> b) -> a -> b
$ \Object
o -> BrowserBounds -> BrowserGetWindowBounds
BrowserGetWindowBounds
    (BrowserBounds -> BrowserGetWindowBounds)
-> Parser BrowserBounds -> Parser BrowserGetWindowBounds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser BrowserBounds
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"bounds"
instance Command PBrowserGetWindowBounds where
  type CommandResponse PBrowserGetWindowBounds = BrowserGetWindowBounds
  commandName :: Proxy PBrowserGetWindowBounds -> String
commandName Proxy PBrowserGetWindowBounds
_ = String
"Browser.getWindowBounds"

-- | Get the browser window that contains the devtools target.

-- | Parameters of the 'Browser.getWindowForTarget' command.
data PBrowserGetWindowForTarget = PBrowserGetWindowForTarget
  {
    -- | Devtools agent host id. If called as a part of the session, associated targetId is used.
    PBrowserGetWindowForTarget -> Maybe Text
pBrowserGetWindowForTargetTargetId :: Maybe TargetTargetID
  }
  deriving (PBrowserGetWindowForTarget -> PBrowserGetWindowForTarget -> Bool
(PBrowserGetWindowForTarget -> PBrowserGetWindowForTarget -> Bool)
-> (PBrowserGetWindowForTarget
    -> PBrowserGetWindowForTarget -> Bool)
-> Eq PBrowserGetWindowForTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserGetWindowForTarget -> PBrowserGetWindowForTarget -> Bool
$c/= :: PBrowserGetWindowForTarget -> PBrowserGetWindowForTarget -> Bool
== :: PBrowserGetWindowForTarget -> PBrowserGetWindowForTarget -> Bool
$c== :: PBrowserGetWindowForTarget -> PBrowserGetWindowForTarget -> Bool
Eq, Int -> PBrowserGetWindowForTarget -> ShowS
[PBrowserGetWindowForTarget] -> ShowS
PBrowserGetWindowForTarget -> String
(Int -> PBrowserGetWindowForTarget -> ShowS)
-> (PBrowserGetWindowForTarget -> String)
-> ([PBrowserGetWindowForTarget] -> ShowS)
-> Show PBrowserGetWindowForTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserGetWindowForTarget] -> ShowS
$cshowList :: [PBrowserGetWindowForTarget] -> ShowS
show :: PBrowserGetWindowForTarget -> String
$cshow :: PBrowserGetWindowForTarget -> String
showsPrec :: Int -> PBrowserGetWindowForTarget -> ShowS
$cshowsPrec :: Int -> PBrowserGetWindowForTarget -> ShowS
Show)
pBrowserGetWindowForTarget
  :: PBrowserGetWindowForTarget
pBrowserGetWindowForTarget :: PBrowserGetWindowForTarget
pBrowserGetWindowForTarget
  = Maybe Text -> PBrowserGetWindowForTarget
PBrowserGetWindowForTarget
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PBrowserGetWindowForTarget where
  toJSON :: PBrowserGetWindowForTarget -> Value
toJSON PBrowserGetWindowForTarget
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
"targetId" 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
<$> (PBrowserGetWindowForTarget -> Maybe Text
pBrowserGetWindowForTargetTargetId PBrowserGetWindowForTarget
p)
    ]
data BrowserGetWindowForTarget = BrowserGetWindowForTarget
  {
    -- | Browser window id.
    BrowserGetWindowForTarget -> Int
browserGetWindowForTargetWindowId :: BrowserWindowID,
    -- | Bounds information of the window. When window state is 'minimized', the restored window
    --   position and size are returned.
    BrowserGetWindowForTarget -> BrowserBounds
browserGetWindowForTargetBounds :: BrowserBounds
  }
  deriving (BrowserGetWindowForTarget -> BrowserGetWindowForTarget -> Bool
(BrowserGetWindowForTarget -> BrowserGetWindowForTarget -> Bool)
-> (BrowserGetWindowForTarget -> BrowserGetWindowForTarget -> Bool)
-> Eq BrowserGetWindowForTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserGetWindowForTarget -> BrowserGetWindowForTarget -> Bool
$c/= :: BrowserGetWindowForTarget -> BrowserGetWindowForTarget -> Bool
== :: BrowserGetWindowForTarget -> BrowserGetWindowForTarget -> Bool
$c== :: BrowserGetWindowForTarget -> BrowserGetWindowForTarget -> Bool
Eq, Int -> BrowserGetWindowForTarget -> ShowS
[BrowserGetWindowForTarget] -> ShowS
BrowserGetWindowForTarget -> String
(Int -> BrowserGetWindowForTarget -> ShowS)
-> (BrowserGetWindowForTarget -> String)
-> ([BrowserGetWindowForTarget] -> ShowS)
-> Show BrowserGetWindowForTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserGetWindowForTarget] -> ShowS
$cshowList :: [BrowserGetWindowForTarget] -> ShowS
show :: BrowserGetWindowForTarget -> String
$cshow :: BrowserGetWindowForTarget -> String
showsPrec :: Int -> BrowserGetWindowForTarget -> ShowS
$cshowsPrec :: Int -> BrowserGetWindowForTarget -> ShowS
Show)
instance FromJSON BrowserGetWindowForTarget where
  parseJSON :: Value -> Parser BrowserGetWindowForTarget
parseJSON = String
-> (Object -> Parser BrowserGetWindowForTarget)
-> Value
-> Parser BrowserGetWindowForTarget
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BrowserGetWindowForTarget" ((Object -> Parser BrowserGetWindowForTarget)
 -> Value -> Parser BrowserGetWindowForTarget)
-> (Object -> Parser BrowserGetWindowForTarget)
-> Value
-> Parser BrowserGetWindowForTarget
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> BrowserBounds -> BrowserGetWindowForTarget
BrowserGetWindowForTarget
    (Int -> BrowserBounds -> BrowserGetWindowForTarget)
-> Parser Int
-> Parser (BrowserBounds -> BrowserGetWindowForTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"windowId"
    Parser (BrowserBounds -> BrowserGetWindowForTarget)
-> Parser BrowserBounds -> Parser BrowserGetWindowForTarget
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser BrowserBounds
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"bounds"
instance Command PBrowserGetWindowForTarget where
  type CommandResponse PBrowserGetWindowForTarget = BrowserGetWindowForTarget
  commandName :: Proxy PBrowserGetWindowForTarget -> String
commandName Proxy PBrowserGetWindowForTarget
_ = String
"Browser.getWindowForTarget"

-- | Set position and/or size of the browser window.

-- | Parameters of the 'Browser.setWindowBounds' command.
data PBrowserSetWindowBounds = PBrowserSetWindowBounds
  {
    -- | Browser window id.
    PBrowserSetWindowBounds -> Int
pBrowserSetWindowBoundsWindowId :: BrowserWindowID,
    -- | New window bounds. The 'minimized', 'maximized' and 'fullscreen' states cannot be combined
    --   with 'left', 'top', 'width' or 'height'. Leaves unspecified fields unchanged.
    PBrowserSetWindowBounds -> BrowserBounds
pBrowserSetWindowBoundsBounds :: BrowserBounds
  }
  deriving (PBrowserSetWindowBounds -> PBrowserSetWindowBounds -> Bool
(PBrowserSetWindowBounds -> PBrowserSetWindowBounds -> Bool)
-> (PBrowserSetWindowBounds -> PBrowserSetWindowBounds -> Bool)
-> Eq PBrowserSetWindowBounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserSetWindowBounds -> PBrowserSetWindowBounds -> Bool
$c/= :: PBrowserSetWindowBounds -> PBrowserSetWindowBounds -> Bool
== :: PBrowserSetWindowBounds -> PBrowserSetWindowBounds -> Bool
$c== :: PBrowserSetWindowBounds -> PBrowserSetWindowBounds -> Bool
Eq, Int -> PBrowserSetWindowBounds -> ShowS
[PBrowserSetWindowBounds] -> ShowS
PBrowserSetWindowBounds -> String
(Int -> PBrowserSetWindowBounds -> ShowS)
-> (PBrowserSetWindowBounds -> String)
-> ([PBrowserSetWindowBounds] -> ShowS)
-> Show PBrowserSetWindowBounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserSetWindowBounds] -> ShowS
$cshowList :: [PBrowserSetWindowBounds] -> ShowS
show :: PBrowserSetWindowBounds -> String
$cshow :: PBrowserSetWindowBounds -> String
showsPrec :: Int -> PBrowserSetWindowBounds -> ShowS
$cshowsPrec :: Int -> PBrowserSetWindowBounds -> ShowS
Show)
pBrowserSetWindowBounds
  {-
  -- | Browser window id.
  -}
  :: BrowserWindowID
  {-
  -- | New window bounds. The 'minimized', 'maximized' and 'fullscreen' states cannot be combined
  --   with 'left', 'top', 'width' or 'height'. Leaves unspecified fields unchanged.
  -}
  -> BrowserBounds
  -> PBrowserSetWindowBounds
pBrowserSetWindowBounds :: Int -> BrowserBounds -> PBrowserSetWindowBounds
pBrowserSetWindowBounds
  Int
arg_pBrowserSetWindowBoundsWindowId
  BrowserBounds
arg_pBrowserSetWindowBoundsBounds
  = Int -> BrowserBounds -> PBrowserSetWindowBounds
PBrowserSetWindowBounds
    Int
arg_pBrowserSetWindowBoundsWindowId
    BrowserBounds
arg_pBrowserSetWindowBoundsBounds
instance ToJSON PBrowserSetWindowBounds where
  toJSON :: PBrowserSetWindowBounds -> Value
toJSON PBrowserSetWindowBounds
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
"windowId" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (PBrowserSetWindowBounds -> Int
pBrowserSetWindowBoundsWindowId PBrowserSetWindowBounds
p),
    (Text
"bounds" Text -> BrowserBounds -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (BrowserBounds -> Pair) -> Maybe BrowserBounds -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BrowserBounds -> Maybe BrowserBounds
forall a. a -> Maybe a
Just (PBrowserSetWindowBounds -> BrowserBounds
pBrowserSetWindowBoundsBounds PBrowserSetWindowBounds
p)
    ]
instance Command PBrowserSetWindowBounds where
  type CommandResponse PBrowserSetWindowBounds = ()
  commandName :: Proxy PBrowserSetWindowBounds -> String
commandName Proxy PBrowserSetWindowBounds
_ = String
"Browser.setWindowBounds"
  fromJSON :: Proxy PBrowserSetWindowBounds
-> Value -> Result (CommandResponse PBrowserSetWindowBounds)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PBrowserSetWindowBounds -> Result ())
-> Proxy PBrowserSetWindowBounds
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PBrowserSetWindowBounds -> ())
-> Proxy PBrowserSetWindowBounds
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PBrowserSetWindowBounds -> ()
forall a b. a -> b -> a
const ()

-- | Set dock tile details, platform-specific.

-- | Parameters of the 'Browser.setDockTile' command.
data PBrowserSetDockTile = PBrowserSetDockTile
  {
    PBrowserSetDockTile -> Maybe Text
pBrowserSetDockTileBadgeLabel :: Maybe T.Text,
    -- | Png encoded image. (Encoded as a base64 string when passed over JSON)
    PBrowserSetDockTile -> Maybe Text
pBrowserSetDockTileImage :: Maybe T.Text
  }
  deriving (PBrowserSetDockTile -> PBrowserSetDockTile -> Bool
(PBrowserSetDockTile -> PBrowserSetDockTile -> Bool)
-> (PBrowserSetDockTile -> PBrowserSetDockTile -> Bool)
-> Eq PBrowserSetDockTile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserSetDockTile -> PBrowserSetDockTile -> Bool
$c/= :: PBrowserSetDockTile -> PBrowserSetDockTile -> Bool
== :: PBrowserSetDockTile -> PBrowserSetDockTile -> Bool
$c== :: PBrowserSetDockTile -> PBrowserSetDockTile -> Bool
Eq, Int -> PBrowserSetDockTile -> ShowS
[PBrowserSetDockTile] -> ShowS
PBrowserSetDockTile -> String
(Int -> PBrowserSetDockTile -> ShowS)
-> (PBrowserSetDockTile -> String)
-> ([PBrowserSetDockTile] -> ShowS)
-> Show PBrowserSetDockTile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserSetDockTile] -> ShowS
$cshowList :: [PBrowserSetDockTile] -> ShowS
show :: PBrowserSetDockTile -> String
$cshow :: PBrowserSetDockTile -> String
showsPrec :: Int -> PBrowserSetDockTile -> ShowS
$cshowsPrec :: Int -> PBrowserSetDockTile -> ShowS
Show)
pBrowserSetDockTile
  :: PBrowserSetDockTile
pBrowserSetDockTile :: PBrowserSetDockTile
pBrowserSetDockTile
  = Maybe Text -> Maybe Text -> PBrowserSetDockTile
PBrowserSetDockTile
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PBrowserSetDockTile where
  toJSON :: PBrowserSetDockTile -> Value
toJSON PBrowserSetDockTile
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
"badgeLabel" 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
<$> (PBrowserSetDockTile -> Maybe Text
pBrowserSetDockTileBadgeLabel PBrowserSetDockTile
p),
    (Text
"image" 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
<$> (PBrowserSetDockTile -> Maybe Text
pBrowserSetDockTileImage PBrowserSetDockTile
p)
    ]
instance Command PBrowserSetDockTile where
  type CommandResponse PBrowserSetDockTile = ()
  commandName :: Proxy PBrowserSetDockTile -> String
commandName Proxy PBrowserSetDockTile
_ = String
"Browser.setDockTile"
  fromJSON :: Proxy PBrowserSetDockTile
-> Value -> Result (CommandResponse PBrowserSetDockTile)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PBrowserSetDockTile -> Result ())
-> Proxy PBrowserSetDockTile
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PBrowserSetDockTile -> ())
-> Proxy PBrowserSetDockTile
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PBrowserSetDockTile -> ()
forall a b. a -> b -> a
const ()

-- | Invoke custom browser commands used by telemetry.

-- | Parameters of the 'Browser.executeBrowserCommand' command.
data PBrowserExecuteBrowserCommand = PBrowserExecuteBrowserCommand
  {
    PBrowserExecuteBrowserCommand -> BrowserBrowserCommandId
pBrowserExecuteBrowserCommandCommandId :: BrowserBrowserCommandId
  }
  deriving (PBrowserExecuteBrowserCommand
-> PBrowserExecuteBrowserCommand -> Bool
(PBrowserExecuteBrowserCommand
 -> PBrowserExecuteBrowserCommand -> Bool)
-> (PBrowserExecuteBrowserCommand
    -> PBrowserExecuteBrowserCommand -> Bool)
-> Eq PBrowserExecuteBrowserCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBrowserExecuteBrowserCommand
-> PBrowserExecuteBrowserCommand -> Bool
$c/= :: PBrowserExecuteBrowserCommand
-> PBrowserExecuteBrowserCommand -> Bool
== :: PBrowserExecuteBrowserCommand
-> PBrowserExecuteBrowserCommand -> Bool
$c== :: PBrowserExecuteBrowserCommand
-> PBrowserExecuteBrowserCommand -> Bool
Eq, Int -> PBrowserExecuteBrowserCommand -> ShowS
[PBrowserExecuteBrowserCommand] -> ShowS
PBrowserExecuteBrowserCommand -> String
(Int -> PBrowserExecuteBrowserCommand -> ShowS)
-> (PBrowserExecuteBrowserCommand -> String)
-> ([PBrowserExecuteBrowserCommand] -> ShowS)
-> Show PBrowserExecuteBrowserCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBrowserExecuteBrowserCommand] -> ShowS
$cshowList :: [PBrowserExecuteBrowserCommand] -> ShowS
show :: PBrowserExecuteBrowserCommand -> String
$cshow :: PBrowserExecuteBrowserCommand -> String
showsPrec :: Int -> PBrowserExecuteBrowserCommand -> ShowS
$cshowsPrec :: Int -> PBrowserExecuteBrowserCommand -> ShowS
Show)
pBrowserExecuteBrowserCommand
  :: BrowserBrowserCommandId
  -> PBrowserExecuteBrowserCommand
pBrowserExecuteBrowserCommand :: BrowserBrowserCommandId -> PBrowserExecuteBrowserCommand
pBrowserExecuteBrowserCommand
  BrowserBrowserCommandId
arg_pBrowserExecuteBrowserCommandCommandId
  = BrowserBrowserCommandId -> PBrowserExecuteBrowserCommand
PBrowserExecuteBrowserCommand
    BrowserBrowserCommandId
arg_pBrowserExecuteBrowserCommandCommandId
instance ToJSON PBrowserExecuteBrowserCommand where
  toJSON :: PBrowserExecuteBrowserCommand -> Value
toJSON PBrowserExecuteBrowserCommand
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
"commandId" Text -> BrowserBrowserCommandId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (BrowserBrowserCommandId -> Pair)
-> Maybe BrowserBrowserCommandId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BrowserBrowserCommandId -> Maybe BrowserBrowserCommandId
forall a. a -> Maybe a
Just (PBrowserExecuteBrowserCommand -> BrowserBrowserCommandId
pBrowserExecuteBrowserCommandCommandId PBrowserExecuteBrowserCommand
p)
    ]
instance Command PBrowserExecuteBrowserCommand where
  type CommandResponse PBrowserExecuteBrowserCommand = ()
  commandName :: Proxy PBrowserExecuteBrowserCommand -> String
commandName Proxy PBrowserExecuteBrowserCommand
_ = String
"Browser.executeBrowserCommand"
  fromJSON :: Proxy PBrowserExecuteBrowserCommand
-> Value -> Result (CommandResponse PBrowserExecuteBrowserCommand)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PBrowserExecuteBrowserCommand -> Result ())
-> Proxy PBrowserExecuteBrowserCommand
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PBrowserExecuteBrowserCommand -> ())
-> Proxy PBrowserExecuteBrowserCommand
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PBrowserExecuteBrowserCommand -> ()
forall a b. a -> b -> a
const ()

-- | Type 'Target.TargetID'.
type TargetTargetID = T.Text

-- | Type 'Target.SessionID'.
--   Unique identifier of attached debugging session.
type TargetSessionID = T.Text

-- | Type 'Target.TargetInfo'.
data TargetTargetInfo = TargetTargetInfo
  {
    TargetTargetInfo -> Text
targetTargetInfoTargetId :: TargetTargetID,
    TargetTargetInfo -> Text
targetTargetInfoType :: T.Text,
    TargetTargetInfo -> Text
targetTargetInfoTitle :: T.Text,
    TargetTargetInfo -> Text
targetTargetInfoUrl :: T.Text,
    -- | Whether the target has an attached client.
    TargetTargetInfo -> Bool
targetTargetInfoAttached :: Bool,
    -- | Opener target Id
    TargetTargetInfo -> Maybe Text
targetTargetInfoOpenerId :: Maybe TargetTargetID,
    -- | Whether the target has access to the originating window.
    TargetTargetInfo -> Bool
targetTargetInfoCanAccessOpener :: Bool,
    -- | Frame id of originating window (is only set if target has an opener).
    TargetTargetInfo -> Maybe Text
targetTargetInfoOpenerFrameId :: Maybe DOMPageNetworkEmulationSecurity.PageFrameId,
    TargetTargetInfo -> Maybe Text
targetTargetInfoBrowserContextId :: Maybe BrowserBrowserContextID,
    -- | Provides additional details for specific target types. For example, for
    --   the type of "page", this may be set to "portal" or "prerender".
    TargetTargetInfo -> Maybe Text
targetTargetInfoSubtype :: Maybe T.Text
  }
  deriving (TargetTargetInfo -> TargetTargetInfo -> Bool
(TargetTargetInfo -> TargetTargetInfo -> Bool)
-> (TargetTargetInfo -> TargetTargetInfo -> Bool)
-> Eq TargetTargetInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetTargetInfo -> TargetTargetInfo -> Bool
$c/= :: TargetTargetInfo -> TargetTargetInfo -> Bool
== :: TargetTargetInfo -> TargetTargetInfo -> Bool
$c== :: TargetTargetInfo -> TargetTargetInfo -> Bool
Eq, Int -> TargetTargetInfo -> ShowS
[TargetTargetInfo] -> ShowS
TargetTargetInfo -> String
(Int -> TargetTargetInfo -> ShowS)
-> (TargetTargetInfo -> String)
-> ([TargetTargetInfo] -> ShowS)
-> Show TargetTargetInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetTargetInfo] -> ShowS
$cshowList :: [TargetTargetInfo] -> ShowS
show :: TargetTargetInfo -> String
$cshow :: TargetTargetInfo -> String
showsPrec :: Int -> TargetTargetInfo -> ShowS
$cshowsPrec :: Int -> TargetTargetInfo -> ShowS
Show)
instance FromJSON TargetTargetInfo where
  parseJSON :: Value -> Parser TargetTargetInfo
parseJSON = String
-> (Object -> Parser TargetTargetInfo)
-> Value
-> Parser TargetTargetInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetTargetInfo" ((Object -> Parser TargetTargetInfo)
 -> Value -> Parser TargetTargetInfo)
-> (Object -> Parser TargetTargetInfo)
-> Value
-> Parser TargetTargetInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> Text
-> Text
-> Bool
-> Maybe Text
-> Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> TargetTargetInfo
TargetTargetInfo
    (Text
 -> Text
 -> Text
 -> Text
 -> Bool
 -> Maybe Text
 -> Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> TargetTargetInfo)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Bool
      -> Maybe Text
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> TargetTargetInfo)
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
"targetId"
    Parser
  (Text
   -> Text
   -> Text
   -> Bool
   -> Maybe Text
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> TargetTargetInfo)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Bool
      -> Maybe Text
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> TargetTargetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"type"
    Parser
  (Text
   -> Text
   -> Bool
   -> Maybe Text
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> TargetTargetInfo)
-> Parser Text
-> Parser
     (Text
      -> Bool
      -> Maybe Text
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> TargetTargetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"title"
    Parser
  (Text
   -> Bool
   -> Maybe Text
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> TargetTargetInfo)
-> Parser Text
-> Parser
     (Bool
      -> Maybe Text
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> TargetTargetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"url"
    Parser
  (Bool
   -> Maybe Text
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> TargetTargetInfo)
-> Parser Bool
-> Parser
     (Maybe Text
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> TargetTargetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"attached"
    Parser
  (Maybe Text
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> TargetTargetInfo)
-> Parser (Maybe Text)
-> Parser
     (Bool
      -> Maybe Text -> Maybe Text -> Maybe Text -> TargetTargetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"openerId"
    Parser
  (Bool
   -> Maybe Text -> Maybe Text -> Maybe Text -> TargetTargetInfo)
-> Parser Bool
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> TargetTargetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"canAccessOpener"
    Parser (Maybe Text -> Maybe Text -> Maybe Text -> TargetTargetInfo)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> TargetTargetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"openerFrameId"
    Parser (Maybe Text -> Maybe Text -> TargetTargetInfo)
-> Parser (Maybe Text) -> Parser (Maybe Text -> TargetTargetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"browserContextId"
    Parser (Maybe Text -> TargetTargetInfo)
-> Parser (Maybe Text) -> Parser TargetTargetInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"subtype"
instance ToJSON TargetTargetInfo where
  toJSON :: TargetTargetInfo -> Value
toJSON TargetTargetInfo
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
"targetId" 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 (TargetTargetInfo -> Text
targetTargetInfoTargetId TargetTargetInfo
p),
    (Text
"type" 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 (TargetTargetInfo -> Text
targetTargetInfoType TargetTargetInfo
p),
    (Text
"title" 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 (TargetTargetInfo -> Text
targetTargetInfoTitle TargetTargetInfo
p),
    (Text
"url" 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 (TargetTargetInfo -> Text
targetTargetInfoUrl TargetTargetInfo
p),
    (Text
"attached" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (TargetTargetInfo -> Bool
targetTargetInfoAttached TargetTargetInfo
p),
    (Text
"openerId" 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
<$> (TargetTargetInfo -> Maybe Text
targetTargetInfoOpenerId TargetTargetInfo
p),
    (Text
"canAccessOpener" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (TargetTargetInfo -> Bool
targetTargetInfoCanAccessOpener TargetTargetInfo
p),
    (Text
"openerFrameId" 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
<$> (TargetTargetInfo -> Maybe Text
targetTargetInfoOpenerFrameId TargetTargetInfo
p),
    (Text
"browserContextId" 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
<$> (TargetTargetInfo -> Maybe Text
targetTargetInfoBrowserContextId TargetTargetInfo
p),
    (Text
"subtype" 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
<$> (TargetTargetInfo -> Maybe Text
targetTargetInfoSubtype TargetTargetInfo
p)
    ]

-- | Type 'Target.FilterEntry'.
--   A filter used by target query/discovery/auto-attach operations.
data TargetFilterEntry = TargetFilterEntry
  {
    -- | If set, causes exclusion of mathcing targets from the list.
    TargetFilterEntry -> Maybe Bool
targetFilterEntryExclude :: Maybe Bool,
    -- | If not present, matches any type.
    TargetFilterEntry -> Maybe Text
targetFilterEntryType :: Maybe T.Text
  }
  deriving (TargetFilterEntry -> TargetFilterEntry -> Bool
(TargetFilterEntry -> TargetFilterEntry -> Bool)
-> (TargetFilterEntry -> TargetFilterEntry -> Bool)
-> Eq TargetFilterEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetFilterEntry -> TargetFilterEntry -> Bool
$c/= :: TargetFilterEntry -> TargetFilterEntry -> Bool
== :: TargetFilterEntry -> TargetFilterEntry -> Bool
$c== :: TargetFilterEntry -> TargetFilterEntry -> Bool
Eq, Int -> TargetFilterEntry -> ShowS
[TargetFilterEntry] -> ShowS
TargetFilterEntry -> String
(Int -> TargetFilterEntry -> ShowS)
-> (TargetFilterEntry -> String)
-> ([TargetFilterEntry] -> ShowS)
-> Show TargetFilterEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetFilterEntry] -> ShowS
$cshowList :: [TargetFilterEntry] -> ShowS
show :: TargetFilterEntry -> String
$cshow :: TargetFilterEntry -> String
showsPrec :: Int -> TargetFilterEntry -> ShowS
$cshowsPrec :: Int -> TargetFilterEntry -> ShowS
Show)
instance FromJSON TargetFilterEntry where
  parseJSON :: Value -> Parser TargetFilterEntry
parseJSON = String
-> (Object -> Parser TargetFilterEntry)
-> Value
-> Parser TargetFilterEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetFilterEntry" ((Object -> Parser TargetFilterEntry)
 -> Value -> Parser TargetFilterEntry)
-> (Object -> Parser TargetFilterEntry)
-> Value
-> Parser TargetFilterEntry
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Bool -> Maybe Text -> TargetFilterEntry
TargetFilterEntry
    (Maybe Bool -> Maybe Text -> TargetFilterEntry)
-> Parser (Maybe Bool) -> Parser (Maybe Text -> TargetFilterEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"exclude"
    Parser (Maybe Text -> TargetFilterEntry)
-> Parser (Maybe Text) -> Parser TargetFilterEntry
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"type"
instance ToJSON TargetFilterEntry where
  toJSON :: TargetFilterEntry -> Value
toJSON TargetFilterEntry
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
"exclude" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TargetFilterEntry -> Maybe Bool
targetFilterEntryExclude TargetFilterEntry
p),
    (Text
"type" 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
<$> (TargetFilterEntry -> Maybe Text
targetFilterEntryType TargetFilterEntry
p)
    ]

-- | Type 'Target.TargetFilter'.
--   The entries in TargetFilter are matched sequentially against targets and
--   the first entry that matches determines if the target is included or not,
--   depending on the value of `exclude` field in the entry.
--   If filter is not specified, the one assumed is
--   [{type: "browser", exclude: true}, {type: "tab", exclude: true}, {}]
--   (i.e. include everything but `browser` and `tab`).
type TargetTargetFilter = [TargetFilterEntry]

-- | Type 'Target.RemoteLocation'.
data TargetRemoteLocation = TargetRemoteLocation
  {
    TargetRemoteLocation -> Text
targetRemoteLocationHost :: T.Text,
    TargetRemoteLocation -> Int
targetRemoteLocationPort :: Int
  }
  deriving (TargetRemoteLocation -> TargetRemoteLocation -> Bool
(TargetRemoteLocation -> TargetRemoteLocation -> Bool)
-> (TargetRemoteLocation -> TargetRemoteLocation -> Bool)
-> Eq TargetRemoteLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetRemoteLocation -> TargetRemoteLocation -> Bool
$c/= :: TargetRemoteLocation -> TargetRemoteLocation -> Bool
== :: TargetRemoteLocation -> TargetRemoteLocation -> Bool
$c== :: TargetRemoteLocation -> TargetRemoteLocation -> Bool
Eq, Int -> TargetRemoteLocation -> ShowS
[TargetRemoteLocation] -> ShowS
TargetRemoteLocation -> String
(Int -> TargetRemoteLocation -> ShowS)
-> (TargetRemoteLocation -> String)
-> ([TargetRemoteLocation] -> ShowS)
-> Show TargetRemoteLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetRemoteLocation] -> ShowS
$cshowList :: [TargetRemoteLocation] -> ShowS
show :: TargetRemoteLocation -> String
$cshow :: TargetRemoteLocation -> String
showsPrec :: Int -> TargetRemoteLocation -> ShowS
$cshowsPrec :: Int -> TargetRemoteLocation -> ShowS
Show)
instance FromJSON TargetRemoteLocation where
  parseJSON :: Value -> Parser TargetRemoteLocation
parseJSON = String
-> (Object -> Parser TargetRemoteLocation)
-> Value
-> Parser TargetRemoteLocation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetRemoteLocation" ((Object -> Parser TargetRemoteLocation)
 -> Value -> Parser TargetRemoteLocation)
-> (Object -> Parser TargetRemoteLocation)
-> Value
-> Parser TargetRemoteLocation
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Int -> TargetRemoteLocation
TargetRemoteLocation
    (Text -> Int -> TargetRemoteLocation)
-> Parser Text -> Parser (Int -> TargetRemoteLocation)
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
"host"
    Parser (Int -> TargetRemoteLocation)
-> Parser Int -> Parser TargetRemoteLocation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"port"
instance ToJSON TargetRemoteLocation where
  toJSON :: TargetRemoteLocation -> Value
toJSON TargetRemoteLocation
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
"host" 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 (TargetRemoteLocation -> Text
targetRemoteLocationHost TargetRemoteLocation
p),
    (Text
"port" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (TargetRemoteLocation -> Int
targetRemoteLocationPort TargetRemoteLocation
p)
    ]

-- | Type of the 'Target.attachedToTarget' event.
data TargetAttachedToTarget = TargetAttachedToTarget
  {
    -- | Identifier assigned to the session used to send/receive messages.
    TargetAttachedToTarget -> Text
targetAttachedToTargetSessionId :: TargetSessionID,
    TargetAttachedToTarget -> TargetTargetInfo
targetAttachedToTargetTargetInfo :: TargetTargetInfo,
    TargetAttachedToTarget -> Bool
targetAttachedToTargetWaitingForDebugger :: Bool
  }
  deriving (TargetAttachedToTarget -> TargetAttachedToTarget -> Bool
(TargetAttachedToTarget -> TargetAttachedToTarget -> Bool)
-> (TargetAttachedToTarget -> TargetAttachedToTarget -> Bool)
-> Eq TargetAttachedToTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetAttachedToTarget -> TargetAttachedToTarget -> Bool
$c/= :: TargetAttachedToTarget -> TargetAttachedToTarget -> Bool
== :: TargetAttachedToTarget -> TargetAttachedToTarget -> Bool
$c== :: TargetAttachedToTarget -> TargetAttachedToTarget -> Bool
Eq, Int -> TargetAttachedToTarget -> ShowS
[TargetAttachedToTarget] -> ShowS
TargetAttachedToTarget -> String
(Int -> TargetAttachedToTarget -> ShowS)
-> (TargetAttachedToTarget -> String)
-> ([TargetAttachedToTarget] -> ShowS)
-> Show TargetAttachedToTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetAttachedToTarget] -> ShowS
$cshowList :: [TargetAttachedToTarget] -> ShowS
show :: TargetAttachedToTarget -> String
$cshow :: TargetAttachedToTarget -> String
showsPrec :: Int -> TargetAttachedToTarget -> ShowS
$cshowsPrec :: Int -> TargetAttachedToTarget -> ShowS
Show)
instance FromJSON TargetAttachedToTarget where
  parseJSON :: Value -> Parser TargetAttachedToTarget
parseJSON = String
-> (Object -> Parser TargetAttachedToTarget)
-> Value
-> Parser TargetAttachedToTarget
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetAttachedToTarget" ((Object -> Parser TargetAttachedToTarget)
 -> Value -> Parser TargetAttachedToTarget)
-> (Object -> Parser TargetAttachedToTarget)
-> Value
-> Parser TargetAttachedToTarget
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> TargetTargetInfo -> Bool -> TargetAttachedToTarget
TargetAttachedToTarget
    (Text -> TargetTargetInfo -> Bool -> TargetAttachedToTarget)
-> Parser Text
-> Parser (TargetTargetInfo -> Bool -> TargetAttachedToTarget)
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
"sessionId"
    Parser (TargetTargetInfo -> Bool -> TargetAttachedToTarget)
-> Parser TargetTargetInfo
-> Parser (Bool -> TargetAttachedToTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser TargetTargetInfo
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"targetInfo"
    Parser (Bool -> TargetAttachedToTarget)
-> Parser Bool -> Parser TargetAttachedToTarget
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"waitingForDebugger"
instance Event TargetAttachedToTarget where
  eventName :: Proxy TargetAttachedToTarget -> String
eventName Proxy TargetAttachedToTarget
_ = String
"Target.attachedToTarget"

-- | Type of the 'Target.detachedFromTarget' event.
data TargetDetachedFromTarget = TargetDetachedFromTarget
  {
    -- | Detached session identifier.
    TargetDetachedFromTarget -> Text
targetDetachedFromTargetSessionId :: TargetSessionID
  }
  deriving (TargetDetachedFromTarget -> TargetDetachedFromTarget -> Bool
(TargetDetachedFromTarget -> TargetDetachedFromTarget -> Bool)
-> (TargetDetachedFromTarget -> TargetDetachedFromTarget -> Bool)
-> Eq TargetDetachedFromTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetDetachedFromTarget -> TargetDetachedFromTarget -> Bool
$c/= :: TargetDetachedFromTarget -> TargetDetachedFromTarget -> Bool
== :: TargetDetachedFromTarget -> TargetDetachedFromTarget -> Bool
$c== :: TargetDetachedFromTarget -> TargetDetachedFromTarget -> Bool
Eq, Int -> TargetDetachedFromTarget -> ShowS
[TargetDetachedFromTarget] -> ShowS
TargetDetachedFromTarget -> String
(Int -> TargetDetachedFromTarget -> ShowS)
-> (TargetDetachedFromTarget -> String)
-> ([TargetDetachedFromTarget] -> ShowS)
-> Show TargetDetachedFromTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetDetachedFromTarget] -> ShowS
$cshowList :: [TargetDetachedFromTarget] -> ShowS
show :: TargetDetachedFromTarget -> String
$cshow :: TargetDetachedFromTarget -> String
showsPrec :: Int -> TargetDetachedFromTarget -> ShowS
$cshowsPrec :: Int -> TargetDetachedFromTarget -> ShowS
Show)
instance FromJSON TargetDetachedFromTarget where
  parseJSON :: Value -> Parser TargetDetachedFromTarget
parseJSON = String
-> (Object -> Parser TargetDetachedFromTarget)
-> Value
-> Parser TargetDetachedFromTarget
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetDetachedFromTarget" ((Object -> Parser TargetDetachedFromTarget)
 -> Value -> Parser TargetDetachedFromTarget)
-> (Object -> Parser TargetDetachedFromTarget)
-> Value
-> Parser TargetDetachedFromTarget
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> TargetDetachedFromTarget
TargetDetachedFromTarget
    (Text -> TargetDetachedFromTarget)
-> Parser Text -> Parser TargetDetachedFromTarget
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
"sessionId"
instance Event TargetDetachedFromTarget where
  eventName :: Proxy TargetDetachedFromTarget -> String
eventName Proxy TargetDetachedFromTarget
_ = String
"Target.detachedFromTarget"

-- | Type of the 'Target.receivedMessageFromTarget' event.
data TargetReceivedMessageFromTarget = TargetReceivedMessageFromTarget
  {
    -- | Identifier of a session which sends a message.
    TargetReceivedMessageFromTarget -> Text
targetReceivedMessageFromTargetSessionId :: TargetSessionID,
    TargetReceivedMessageFromTarget -> Text
targetReceivedMessageFromTargetMessage :: T.Text
  }
  deriving (TargetReceivedMessageFromTarget
-> TargetReceivedMessageFromTarget -> Bool
(TargetReceivedMessageFromTarget
 -> TargetReceivedMessageFromTarget -> Bool)
-> (TargetReceivedMessageFromTarget
    -> TargetReceivedMessageFromTarget -> Bool)
-> Eq TargetReceivedMessageFromTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetReceivedMessageFromTarget
-> TargetReceivedMessageFromTarget -> Bool
$c/= :: TargetReceivedMessageFromTarget
-> TargetReceivedMessageFromTarget -> Bool
== :: TargetReceivedMessageFromTarget
-> TargetReceivedMessageFromTarget -> Bool
$c== :: TargetReceivedMessageFromTarget
-> TargetReceivedMessageFromTarget -> Bool
Eq, Int -> TargetReceivedMessageFromTarget -> ShowS
[TargetReceivedMessageFromTarget] -> ShowS
TargetReceivedMessageFromTarget -> String
(Int -> TargetReceivedMessageFromTarget -> ShowS)
-> (TargetReceivedMessageFromTarget -> String)
-> ([TargetReceivedMessageFromTarget] -> ShowS)
-> Show TargetReceivedMessageFromTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetReceivedMessageFromTarget] -> ShowS
$cshowList :: [TargetReceivedMessageFromTarget] -> ShowS
show :: TargetReceivedMessageFromTarget -> String
$cshow :: TargetReceivedMessageFromTarget -> String
showsPrec :: Int -> TargetReceivedMessageFromTarget -> ShowS
$cshowsPrec :: Int -> TargetReceivedMessageFromTarget -> ShowS
Show)
instance FromJSON TargetReceivedMessageFromTarget where
  parseJSON :: Value -> Parser TargetReceivedMessageFromTarget
parseJSON = String
-> (Object -> Parser TargetReceivedMessageFromTarget)
-> Value
-> Parser TargetReceivedMessageFromTarget
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetReceivedMessageFromTarget" ((Object -> Parser TargetReceivedMessageFromTarget)
 -> Value -> Parser TargetReceivedMessageFromTarget)
-> (Object -> Parser TargetReceivedMessageFromTarget)
-> Value
-> Parser TargetReceivedMessageFromTarget
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> TargetReceivedMessageFromTarget
TargetReceivedMessageFromTarget
    (Text -> Text -> TargetReceivedMessageFromTarget)
-> Parser Text -> Parser (Text -> TargetReceivedMessageFromTarget)
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
"sessionId"
    Parser (Text -> TargetReceivedMessageFromTarget)
-> Parser Text -> Parser TargetReceivedMessageFromTarget
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"message"
instance Event TargetReceivedMessageFromTarget where
  eventName :: Proxy TargetReceivedMessageFromTarget -> String
eventName Proxy TargetReceivedMessageFromTarget
_ = String
"Target.receivedMessageFromTarget"

-- | Type of the 'Target.targetCreated' event.
data TargetTargetCreated = TargetTargetCreated
  {
    TargetTargetCreated -> TargetTargetInfo
targetTargetCreatedTargetInfo :: TargetTargetInfo
  }
  deriving (TargetTargetCreated -> TargetTargetCreated -> Bool
(TargetTargetCreated -> TargetTargetCreated -> Bool)
-> (TargetTargetCreated -> TargetTargetCreated -> Bool)
-> Eq TargetTargetCreated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetTargetCreated -> TargetTargetCreated -> Bool
$c/= :: TargetTargetCreated -> TargetTargetCreated -> Bool
== :: TargetTargetCreated -> TargetTargetCreated -> Bool
$c== :: TargetTargetCreated -> TargetTargetCreated -> Bool
Eq, Int -> TargetTargetCreated -> ShowS
[TargetTargetCreated] -> ShowS
TargetTargetCreated -> String
(Int -> TargetTargetCreated -> ShowS)
-> (TargetTargetCreated -> String)
-> ([TargetTargetCreated] -> ShowS)
-> Show TargetTargetCreated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetTargetCreated] -> ShowS
$cshowList :: [TargetTargetCreated] -> ShowS
show :: TargetTargetCreated -> String
$cshow :: TargetTargetCreated -> String
showsPrec :: Int -> TargetTargetCreated -> ShowS
$cshowsPrec :: Int -> TargetTargetCreated -> ShowS
Show)
instance FromJSON TargetTargetCreated where
  parseJSON :: Value -> Parser TargetTargetCreated
parseJSON = String
-> (Object -> Parser TargetTargetCreated)
-> Value
-> Parser TargetTargetCreated
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetTargetCreated" ((Object -> Parser TargetTargetCreated)
 -> Value -> Parser TargetTargetCreated)
-> (Object -> Parser TargetTargetCreated)
-> Value
-> Parser TargetTargetCreated
forall a b. (a -> b) -> a -> b
$ \Object
o -> TargetTargetInfo -> TargetTargetCreated
TargetTargetCreated
    (TargetTargetInfo -> TargetTargetCreated)
-> Parser TargetTargetInfo -> Parser TargetTargetCreated
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser TargetTargetInfo
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"targetInfo"
instance Event TargetTargetCreated where
  eventName :: Proxy TargetTargetCreated -> String
eventName Proxy TargetTargetCreated
_ = String
"Target.targetCreated"

-- | Type of the 'Target.targetDestroyed' event.
data TargetTargetDestroyed = TargetTargetDestroyed
  {
    TargetTargetDestroyed -> Text
targetTargetDestroyedTargetId :: TargetTargetID
  }
  deriving (TargetTargetDestroyed -> TargetTargetDestroyed -> Bool
(TargetTargetDestroyed -> TargetTargetDestroyed -> Bool)
-> (TargetTargetDestroyed -> TargetTargetDestroyed -> Bool)
-> Eq TargetTargetDestroyed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetTargetDestroyed -> TargetTargetDestroyed -> Bool
$c/= :: TargetTargetDestroyed -> TargetTargetDestroyed -> Bool
== :: TargetTargetDestroyed -> TargetTargetDestroyed -> Bool
$c== :: TargetTargetDestroyed -> TargetTargetDestroyed -> Bool
Eq, Int -> TargetTargetDestroyed -> ShowS
[TargetTargetDestroyed] -> ShowS
TargetTargetDestroyed -> String
(Int -> TargetTargetDestroyed -> ShowS)
-> (TargetTargetDestroyed -> String)
-> ([TargetTargetDestroyed] -> ShowS)
-> Show TargetTargetDestroyed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetTargetDestroyed] -> ShowS
$cshowList :: [TargetTargetDestroyed] -> ShowS
show :: TargetTargetDestroyed -> String
$cshow :: TargetTargetDestroyed -> String
showsPrec :: Int -> TargetTargetDestroyed -> ShowS
$cshowsPrec :: Int -> TargetTargetDestroyed -> ShowS
Show)
instance FromJSON TargetTargetDestroyed where
  parseJSON :: Value -> Parser TargetTargetDestroyed
parseJSON = String
-> (Object -> Parser TargetTargetDestroyed)
-> Value
-> Parser TargetTargetDestroyed
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetTargetDestroyed" ((Object -> Parser TargetTargetDestroyed)
 -> Value -> Parser TargetTargetDestroyed)
-> (Object -> Parser TargetTargetDestroyed)
-> Value
-> Parser TargetTargetDestroyed
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> TargetTargetDestroyed
TargetTargetDestroyed
    (Text -> TargetTargetDestroyed)
-> Parser Text -> Parser TargetTargetDestroyed
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
"targetId"
instance Event TargetTargetDestroyed where
  eventName :: Proxy TargetTargetDestroyed -> String
eventName Proxy TargetTargetDestroyed
_ = String
"Target.targetDestroyed"

-- | Type of the 'Target.targetCrashed' event.
data TargetTargetCrashed = TargetTargetCrashed
  {
    TargetTargetCrashed -> Text
targetTargetCrashedTargetId :: TargetTargetID,
    -- | Termination status type.
    TargetTargetCrashed -> Text
targetTargetCrashedStatus :: T.Text,
    -- | Termination error code.
    TargetTargetCrashed -> Int
targetTargetCrashedErrorCode :: Int
  }
  deriving (TargetTargetCrashed -> TargetTargetCrashed -> Bool
(TargetTargetCrashed -> TargetTargetCrashed -> Bool)
-> (TargetTargetCrashed -> TargetTargetCrashed -> Bool)
-> Eq TargetTargetCrashed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetTargetCrashed -> TargetTargetCrashed -> Bool
$c/= :: TargetTargetCrashed -> TargetTargetCrashed -> Bool
== :: TargetTargetCrashed -> TargetTargetCrashed -> Bool
$c== :: TargetTargetCrashed -> TargetTargetCrashed -> Bool
Eq, Int -> TargetTargetCrashed -> ShowS
[TargetTargetCrashed] -> ShowS
TargetTargetCrashed -> String
(Int -> TargetTargetCrashed -> ShowS)
-> (TargetTargetCrashed -> String)
-> ([TargetTargetCrashed] -> ShowS)
-> Show TargetTargetCrashed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetTargetCrashed] -> ShowS
$cshowList :: [TargetTargetCrashed] -> ShowS
show :: TargetTargetCrashed -> String
$cshow :: TargetTargetCrashed -> String
showsPrec :: Int -> TargetTargetCrashed -> ShowS
$cshowsPrec :: Int -> TargetTargetCrashed -> ShowS
Show)
instance FromJSON TargetTargetCrashed where
  parseJSON :: Value -> Parser TargetTargetCrashed
parseJSON = String
-> (Object -> Parser TargetTargetCrashed)
-> Value
-> Parser TargetTargetCrashed
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetTargetCrashed" ((Object -> Parser TargetTargetCrashed)
 -> Value -> Parser TargetTargetCrashed)
-> (Object -> Parser TargetTargetCrashed)
-> Value
-> Parser TargetTargetCrashed
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Int -> TargetTargetCrashed
TargetTargetCrashed
    (Text -> Text -> Int -> TargetTargetCrashed)
-> Parser Text -> Parser (Text -> Int -> TargetTargetCrashed)
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
"targetId"
    Parser (Text -> Int -> TargetTargetCrashed)
-> Parser Text -> Parser (Int -> TargetTargetCrashed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"status"
    Parser (Int -> TargetTargetCrashed)
-> Parser Int -> Parser TargetTargetCrashed
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"errorCode"
instance Event TargetTargetCrashed where
  eventName :: Proxy TargetTargetCrashed -> String
eventName Proxy TargetTargetCrashed
_ = String
"Target.targetCrashed"

-- | Type of the 'Target.targetInfoChanged' event.
data TargetTargetInfoChanged = TargetTargetInfoChanged
  {
    TargetTargetInfoChanged -> TargetTargetInfo
targetTargetInfoChangedTargetInfo :: TargetTargetInfo
  }
  deriving (TargetTargetInfoChanged -> TargetTargetInfoChanged -> Bool
(TargetTargetInfoChanged -> TargetTargetInfoChanged -> Bool)
-> (TargetTargetInfoChanged -> TargetTargetInfoChanged -> Bool)
-> Eq TargetTargetInfoChanged
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetTargetInfoChanged -> TargetTargetInfoChanged -> Bool
$c/= :: TargetTargetInfoChanged -> TargetTargetInfoChanged -> Bool
== :: TargetTargetInfoChanged -> TargetTargetInfoChanged -> Bool
$c== :: TargetTargetInfoChanged -> TargetTargetInfoChanged -> Bool
Eq, Int -> TargetTargetInfoChanged -> ShowS
[TargetTargetInfoChanged] -> ShowS
TargetTargetInfoChanged -> String
(Int -> TargetTargetInfoChanged -> ShowS)
-> (TargetTargetInfoChanged -> String)
-> ([TargetTargetInfoChanged] -> ShowS)
-> Show TargetTargetInfoChanged
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetTargetInfoChanged] -> ShowS
$cshowList :: [TargetTargetInfoChanged] -> ShowS
show :: TargetTargetInfoChanged -> String
$cshow :: TargetTargetInfoChanged -> String
showsPrec :: Int -> TargetTargetInfoChanged -> ShowS
$cshowsPrec :: Int -> TargetTargetInfoChanged -> ShowS
Show)
instance FromJSON TargetTargetInfoChanged where
  parseJSON :: Value -> Parser TargetTargetInfoChanged
parseJSON = String
-> (Object -> Parser TargetTargetInfoChanged)
-> Value
-> Parser TargetTargetInfoChanged
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetTargetInfoChanged" ((Object -> Parser TargetTargetInfoChanged)
 -> Value -> Parser TargetTargetInfoChanged)
-> (Object -> Parser TargetTargetInfoChanged)
-> Value
-> Parser TargetTargetInfoChanged
forall a b. (a -> b) -> a -> b
$ \Object
o -> TargetTargetInfo -> TargetTargetInfoChanged
TargetTargetInfoChanged
    (TargetTargetInfo -> TargetTargetInfoChanged)
-> Parser TargetTargetInfo -> Parser TargetTargetInfoChanged
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser TargetTargetInfo
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"targetInfo"
instance Event TargetTargetInfoChanged where
  eventName :: Proxy TargetTargetInfoChanged -> String
eventName Proxy TargetTargetInfoChanged
_ = String
"Target.targetInfoChanged"

-- | Activates (focuses) the target.

-- | Parameters of the 'Target.activateTarget' command.
data PTargetActivateTarget = PTargetActivateTarget
  {
    PTargetActivateTarget -> Text
pTargetActivateTargetTargetId :: TargetTargetID
  }
  deriving (PTargetActivateTarget -> PTargetActivateTarget -> Bool
(PTargetActivateTarget -> PTargetActivateTarget -> Bool)
-> (PTargetActivateTarget -> PTargetActivateTarget -> Bool)
-> Eq PTargetActivateTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetActivateTarget -> PTargetActivateTarget -> Bool
$c/= :: PTargetActivateTarget -> PTargetActivateTarget -> Bool
== :: PTargetActivateTarget -> PTargetActivateTarget -> Bool
$c== :: PTargetActivateTarget -> PTargetActivateTarget -> Bool
Eq, Int -> PTargetActivateTarget -> ShowS
[PTargetActivateTarget] -> ShowS
PTargetActivateTarget -> String
(Int -> PTargetActivateTarget -> ShowS)
-> (PTargetActivateTarget -> String)
-> ([PTargetActivateTarget] -> ShowS)
-> Show PTargetActivateTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetActivateTarget] -> ShowS
$cshowList :: [PTargetActivateTarget] -> ShowS
show :: PTargetActivateTarget -> String
$cshow :: PTargetActivateTarget -> String
showsPrec :: Int -> PTargetActivateTarget -> ShowS
$cshowsPrec :: Int -> PTargetActivateTarget -> ShowS
Show)
pTargetActivateTarget
  :: TargetTargetID
  -> PTargetActivateTarget
pTargetActivateTarget :: Text -> PTargetActivateTarget
pTargetActivateTarget
  Text
arg_pTargetActivateTargetTargetId
  = Text -> PTargetActivateTarget
PTargetActivateTarget
    Text
arg_pTargetActivateTargetTargetId
instance ToJSON PTargetActivateTarget where
  toJSON :: PTargetActivateTarget -> Value
toJSON PTargetActivateTarget
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
"targetId" 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 (PTargetActivateTarget -> Text
pTargetActivateTargetTargetId PTargetActivateTarget
p)
    ]
instance Command PTargetActivateTarget where
  type CommandResponse PTargetActivateTarget = ()
  commandName :: Proxy PTargetActivateTarget -> String
commandName Proxy PTargetActivateTarget
_ = String
"Target.activateTarget"
  fromJSON :: Proxy PTargetActivateTarget
-> Value -> Result (CommandResponse PTargetActivateTarget)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PTargetActivateTarget -> Result ())
-> Proxy PTargetActivateTarget
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PTargetActivateTarget -> ())
-> Proxy PTargetActivateTarget
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PTargetActivateTarget -> ()
forall a b. a -> b -> a
const ()

-- | Attaches to the target with given id.

-- | Parameters of the 'Target.attachToTarget' command.
data PTargetAttachToTarget = PTargetAttachToTarget
  {
    PTargetAttachToTarget -> Text
pTargetAttachToTargetTargetId :: TargetTargetID,
    -- | Enables "flat" access to the session via specifying sessionId attribute in the commands.
    --   We plan to make this the default, deprecate non-flattened mode,
    --   and eventually retire it. See crbug.com/991325.
    PTargetAttachToTarget -> Maybe Bool
pTargetAttachToTargetFlatten :: Maybe Bool
  }
  deriving (PTargetAttachToTarget -> PTargetAttachToTarget -> Bool
(PTargetAttachToTarget -> PTargetAttachToTarget -> Bool)
-> (PTargetAttachToTarget -> PTargetAttachToTarget -> Bool)
-> Eq PTargetAttachToTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetAttachToTarget -> PTargetAttachToTarget -> Bool
$c/= :: PTargetAttachToTarget -> PTargetAttachToTarget -> Bool
== :: PTargetAttachToTarget -> PTargetAttachToTarget -> Bool
$c== :: PTargetAttachToTarget -> PTargetAttachToTarget -> Bool
Eq, Int -> PTargetAttachToTarget -> ShowS
[PTargetAttachToTarget] -> ShowS
PTargetAttachToTarget -> String
(Int -> PTargetAttachToTarget -> ShowS)
-> (PTargetAttachToTarget -> String)
-> ([PTargetAttachToTarget] -> ShowS)
-> Show PTargetAttachToTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetAttachToTarget] -> ShowS
$cshowList :: [PTargetAttachToTarget] -> ShowS
show :: PTargetAttachToTarget -> String
$cshow :: PTargetAttachToTarget -> String
showsPrec :: Int -> PTargetAttachToTarget -> ShowS
$cshowsPrec :: Int -> PTargetAttachToTarget -> ShowS
Show)
pTargetAttachToTarget
  :: TargetTargetID
  -> PTargetAttachToTarget
pTargetAttachToTarget :: Text -> PTargetAttachToTarget
pTargetAttachToTarget
  Text
arg_pTargetAttachToTargetTargetId
  = Text -> Maybe Bool -> PTargetAttachToTarget
PTargetAttachToTarget
    Text
arg_pTargetAttachToTargetTargetId
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PTargetAttachToTarget where
  toJSON :: PTargetAttachToTarget -> Value
toJSON PTargetAttachToTarget
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
"targetId" 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 (PTargetAttachToTarget -> Text
pTargetAttachToTargetTargetId PTargetAttachToTarget
p),
    (Text
"flatten" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PTargetAttachToTarget -> Maybe Bool
pTargetAttachToTargetFlatten PTargetAttachToTarget
p)
    ]
data TargetAttachToTarget = TargetAttachToTarget
  {
    -- | Id assigned to the session.
    TargetAttachToTarget -> Text
targetAttachToTargetSessionId :: TargetSessionID
  }
  deriving (TargetAttachToTarget -> TargetAttachToTarget -> Bool
(TargetAttachToTarget -> TargetAttachToTarget -> Bool)
-> (TargetAttachToTarget -> TargetAttachToTarget -> Bool)
-> Eq TargetAttachToTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetAttachToTarget -> TargetAttachToTarget -> Bool
$c/= :: TargetAttachToTarget -> TargetAttachToTarget -> Bool
== :: TargetAttachToTarget -> TargetAttachToTarget -> Bool
$c== :: TargetAttachToTarget -> TargetAttachToTarget -> Bool
Eq, Int -> TargetAttachToTarget -> ShowS
[TargetAttachToTarget] -> ShowS
TargetAttachToTarget -> String
(Int -> TargetAttachToTarget -> ShowS)
-> (TargetAttachToTarget -> String)
-> ([TargetAttachToTarget] -> ShowS)
-> Show TargetAttachToTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetAttachToTarget] -> ShowS
$cshowList :: [TargetAttachToTarget] -> ShowS
show :: TargetAttachToTarget -> String
$cshow :: TargetAttachToTarget -> String
showsPrec :: Int -> TargetAttachToTarget -> ShowS
$cshowsPrec :: Int -> TargetAttachToTarget -> ShowS
Show)
instance FromJSON TargetAttachToTarget where
  parseJSON :: Value -> Parser TargetAttachToTarget
parseJSON = String
-> (Object -> Parser TargetAttachToTarget)
-> Value
-> Parser TargetAttachToTarget
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetAttachToTarget" ((Object -> Parser TargetAttachToTarget)
 -> Value -> Parser TargetAttachToTarget)
-> (Object -> Parser TargetAttachToTarget)
-> Value
-> Parser TargetAttachToTarget
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> TargetAttachToTarget
TargetAttachToTarget
    (Text -> TargetAttachToTarget)
-> Parser Text -> Parser TargetAttachToTarget
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
"sessionId"
instance Command PTargetAttachToTarget where
  type CommandResponse PTargetAttachToTarget = TargetAttachToTarget
  commandName :: Proxy PTargetAttachToTarget -> String
commandName Proxy PTargetAttachToTarget
_ = String
"Target.attachToTarget"

-- | Attaches to the browser target, only uses flat sessionId mode.

-- | Parameters of the 'Target.attachToBrowserTarget' command.
data PTargetAttachToBrowserTarget = PTargetAttachToBrowserTarget
  deriving (PTargetAttachToBrowserTarget
-> PTargetAttachToBrowserTarget -> Bool
(PTargetAttachToBrowserTarget
 -> PTargetAttachToBrowserTarget -> Bool)
-> (PTargetAttachToBrowserTarget
    -> PTargetAttachToBrowserTarget -> Bool)
-> Eq PTargetAttachToBrowserTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetAttachToBrowserTarget
-> PTargetAttachToBrowserTarget -> Bool
$c/= :: PTargetAttachToBrowserTarget
-> PTargetAttachToBrowserTarget -> Bool
== :: PTargetAttachToBrowserTarget
-> PTargetAttachToBrowserTarget -> Bool
$c== :: PTargetAttachToBrowserTarget
-> PTargetAttachToBrowserTarget -> Bool
Eq, Int -> PTargetAttachToBrowserTarget -> ShowS
[PTargetAttachToBrowserTarget] -> ShowS
PTargetAttachToBrowserTarget -> String
(Int -> PTargetAttachToBrowserTarget -> ShowS)
-> (PTargetAttachToBrowserTarget -> String)
-> ([PTargetAttachToBrowserTarget] -> ShowS)
-> Show PTargetAttachToBrowserTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetAttachToBrowserTarget] -> ShowS
$cshowList :: [PTargetAttachToBrowserTarget] -> ShowS
show :: PTargetAttachToBrowserTarget -> String
$cshow :: PTargetAttachToBrowserTarget -> String
showsPrec :: Int -> PTargetAttachToBrowserTarget -> ShowS
$cshowsPrec :: Int -> PTargetAttachToBrowserTarget -> ShowS
Show)
pTargetAttachToBrowserTarget
  :: PTargetAttachToBrowserTarget
pTargetAttachToBrowserTarget :: PTargetAttachToBrowserTarget
pTargetAttachToBrowserTarget
  = PTargetAttachToBrowserTarget
PTargetAttachToBrowserTarget
instance ToJSON PTargetAttachToBrowserTarget where
  toJSON :: PTargetAttachToBrowserTarget -> Value
toJSON PTargetAttachToBrowserTarget
_ = Value
A.Null
data TargetAttachToBrowserTarget = TargetAttachToBrowserTarget
  {
    -- | Id assigned to the session.
    TargetAttachToBrowserTarget -> Text
targetAttachToBrowserTargetSessionId :: TargetSessionID
  }
  deriving (TargetAttachToBrowserTarget -> TargetAttachToBrowserTarget -> Bool
(TargetAttachToBrowserTarget
 -> TargetAttachToBrowserTarget -> Bool)
-> (TargetAttachToBrowserTarget
    -> TargetAttachToBrowserTarget -> Bool)
-> Eq TargetAttachToBrowserTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetAttachToBrowserTarget -> TargetAttachToBrowserTarget -> Bool
$c/= :: TargetAttachToBrowserTarget -> TargetAttachToBrowserTarget -> Bool
== :: TargetAttachToBrowserTarget -> TargetAttachToBrowserTarget -> Bool
$c== :: TargetAttachToBrowserTarget -> TargetAttachToBrowserTarget -> Bool
Eq, Int -> TargetAttachToBrowserTarget -> ShowS
[TargetAttachToBrowserTarget] -> ShowS
TargetAttachToBrowserTarget -> String
(Int -> TargetAttachToBrowserTarget -> ShowS)
-> (TargetAttachToBrowserTarget -> String)
-> ([TargetAttachToBrowserTarget] -> ShowS)
-> Show TargetAttachToBrowserTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetAttachToBrowserTarget] -> ShowS
$cshowList :: [TargetAttachToBrowserTarget] -> ShowS
show :: TargetAttachToBrowserTarget -> String
$cshow :: TargetAttachToBrowserTarget -> String
showsPrec :: Int -> TargetAttachToBrowserTarget -> ShowS
$cshowsPrec :: Int -> TargetAttachToBrowserTarget -> ShowS
Show)
instance FromJSON TargetAttachToBrowserTarget where
  parseJSON :: Value -> Parser TargetAttachToBrowserTarget
parseJSON = String
-> (Object -> Parser TargetAttachToBrowserTarget)
-> Value
-> Parser TargetAttachToBrowserTarget
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetAttachToBrowserTarget" ((Object -> Parser TargetAttachToBrowserTarget)
 -> Value -> Parser TargetAttachToBrowserTarget)
-> (Object -> Parser TargetAttachToBrowserTarget)
-> Value
-> Parser TargetAttachToBrowserTarget
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> TargetAttachToBrowserTarget
TargetAttachToBrowserTarget
    (Text -> TargetAttachToBrowserTarget)
-> Parser Text -> Parser TargetAttachToBrowserTarget
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
"sessionId"
instance Command PTargetAttachToBrowserTarget where
  type CommandResponse PTargetAttachToBrowserTarget = TargetAttachToBrowserTarget
  commandName :: Proxy PTargetAttachToBrowserTarget -> String
commandName Proxy PTargetAttachToBrowserTarget
_ = String
"Target.attachToBrowserTarget"

-- | Closes the target. If the target is a page that gets closed too.

-- | Parameters of the 'Target.closeTarget' command.
data PTargetCloseTarget = PTargetCloseTarget
  {
    PTargetCloseTarget -> Text
pTargetCloseTargetTargetId :: TargetTargetID
  }
  deriving (PTargetCloseTarget -> PTargetCloseTarget -> Bool
(PTargetCloseTarget -> PTargetCloseTarget -> Bool)
-> (PTargetCloseTarget -> PTargetCloseTarget -> Bool)
-> Eq PTargetCloseTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetCloseTarget -> PTargetCloseTarget -> Bool
$c/= :: PTargetCloseTarget -> PTargetCloseTarget -> Bool
== :: PTargetCloseTarget -> PTargetCloseTarget -> Bool
$c== :: PTargetCloseTarget -> PTargetCloseTarget -> Bool
Eq, Int -> PTargetCloseTarget -> ShowS
[PTargetCloseTarget] -> ShowS
PTargetCloseTarget -> String
(Int -> PTargetCloseTarget -> ShowS)
-> (PTargetCloseTarget -> String)
-> ([PTargetCloseTarget] -> ShowS)
-> Show PTargetCloseTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetCloseTarget] -> ShowS
$cshowList :: [PTargetCloseTarget] -> ShowS
show :: PTargetCloseTarget -> String
$cshow :: PTargetCloseTarget -> String
showsPrec :: Int -> PTargetCloseTarget -> ShowS
$cshowsPrec :: Int -> PTargetCloseTarget -> ShowS
Show)
pTargetCloseTarget
  :: TargetTargetID
  -> PTargetCloseTarget
pTargetCloseTarget :: Text -> PTargetCloseTarget
pTargetCloseTarget
  Text
arg_pTargetCloseTargetTargetId
  = Text -> PTargetCloseTarget
PTargetCloseTarget
    Text
arg_pTargetCloseTargetTargetId
instance ToJSON PTargetCloseTarget where
  toJSON :: PTargetCloseTarget -> Value
toJSON PTargetCloseTarget
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
"targetId" 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 (PTargetCloseTarget -> Text
pTargetCloseTargetTargetId PTargetCloseTarget
p)
    ]
instance Command PTargetCloseTarget where
  type CommandResponse PTargetCloseTarget = ()
  commandName :: Proxy PTargetCloseTarget -> String
commandName Proxy PTargetCloseTarget
_ = String
"Target.closeTarget"
  fromJSON :: Proxy PTargetCloseTarget
-> Value -> Result (CommandResponse PTargetCloseTarget)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PTargetCloseTarget -> Result ())
-> Proxy PTargetCloseTarget
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PTargetCloseTarget -> ())
-> Proxy PTargetCloseTarget
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PTargetCloseTarget -> ()
forall a b. a -> b -> a
const ()

-- | Inject object to the target's main frame that provides a communication
--   channel with browser target.
--   
--   Injected object will be available as `window[bindingName]`.
--   
--   The object has the follwing API:
--   - `binding.send(json)` - a method to send messages over the remote debugging protocol
--   - `binding.onmessage = json => handleMessage(json)` - a callback that will be called for the protocol notifications and command responses.

-- | Parameters of the 'Target.exposeDevToolsProtocol' command.
data PTargetExposeDevToolsProtocol = PTargetExposeDevToolsProtocol
  {
    PTargetExposeDevToolsProtocol -> Text
pTargetExposeDevToolsProtocolTargetId :: TargetTargetID,
    -- | Binding name, 'cdp' if not specified.
    PTargetExposeDevToolsProtocol -> Maybe Text
pTargetExposeDevToolsProtocolBindingName :: Maybe T.Text
  }
  deriving (PTargetExposeDevToolsProtocol
-> PTargetExposeDevToolsProtocol -> Bool
(PTargetExposeDevToolsProtocol
 -> PTargetExposeDevToolsProtocol -> Bool)
-> (PTargetExposeDevToolsProtocol
    -> PTargetExposeDevToolsProtocol -> Bool)
-> Eq PTargetExposeDevToolsProtocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetExposeDevToolsProtocol
-> PTargetExposeDevToolsProtocol -> Bool
$c/= :: PTargetExposeDevToolsProtocol
-> PTargetExposeDevToolsProtocol -> Bool
== :: PTargetExposeDevToolsProtocol
-> PTargetExposeDevToolsProtocol -> Bool
$c== :: PTargetExposeDevToolsProtocol
-> PTargetExposeDevToolsProtocol -> Bool
Eq, Int -> PTargetExposeDevToolsProtocol -> ShowS
[PTargetExposeDevToolsProtocol] -> ShowS
PTargetExposeDevToolsProtocol -> String
(Int -> PTargetExposeDevToolsProtocol -> ShowS)
-> (PTargetExposeDevToolsProtocol -> String)
-> ([PTargetExposeDevToolsProtocol] -> ShowS)
-> Show PTargetExposeDevToolsProtocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetExposeDevToolsProtocol] -> ShowS
$cshowList :: [PTargetExposeDevToolsProtocol] -> ShowS
show :: PTargetExposeDevToolsProtocol -> String
$cshow :: PTargetExposeDevToolsProtocol -> String
showsPrec :: Int -> PTargetExposeDevToolsProtocol -> ShowS
$cshowsPrec :: Int -> PTargetExposeDevToolsProtocol -> ShowS
Show)
pTargetExposeDevToolsProtocol
  :: TargetTargetID
  -> PTargetExposeDevToolsProtocol
pTargetExposeDevToolsProtocol :: Text -> PTargetExposeDevToolsProtocol
pTargetExposeDevToolsProtocol
  Text
arg_pTargetExposeDevToolsProtocolTargetId
  = Text -> Maybe Text -> PTargetExposeDevToolsProtocol
PTargetExposeDevToolsProtocol
    Text
arg_pTargetExposeDevToolsProtocolTargetId
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PTargetExposeDevToolsProtocol where
  toJSON :: PTargetExposeDevToolsProtocol -> Value
toJSON PTargetExposeDevToolsProtocol
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
"targetId" 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 (PTargetExposeDevToolsProtocol -> Text
pTargetExposeDevToolsProtocolTargetId PTargetExposeDevToolsProtocol
p),
    (Text
"bindingName" 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
<$> (PTargetExposeDevToolsProtocol -> Maybe Text
pTargetExposeDevToolsProtocolBindingName PTargetExposeDevToolsProtocol
p)
    ]
instance Command PTargetExposeDevToolsProtocol where
  type CommandResponse PTargetExposeDevToolsProtocol = ()
  commandName :: Proxy PTargetExposeDevToolsProtocol -> String
commandName Proxy PTargetExposeDevToolsProtocol
_ = String
"Target.exposeDevToolsProtocol"
  fromJSON :: Proxy PTargetExposeDevToolsProtocol
-> Value -> Result (CommandResponse PTargetExposeDevToolsProtocol)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PTargetExposeDevToolsProtocol -> Result ())
-> Proxy PTargetExposeDevToolsProtocol
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PTargetExposeDevToolsProtocol -> ())
-> Proxy PTargetExposeDevToolsProtocol
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PTargetExposeDevToolsProtocol -> ()
forall a b. a -> b -> a
const ()

-- | Creates a new empty BrowserContext. Similar to an incognito profile but you can have more than
--   one.

-- | Parameters of the 'Target.createBrowserContext' command.
data PTargetCreateBrowserContext = PTargetCreateBrowserContext
  {
    -- | If specified, disposes this context when debugging session disconnects.
    PTargetCreateBrowserContext -> Maybe Bool
pTargetCreateBrowserContextDisposeOnDetach :: Maybe Bool,
    -- | Proxy server, similar to the one passed to --proxy-server
    PTargetCreateBrowserContext -> Maybe Text
pTargetCreateBrowserContextProxyServer :: Maybe T.Text,
    -- | Proxy bypass list, similar to the one passed to --proxy-bypass-list
    PTargetCreateBrowserContext -> Maybe Text
pTargetCreateBrowserContextProxyBypassList :: Maybe T.Text,
    -- | An optional list of origins to grant unlimited cross-origin access to.
    --   Parts of the URL other than those constituting origin are ignored.
    PTargetCreateBrowserContext -> Maybe [Text]
pTargetCreateBrowserContextOriginsWithUniversalNetworkAccess :: Maybe [T.Text]
  }
  deriving (PTargetCreateBrowserContext -> PTargetCreateBrowserContext -> Bool
(PTargetCreateBrowserContext
 -> PTargetCreateBrowserContext -> Bool)
-> (PTargetCreateBrowserContext
    -> PTargetCreateBrowserContext -> Bool)
-> Eq PTargetCreateBrowserContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetCreateBrowserContext -> PTargetCreateBrowserContext -> Bool
$c/= :: PTargetCreateBrowserContext -> PTargetCreateBrowserContext -> Bool
== :: PTargetCreateBrowserContext -> PTargetCreateBrowserContext -> Bool
$c== :: PTargetCreateBrowserContext -> PTargetCreateBrowserContext -> Bool
Eq, Int -> PTargetCreateBrowserContext -> ShowS
[PTargetCreateBrowserContext] -> ShowS
PTargetCreateBrowserContext -> String
(Int -> PTargetCreateBrowserContext -> ShowS)
-> (PTargetCreateBrowserContext -> String)
-> ([PTargetCreateBrowserContext] -> ShowS)
-> Show PTargetCreateBrowserContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetCreateBrowserContext] -> ShowS
$cshowList :: [PTargetCreateBrowserContext] -> ShowS
show :: PTargetCreateBrowserContext -> String
$cshow :: PTargetCreateBrowserContext -> String
showsPrec :: Int -> PTargetCreateBrowserContext -> ShowS
$cshowsPrec :: Int -> PTargetCreateBrowserContext -> ShowS
Show)
pTargetCreateBrowserContext
  :: PTargetCreateBrowserContext
pTargetCreateBrowserContext :: PTargetCreateBrowserContext
pTargetCreateBrowserContext
  = Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> PTargetCreateBrowserContext
PTargetCreateBrowserContext
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Maybe [Text]
forall a. Maybe a
Nothing
instance ToJSON PTargetCreateBrowserContext where
  toJSON :: PTargetCreateBrowserContext -> Value
toJSON PTargetCreateBrowserContext
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
"disposeOnDetach" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PTargetCreateBrowserContext -> Maybe Bool
pTargetCreateBrowserContextDisposeOnDetach PTargetCreateBrowserContext
p),
    (Text
"proxyServer" 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
<$> (PTargetCreateBrowserContext -> Maybe Text
pTargetCreateBrowserContextProxyServer PTargetCreateBrowserContext
p),
    (Text
"proxyBypassList" 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
<$> (PTargetCreateBrowserContext -> Maybe Text
pTargetCreateBrowserContextProxyBypassList PTargetCreateBrowserContext
p),
    (Text
"originsWithUniversalNetworkAccess" 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
<$> (PTargetCreateBrowserContext -> Maybe [Text]
pTargetCreateBrowserContextOriginsWithUniversalNetworkAccess PTargetCreateBrowserContext
p)
    ]
data TargetCreateBrowserContext = TargetCreateBrowserContext
  {
    -- | The id of the context created.
    TargetCreateBrowserContext -> Text
targetCreateBrowserContextBrowserContextId :: BrowserBrowserContextID
  }
  deriving (TargetCreateBrowserContext -> TargetCreateBrowserContext -> Bool
(TargetCreateBrowserContext -> TargetCreateBrowserContext -> Bool)
-> (TargetCreateBrowserContext
    -> TargetCreateBrowserContext -> Bool)
-> Eq TargetCreateBrowserContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetCreateBrowserContext -> TargetCreateBrowserContext -> Bool
$c/= :: TargetCreateBrowserContext -> TargetCreateBrowserContext -> Bool
== :: TargetCreateBrowserContext -> TargetCreateBrowserContext -> Bool
$c== :: TargetCreateBrowserContext -> TargetCreateBrowserContext -> Bool
Eq, Int -> TargetCreateBrowserContext -> ShowS
[TargetCreateBrowserContext] -> ShowS
TargetCreateBrowserContext -> String
(Int -> TargetCreateBrowserContext -> ShowS)
-> (TargetCreateBrowserContext -> String)
-> ([TargetCreateBrowserContext] -> ShowS)
-> Show TargetCreateBrowserContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetCreateBrowserContext] -> ShowS
$cshowList :: [TargetCreateBrowserContext] -> ShowS
show :: TargetCreateBrowserContext -> String
$cshow :: TargetCreateBrowserContext -> String
showsPrec :: Int -> TargetCreateBrowserContext -> ShowS
$cshowsPrec :: Int -> TargetCreateBrowserContext -> ShowS
Show)
instance FromJSON TargetCreateBrowserContext where
  parseJSON :: Value -> Parser TargetCreateBrowserContext
parseJSON = String
-> (Object -> Parser TargetCreateBrowserContext)
-> Value
-> Parser TargetCreateBrowserContext
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetCreateBrowserContext" ((Object -> Parser TargetCreateBrowserContext)
 -> Value -> Parser TargetCreateBrowserContext)
-> (Object -> Parser TargetCreateBrowserContext)
-> Value
-> Parser TargetCreateBrowserContext
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> TargetCreateBrowserContext
TargetCreateBrowserContext
    (Text -> TargetCreateBrowserContext)
-> Parser Text -> Parser TargetCreateBrowserContext
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
"browserContextId"
instance Command PTargetCreateBrowserContext where
  type CommandResponse PTargetCreateBrowserContext = TargetCreateBrowserContext
  commandName :: Proxy PTargetCreateBrowserContext -> String
commandName Proxy PTargetCreateBrowserContext
_ = String
"Target.createBrowserContext"

-- | Returns all browser contexts created with `Target.createBrowserContext` method.

-- | Parameters of the 'Target.getBrowserContexts' command.
data PTargetGetBrowserContexts = PTargetGetBrowserContexts
  deriving (PTargetGetBrowserContexts -> PTargetGetBrowserContexts -> Bool
(PTargetGetBrowserContexts -> PTargetGetBrowserContexts -> Bool)
-> (PTargetGetBrowserContexts -> PTargetGetBrowserContexts -> Bool)
-> Eq PTargetGetBrowserContexts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetGetBrowserContexts -> PTargetGetBrowserContexts -> Bool
$c/= :: PTargetGetBrowserContexts -> PTargetGetBrowserContexts -> Bool
== :: PTargetGetBrowserContexts -> PTargetGetBrowserContexts -> Bool
$c== :: PTargetGetBrowserContexts -> PTargetGetBrowserContexts -> Bool
Eq, Int -> PTargetGetBrowserContexts -> ShowS
[PTargetGetBrowserContexts] -> ShowS
PTargetGetBrowserContexts -> String
(Int -> PTargetGetBrowserContexts -> ShowS)
-> (PTargetGetBrowserContexts -> String)
-> ([PTargetGetBrowserContexts] -> ShowS)
-> Show PTargetGetBrowserContexts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetGetBrowserContexts] -> ShowS
$cshowList :: [PTargetGetBrowserContexts] -> ShowS
show :: PTargetGetBrowserContexts -> String
$cshow :: PTargetGetBrowserContexts -> String
showsPrec :: Int -> PTargetGetBrowserContexts -> ShowS
$cshowsPrec :: Int -> PTargetGetBrowserContexts -> ShowS
Show)
pTargetGetBrowserContexts
  :: PTargetGetBrowserContexts
pTargetGetBrowserContexts :: PTargetGetBrowserContexts
pTargetGetBrowserContexts
  = PTargetGetBrowserContexts
PTargetGetBrowserContexts
instance ToJSON PTargetGetBrowserContexts where
  toJSON :: PTargetGetBrowserContexts -> Value
toJSON PTargetGetBrowserContexts
_ = Value
A.Null
data TargetGetBrowserContexts = TargetGetBrowserContexts
  {
    -- | An array of browser context ids.
    TargetGetBrowserContexts -> [Text]
targetGetBrowserContextsBrowserContextIds :: [BrowserBrowserContextID]
  }
  deriving (TargetGetBrowserContexts -> TargetGetBrowserContexts -> Bool
(TargetGetBrowserContexts -> TargetGetBrowserContexts -> Bool)
-> (TargetGetBrowserContexts -> TargetGetBrowserContexts -> Bool)
-> Eq TargetGetBrowserContexts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetGetBrowserContexts -> TargetGetBrowserContexts -> Bool
$c/= :: TargetGetBrowserContexts -> TargetGetBrowserContexts -> Bool
== :: TargetGetBrowserContexts -> TargetGetBrowserContexts -> Bool
$c== :: TargetGetBrowserContexts -> TargetGetBrowserContexts -> Bool
Eq, Int -> TargetGetBrowserContexts -> ShowS
[TargetGetBrowserContexts] -> ShowS
TargetGetBrowserContexts -> String
(Int -> TargetGetBrowserContexts -> ShowS)
-> (TargetGetBrowserContexts -> String)
-> ([TargetGetBrowserContexts] -> ShowS)
-> Show TargetGetBrowserContexts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetGetBrowserContexts] -> ShowS
$cshowList :: [TargetGetBrowserContexts] -> ShowS
show :: TargetGetBrowserContexts -> String
$cshow :: TargetGetBrowserContexts -> String
showsPrec :: Int -> TargetGetBrowserContexts -> ShowS
$cshowsPrec :: Int -> TargetGetBrowserContexts -> ShowS
Show)
instance FromJSON TargetGetBrowserContexts where
  parseJSON :: Value -> Parser TargetGetBrowserContexts
parseJSON = String
-> (Object -> Parser TargetGetBrowserContexts)
-> Value
-> Parser TargetGetBrowserContexts
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetGetBrowserContexts" ((Object -> Parser TargetGetBrowserContexts)
 -> Value -> Parser TargetGetBrowserContexts)
-> (Object -> Parser TargetGetBrowserContexts)
-> Value
-> Parser TargetGetBrowserContexts
forall a b. (a -> b) -> a -> b
$ \Object
o -> [Text] -> TargetGetBrowserContexts
TargetGetBrowserContexts
    ([Text] -> TargetGetBrowserContexts)
-> Parser [Text] -> Parser TargetGetBrowserContexts
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
"browserContextIds"
instance Command PTargetGetBrowserContexts where
  type CommandResponse PTargetGetBrowserContexts = TargetGetBrowserContexts
  commandName :: Proxy PTargetGetBrowserContexts -> String
commandName Proxy PTargetGetBrowserContexts
_ = String
"Target.getBrowserContexts"

-- | Creates a new page.

-- | Parameters of the 'Target.createTarget' command.
data PTargetCreateTarget = PTargetCreateTarget
  {
    -- | The initial URL the page will be navigated to. An empty string indicates about:blank.
    PTargetCreateTarget -> Text
pTargetCreateTargetUrl :: T.Text,
    -- | Frame width in DIP (headless chrome only).
    PTargetCreateTarget -> Maybe Int
pTargetCreateTargetWidth :: Maybe Int,
    -- | Frame height in DIP (headless chrome only).
    PTargetCreateTarget -> Maybe Int
pTargetCreateTargetHeight :: Maybe Int,
    -- | The browser context to create the page in.
    PTargetCreateTarget -> Maybe Text
pTargetCreateTargetBrowserContextId :: Maybe BrowserBrowserContextID,
    -- | Whether BeginFrames for this target will be controlled via DevTools (headless chrome only,
    --   not supported on MacOS yet, false by default).
    PTargetCreateTarget -> Maybe Bool
pTargetCreateTargetEnableBeginFrameControl :: Maybe Bool,
    -- | Whether to create a new Window or Tab (chrome-only, false by default).
    PTargetCreateTarget -> Maybe Bool
pTargetCreateTargetNewWindow :: Maybe Bool,
    -- | Whether to create the target in background or foreground (chrome-only,
    --   false by default).
    PTargetCreateTarget -> Maybe Bool
pTargetCreateTargetBackground :: Maybe Bool
  }
  deriving (PTargetCreateTarget -> PTargetCreateTarget -> Bool
(PTargetCreateTarget -> PTargetCreateTarget -> Bool)
-> (PTargetCreateTarget -> PTargetCreateTarget -> Bool)
-> Eq PTargetCreateTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetCreateTarget -> PTargetCreateTarget -> Bool
$c/= :: PTargetCreateTarget -> PTargetCreateTarget -> Bool
== :: PTargetCreateTarget -> PTargetCreateTarget -> Bool
$c== :: PTargetCreateTarget -> PTargetCreateTarget -> Bool
Eq, Int -> PTargetCreateTarget -> ShowS
[PTargetCreateTarget] -> ShowS
PTargetCreateTarget -> String
(Int -> PTargetCreateTarget -> ShowS)
-> (PTargetCreateTarget -> String)
-> ([PTargetCreateTarget] -> ShowS)
-> Show PTargetCreateTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetCreateTarget] -> ShowS
$cshowList :: [PTargetCreateTarget] -> ShowS
show :: PTargetCreateTarget -> String
$cshow :: PTargetCreateTarget -> String
showsPrec :: Int -> PTargetCreateTarget -> ShowS
$cshowsPrec :: Int -> PTargetCreateTarget -> ShowS
Show)
pTargetCreateTarget
  {-
  -- | The initial URL the page will be navigated to. An empty string indicates about:blank.
  -}
  :: T.Text
  -> PTargetCreateTarget
pTargetCreateTarget :: Text -> PTargetCreateTarget
pTargetCreateTarget
  Text
arg_pTargetCreateTargetUrl
  = Text
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> PTargetCreateTarget
PTargetCreateTarget
    Text
arg_pTargetCreateTargetUrl
    Maybe Int
forall a. Maybe a
Nothing
    Maybe Int
forall a. Maybe a
Nothing
    Maybe Text
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
instance ToJSON PTargetCreateTarget where
  toJSON :: PTargetCreateTarget -> Value
toJSON PTargetCreateTarget
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
"url" 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 (PTargetCreateTarget -> Text
pTargetCreateTargetUrl PTargetCreateTarget
p),
    (Text
"width" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PTargetCreateTarget -> Maybe Int
pTargetCreateTargetWidth PTargetCreateTarget
p),
    (Text
"height" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PTargetCreateTarget -> Maybe Int
pTargetCreateTargetHeight PTargetCreateTarget
p),
    (Text
"browserContextId" 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
<$> (PTargetCreateTarget -> Maybe Text
pTargetCreateTargetBrowserContextId PTargetCreateTarget
p),
    (Text
"enableBeginFrameControl" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PTargetCreateTarget -> Maybe Bool
pTargetCreateTargetEnableBeginFrameControl PTargetCreateTarget
p),
    (Text
"newWindow" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PTargetCreateTarget -> Maybe Bool
pTargetCreateTargetNewWindow PTargetCreateTarget
p),
    (Text
"background" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PTargetCreateTarget -> Maybe Bool
pTargetCreateTargetBackground PTargetCreateTarget
p)
    ]
data TargetCreateTarget = TargetCreateTarget
  {
    -- | The id of the page opened.
    TargetCreateTarget -> Text
targetCreateTargetTargetId :: TargetTargetID
  }
  deriving (TargetCreateTarget -> TargetCreateTarget -> Bool
(TargetCreateTarget -> TargetCreateTarget -> Bool)
-> (TargetCreateTarget -> TargetCreateTarget -> Bool)
-> Eq TargetCreateTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetCreateTarget -> TargetCreateTarget -> Bool
$c/= :: TargetCreateTarget -> TargetCreateTarget -> Bool
== :: TargetCreateTarget -> TargetCreateTarget -> Bool
$c== :: TargetCreateTarget -> TargetCreateTarget -> Bool
Eq, Int -> TargetCreateTarget -> ShowS
[TargetCreateTarget] -> ShowS
TargetCreateTarget -> String
(Int -> TargetCreateTarget -> ShowS)
-> (TargetCreateTarget -> String)
-> ([TargetCreateTarget] -> ShowS)
-> Show TargetCreateTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetCreateTarget] -> ShowS
$cshowList :: [TargetCreateTarget] -> ShowS
show :: TargetCreateTarget -> String
$cshow :: TargetCreateTarget -> String
showsPrec :: Int -> TargetCreateTarget -> ShowS
$cshowsPrec :: Int -> TargetCreateTarget -> ShowS
Show)
instance FromJSON TargetCreateTarget where
  parseJSON :: Value -> Parser TargetCreateTarget
parseJSON = String
-> (Object -> Parser TargetCreateTarget)
-> Value
-> Parser TargetCreateTarget
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetCreateTarget" ((Object -> Parser TargetCreateTarget)
 -> Value -> Parser TargetCreateTarget)
-> (Object -> Parser TargetCreateTarget)
-> Value
-> Parser TargetCreateTarget
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> TargetCreateTarget
TargetCreateTarget
    (Text -> TargetCreateTarget)
-> Parser Text -> Parser TargetCreateTarget
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
"targetId"
instance Command PTargetCreateTarget where
  type CommandResponse PTargetCreateTarget = TargetCreateTarget
  commandName :: Proxy PTargetCreateTarget -> String
commandName Proxy PTargetCreateTarget
_ = String
"Target.createTarget"

-- | Detaches session with given id.

-- | Parameters of the 'Target.detachFromTarget' command.
data PTargetDetachFromTarget = PTargetDetachFromTarget
  {
    -- | Session to detach.
    PTargetDetachFromTarget -> Maybe Text
pTargetDetachFromTargetSessionId :: Maybe TargetSessionID
  }
  deriving (PTargetDetachFromTarget -> PTargetDetachFromTarget -> Bool
(PTargetDetachFromTarget -> PTargetDetachFromTarget -> Bool)
-> (PTargetDetachFromTarget -> PTargetDetachFromTarget -> Bool)
-> Eq PTargetDetachFromTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetDetachFromTarget -> PTargetDetachFromTarget -> Bool
$c/= :: PTargetDetachFromTarget -> PTargetDetachFromTarget -> Bool
== :: PTargetDetachFromTarget -> PTargetDetachFromTarget -> Bool
$c== :: PTargetDetachFromTarget -> PTargetDetachFromTarget -> Bool
Eq, Int -> PTargetDetachFromTarget -> ShowS
[PTargetDetachFromTarget] -> ShowS
PTargetDetachFromTarget -> String
(Int -> PTargetDetachFromTarget -> ShowS)
-> (PTargetDetachFromTarget -> String)
-> ([PTargetDetachFromTarget] -> ShowS)
-> Show PTargetDetachFromTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetDetachFromTarget] -> ShowS
$cshowList :: [PTargetDetachFromTarget] -> ShowS
show :: PTargetDetachFromTarget -> String
$cshow :: PTargetDetachFromTarget -> String
showsPrec :: Int -> PTargetDetachFromTarget -> ShowS
$cshowsPrec :: Int -> PTargetDetachFromTarget -> ShowS
Show)
pTargetDetachFromTarget
  :: PTargetDetachFromTarget
pTargetDetachFromTarget :: PTargetDetachFromTarget
pTargetDetachFromTarget
  = Maybe Text -> PTargetDetachFromTarget
PTargetDetachFromTarget
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PTargetDetachFromTarget where
  toJSON :: PTargetDetachFromTarget -> Value
toJSON PTargetDetachFromTarget
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
"sessionId" 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
<$> (PTargetDetachFromTarget -> Maybe Text
pTargetDetachFromTargetSessionId PTargetDetachFromTarget
p)
    ]
instance Command PTargetDetachFromTarget where
  type CommandResponse PTargetDetachFromTarget = ()
  commandName :: Proxy PTargetDetachFromTarget -> String
commandName Proxy PTargetDetachFromTarget
_ = String
"Target.detachFromTarget"
  fromJSON :: Proxy PTargetDetachFromTarget
-> Value -> Result (CommandResponse PTargetDetachFromTarget)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PTargetDetachFromTarget -> Result ())
-> Proxy PTargetDetachFromTarget
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PTargetDetachFromTarget -> ())
-> Proxy PTargetDetachFromTarget
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PTargetDetachFromTarget -> ()
forall a b. a -> b -> a
const ()

-- | Deletes a BrowserContext. All the belonging pages will be closed without calling their
--   beforeunload hooks.

-- | Parameters of the 'Target.disposeBrowserContext' command.
data PTargetDisposeBrowserContext = PTargetDisposeBrowserContext
  {
    PTargetDisposeBrowserContext -> Text
pTargetDisposeBrowserContextBrowserContextId :: BrowserBrowserContextID
  }
  deriving (PTargetDisposeBrowserContext
-> PTargetDisposeBrowserContext -> Bool
(PTargetDisposeBrowserContext
 -> PTargetDisposeBrowserContext -> Bool)
-> (PTargetDisposeBrowserContext
    -> PTargetDisposeBrowserContext -> Bool)
-> Eq PTargetDisposeBrowserContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetDisposeBrowserContext
-> PTargetDisposeBrowserContext -> Bool
$c/= :: PTargetDisposeBrowserContext
-> PTargetDisposeBrowserContext -> Bool
== :: PTargetDisposeBrowserContext
-> PTargetDisposeBrowserContext -> Bool
$c== :: PTargetDisposeBrowserContext
-> PTargetDisposeBrowserContext -> Bool
Eq, Int -> PTargetDisposeBrowserContext -> ShowS
[PTargetDisposeBrowserContext] -> ShowS
PTargetDisposeBrowserContext -> String
(Int -> PTargetDisposeBrowserContext -> ShowS)
-> (PTargetDisposeBrowserContext -> String)
-> ([PTargetDisposeBrowserContext] -> ShowS)
-> Show PTargetDisposeBrowserContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetDisposeBrowserContext] -> ShowS
$cshowList :: [PTargetDisposeBrowserContext] -> ShowS
show :: PTargetDisposeBrowserContext -> String
$cshow :: PTargetDisposeBrowserContext -> String
showsPrec :: Int -> PTargetDisposeBrowserContext -> ShowS
$cshowsPrec :: Int -> PTargetDisposeBrowserContext -> ShowS
Show)
pTargetDisposeBrowserContext
  :: BrowserBrowserContextID
  -> PTargetDisposeBrowserContext
pTargetDisposeBrowserContext :: Text -> PTargetDisposeBrowserContext
pTargetDisposeBrowserContext
  Text
arg_pTargetDisposeBrowserContextBrowserContextId
  = Text -> PTargetDisposeBrowserContext
PTargetDisposeBrowserContext
    Text
arg_pTargetDisposeBrowserContextBrowserContextId
instance ToJSON PTargetDisposeBrowserContext where
  toJSON :: PTargetDisposeBrowserContext -> Value
toJSON PTargetDisposeBrowserContext
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
"browserContextId" 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 (PTargetDisposeBrowserContext -> Text
pTargetDisposeBrowserContextBrowserContextId PTargetDisposeBrowserContext
p)
    ]
instance Command PTargetDisposeBrowserContext where
  type CommandResponse PTargetDisposeBrowserContext = ()
  commandName :: Proxy PTargetDisposeBrowserContext -> String
commandName Proxy PTargetDisposeBrowserContext
_ = String
"Target.disposeBrowserContext"
  fromJSON :: Proxy PTargetDisposeBrowserContext
-> Value -> Result (CommandResponse PTargetDisposeBrowserContext)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PTargetDisposeBrowserContext -> Result ())
-> Proxy PTargetDisposeBrowserContext
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PTargetDisposeBrowserContext -> ())
-> Proxy PTargetDisposeBrowserContext
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PTargetDisposeBrowserContext -> ()
forall a b. a -> b -> a
const ()

-- | Returns information about a target.

-- | Parameters of the 'Target.getTargetInfo' command.
data PTargetGetTargetInfo = PTargetGetTargetInfo
  {
    PTargetGetTargetInfo -> Maybe Text
pTargetGetTargetInfoTargetId :: Maybe TargetTargetID
  }
  deriving (PTargetGetTargetInfo -> PTargetGetTargetInfo -> Bool
(PTargetGetTargetInfo -> PTargetGetTargetInfo -> Bool)
-> (PTargetGetTargetInfo -> PTargetGetTargetInfo -> Bool)
-> Eq PTargetGetTargetInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetGetTargetInfo -> PTargetGetTargetInfo -> Bool
$c/= :: PTargetGetTargetInfo -> PTargetGetTargetInfo -> Bool
== :: PTargetGetTargetInfo -> PTargetGetTargetInfo -> Bool
$c== :: PTargetGetTargetInfo -> PTargetGetTargetInfo -> Bool
Eq, Int -> PTargetGetTargetInfo -> ShowS
[PTargetGetTargetInfo] -> ShowS
PTargetGetTargetInfo -> String
(Int -> PTargetGetTargetInfo -> ShowS)
-> (PTargetGetTargetInfo -> String)
-> ([PTargetGetTargetInfo] -> ShowS)
-> Show PTargetGetTargetInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetGetTargetInfo] -> ShowS
$cshowList :: [PTargetGetTargetInfo] -> ShowS
show :: PTargetGetTargetInfo -> String
$cshow :: PTargetGetTargetInfo -> String
showsPrec :: Int -> PTargetGetTargetInfo -> ShowS
$cshowsPrec :: Int -> PTargetGetTargetInfo -> ShowS
Show)
pTargetGetTargetInfo
  :: PTargetGetTargetInfo
pTargetGetTargetInfo :: PTargetGetTargetInfo
pTargetGetTargetInfo
  = Maybe Text -> PTargetGetTargetInfo
PTargetGetTargetInfo
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PTargetGetTargetInfo where
  toJSON :: PTargetGetTargetInfo -> Value
toJSON PTargetGetTargetInfo
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
"targetId" 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
<$> (PTargetGetTargetInfo -> Maybe Text
pTargetGetTargetInfoTargetId PTargetGetTargetInfo
p)
    ]
data TargetGetTargetInfo = TargetGetTargetInfo
  {
    TargetGetTargetInfo -> TargetTargetInfo
targetGetTargetInfoTargetInfo :: TargetTargetInfo
  }
  deriving (TargetGetTargetInfo -> TargetGetTargetInfo -> Bool
(TargetGetTargetInfo -> TargetGetTargetInfo -> Bool)
-> (TargetGetTargetInfo -> TargetGetTargetInfo -> Bool)
-> Eq TargetGetTargetInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetGetTargetInfo -> TargetGetTargetInfo -> Bool
$c/= :: TargetGetTargetInfo -> TargetGetTargetInfo -> Bool
== :: TargetGetTargetInfo -> TargetGetTargetInfo -> Bool
$c== :: TargetGetTargetInfo -> TargetGetTargetInfo -> Bool
Eq, Int -> TargetGetTargetInfo -> ShowS
[TargetGetTargetInfo] -> ShowS
TargetGetTargetInfo -> String
(Int -> TargetGetTargetInfo -> ShowS)
-> (TargetGetTargetInfo -> String)
-> ([TargetGetTargetInfo] -> ShowS)
-> Show TargetGetTargetInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetGetTargetInfo] -> ShowS
$cshowList :: [TargetGetTargetInfo] -> ShowS
show :: TargetGetTargetInfo -> String
$cshow :: TargetGetTargetInfo -> String
showsPrec :: Int -> TargetGetTargetInfo -> ShowS
$cshowsPrec :: Int -> TargetGetTargetInfo -> ShowS
Show)
instance FromJSON TargetGetTargetInfo where
  parseJSON :: Value -> Parser TargetGetTargetInfo
parseJSON = String
-> (Object -> Parser TargetGetTargetInfo)
-> Value
-> Parser TargetGetTargetInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetGetTargetInfo" ((Object -> Parser TargetGetTargetInfo)
 -> Value -> Parser TargetGetTargetInfo)
-> (Object -> Parser TargetGetTargetInfo)
-> Value
-> Parser TargetGetTargetInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> TargetTargetInfo -> TargetGetTargetInfo
TargetGetTargetInfo
    (TargetTargetInfo -> TargetGetTargetInfo)
-> Parser TargetTargetInfo -> Parser TargetGetTargetInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser TargetTargetInfo
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"targetInfo"
instance Command PTargetGetTargetInfo where
  type CommandResponse PTargetGetTargetInfo = TargetGetTargetInfo
  commandName :: Proxy PTargetGetTargetInfo -> String
commandName Proxy PTargetGetTargetInfo
_ = String
"Target.getTargetInfo"

-- | Retrieves a list of available targets.

-- | Parameters of the 'Target.getTargets' command.
data PTargetGetTargets = PTargetGetTargets
  {
    -- | Only targets matching filter will be reported. If filter is not specified
    --   and target discovery is currently enabled, a filter used for target discovery
    --   is used for consistency.
    PTargetGetTargets -> Maybe [TargetFilterEntry]
pTargetGetTargetsFilter :: Maybe TargetTargetFilter
  }
  deriving (PTargetGetTargets -> PTargetGetTargets -> Bool
(PTargetGetTargets -> PTargetGetTargets -> Bool)
-> (PTargetGetTargets -> PTargetGetTargets -> Bool)
-> Eq PTargetGetTargets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetGetTargets -> PTargetGetTargets -> Bool
$c/= :: PTargetGetTargets -> PTargetGetTargets -> Bool
== :: PTargetGetTargets -> PTargetGetTargets -> Bool
$c== :: PTargetGetTargets -> PTargetGetTargets -> Bool
Eq, Int -> PTargetGetTargets -> ShowS
[PTargetGetTargets] -> ShowS
PTargetGetTargets -> String
(Int -> PTargetGetTargets -> ShowS)
-> (PTargetGetTargets -> String)
-> ([PTargetGetTargets] -> ShowS)
-> Show PTargetGetTargets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetGetTargets] -> ShowS
$cshowList :: [PTargetGetTargets] -> ShowS
show :: PTargetGetTargets -> String
$cshow :: PTargetGetTargets -> String
showsPrec :: Int -> PTargetGetTargets -> ShowS
$cshowsPrec :: Int -> PTargetGetTargets -> ShowS
Show)
pTargetGetTargets
  :: PTargetGetTargets
pTargetGetTargets :: PTargetGetTargets
pTargetGetTargets
  = Maybe [TargetFilterEntry] -> PTargetGetTargets
PTargetGetTargets
    Maybe [TargetFilterEntry]
forall a. Maybe a
Nothing
instance ToJSON PTargetGetTargets where
  toJSON :: PTargetGetTargets -> Value
toJSON PTargetGetTargets
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
"filter" Text -> [TargetFilterEntry] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([TargetFilterEntry] -> Pair)
-> Maybe [TargetFilterEntry] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PTargetGetTargets -> Maybe [TargetFilterEntry]
pTargetGetTargetsFilter PTargetGetTargets
p)
    ]
data TargetGetTargets = TargetGetTargets
  {
    -- | The list of targets.
    TargetGetTargets -> [TargetTargetInfo]
targetGetTargetsTargetInfos :: [TargetTargetInfo]
  }
  deriving (TargetGetTargets -> TargetGetTargets -> Bool
(TargetGetTargets -> TargetGetTargets -> Bool)
-> (TargetGetTargets -> TargetGetTargets -> Bool)
-> Eq TargetGetTargets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetGetTargets -> TargetGetTargets -> Bool
$c/= :: TargetGetTargets -> TargetGetTargets -> Bool
== :: TargetGetTargets -> TargetGetTargets -> Bool
$c== :: TargetGetTargets -> TargetGetTargets -> Bool
Eq, Int -> TargetGetTargets -> ShowS
[TargetGetTargets] -> ShowS
TargetGetTargets -> String
(Int -> TargetGetTargets -> ShowS)
-> (TargetGetTargets -> String)
-> ([TargetGetTargets] -> ShowS)
-> Show TargetGetTargets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetGetTargets] -> ShowS
$cshowList :: [TargetGetTargets] -> ShowS
show :: TargetGetTargets -> String
$cshow :: TargetGetTargets -> String
showsPrec :: Int -> TargetGetTargets -> ShowS
$cshowsPrec :: Int -> TargetGetTargets -> ShowS
Show)
instance FromJSON TargetGetTargets where
  parseJSON :: Value -> Parser TargetGetTargets
parseJSON = String
-> (Object -> Parser TargetGetTargets)
-> Value
-> Parser TargetGetTargets
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetGetTargets" ((Object -> Parser TargetGetTargets)
 -> Value -> Parser TargetGetTargets)
-> (Object -> Parser TargetGetTargets)
-> Value
-> Parser TargetGetTargets
forall a b. (a -> b) -> a -> b
$ \Object
o -> [TargetTargetInfo] -> TargetGetTargets
TargetGetTargets
    ([TargetTargetInfo] -> TargetGetTargets)
-> Parser [TargetTargetInfo] -> Parser TargetGetTargets
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [TargetTargetInfo]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"targetInfos"
instance Command PTargetGetTargets where
  type CommandResponse PTargetGetTargets = TargetGetTargets
  commandName :: Proxy PTargetGetTargets -> String
commandName Proxy PTargetGetTargets
_ = String
"Target.getTargets"

-- | Controls whether to automatically attach to new targets which are considered to be related to
--   this one. When turned on, attaches to all existing related targets as well. When turned off,
--   automatically detaches from all currently attached targets.
--   This also clears all targets added by `autoAttachRelated` from the list of targets to watch
--   for creation of related targets.

-- | Parameters of the 'Target.setAutoAttach' command.
data PTargetSetAutoAttach = PTargetSetAutoAttach
  {
    -- | Whether to auto-attach to related targets.
    PTargetSetAutoAttach -> Bool
pTargetSetAutoAttachAutoAttach :: Bool,
    -- | Whether to pause new targets when attaching to them. Use `Runtime.runIfWaitingForDebugger`
    --   to run paused targets.
    PTargetSetAutoAttach -> Bool
pTargetSetAutoAttachWaitForDebuggerOnStart :: Bool,
    -- | Enables "flat" access to the session via specifying sessionId attribute in the commands.
    --   We plan to make this the default, deprecate non-flattened mode,
    --   and eventually retire it. See crbug.com/991325.
    PTargetSetAutoAttach -> Maybe Bool
pTargetSetAutoAttachFlatten :: Maybe Bool,
    -- | Only targets matching filter will be attached.
    PTargetSetAutoAttach -> Maybe [TargetFilterEntry]
pTargetSetAutoAttachFilter :: Maybe TargetTargetFilter
  }
  deriving (PTargetSetAutoAttach -> PTargetSetAutoAttach -> Bool
(PTargetSetAutoAttach -> PTargetSetAutoAttach -> Bool)
-> (PTargetSetAutoAttach -> PTargetSetAutoAttach -> Bool)
-> Eq PTargetSetAutoAttach
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetSetAutoAttach -> PTargetSetAutoAttach -> Bool
$c/= :: PTargetSetAutoAttach -> PTargetSetAutoAttach -> Bool
== :: PTargetSetAutoAttach -> PTargetSetAutoAttach -> Bool
$c== :: PTargetSetAutoAttach -> PTargetSetAutoAttach -> Bool
Eq, Int -> PTargetSetAutoAttach -> ShowS
[PTargetSetAutoAttach] -> ShowS
PTargetSetAutoAttach -> String
(Int -> PTargetSetAutoAttach -> ShowS)
-> (PTargetSetAutoAttach -> String)
-> ([PTargetSetAutoAttach] -> ShowS)
-> Show PTargetSetAutoAttach
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetSetAutoAttach] -> ShowS
$cshowList :: [PTargetSetAutoAttach] -> ShowS
show :: PTargetSetAutoAttach -> String
$cshow :: PTargetSetAutoAttach -> String
showsPrec :: Int -> PTargetSetAutoAttach -> ShowS
$cshowsPrec :: Int -> PTargetSetAutoAttach -> ShowS
Show)
pTargetSetAutoAttach
  {-
  -- | Whether to auto-attach to related targets.
  -}
  :: Bool
  {-
  -- | Whether to pause new targets when attaching to them. Use `Runtime.runIfWaitingForDebugger`
  --   to run paused targets.
  -}
  -> Bool
  -> PTargetSetAutoAttach
pTargetSetAutoAttach :: Bool -> Bool -> PTargetSetAutoAttach
pTargetSetAutoAttach
  Bool
arg_pTargetSetAutoAttachAutoAttach
  Bool
arg_pTargetSetAutoAttachWaitForDebuggerOnStart
  = Bool
-> Bool
-> Maybe Bool
-> Maybe [TargetFilterEntry]
-> PTargetSetAutoAttach
PTargetSetAutoAttach
    Bool
arg_pTargetSetAutoAttachAutoAttach
    Bool
arg_pTargetSetAutoAttachWaitForDebuggerOnStart
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe [TargetFilterEntry]
forall a. Maybe a
Nothing
instance ToJSON PTargetSetAutoAttach where
  toJSON :: PTargetSetAutoAttach -> Value
toJSON PTargetSetAutoAttach
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
"autoAttach" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (PTargetSetAutoAttach -> Bool
pTargetSetAutoAttachAutoAttach PTargetSetAutoAttach
p),
    (Text
"waitForDebuggerOnStart" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (PTargetSetAutoAttach -> Bool
pTargetSetAutoAttachWaitForDebuggerOnStart PTargetSetAutoAttach
p),
    (Text
"flatten" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PTargetSetAutoAttach -> Maybe Bool
pTargetSetAutoAttachFlatten PTargetSetAutoAttach
p),
    (Text
"filter" Text -> [TargetFilterEntry] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([TargetFilterEntry] -> Pair)
-> Maybe [TargetFilterEntry] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PTargetSetAutoAttach -> Maybe [TargetFilterEntry]
pTargetSetAutoAttachFilter PTargetSetAutoAttach
p)
    ]
instance Command PTargetSetAutoAttach where
  type CommandResponse PTargetSetAutoAttach = ()
  commandName :: Proxy PTargetSetAutoAttach -> String
commandName Proxy PTargetSetAutoAttach
_ = String
"Target.setAutoAttach"
  fromJSON :: Proxy PTargetSetAutoAttach
-> Value -> Result (CommandResponse PTargetSetAutoAttach)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PTargetSetAutoAttach -> Result ())
-> Proxy PTargetSetAutoAttach
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PTargetSetAutoAttach -> ())
-> Proxy PTargetSetAutoAttach
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PTargetSetAutoAttach -> ()
forall a b. a -> b -> a
const ()

-- | Adds the specified target to the list of targets that will be monitored for any related target
--   creation (such as child frames, child workers and new versions of service worker) and reported
--   through `attachedToTarget`. The specified target is also auto-attached.
--   This cancels the effect of any previous `setAutoAttach` and is also cancelled by subsequent
--   `setAutoAttach`. Only available at the Browser target.

-- | Parameters of the 'Target.autoAttachRelated' command.
data PTargetAutoAttachRelated = PTargetAutoAttachRelated
  {
    PTargetAutoAttachRelated -> Text
pTargetAutoAttachRelatedTargetId :: TargetTargetID,
    -- | Whether to pause new targets when attaching to them. Use `Runtime.runIfWaitingForDebugger`
    --   to run paused targets.
    PTargetAutoAttachRelated -> Bool
pTargetAutoAttachRelatedWaitForDebuggerOnStart :: Bool,
    -- | Only targets matching filter will be attached.
    PTargetAutoAttachRelated -> Maybe [TargetFilterEntry]
pTargetAutoAttachRelatedFilter :: Maybe TargetTargetFilter
  }
  deriving (PTargetAutoAttachRelated -> PTargetAutoAttachRelated -> Bool
(PTargetAutoAttachRelated -> PTargetAutoAttachRelated -> Bool)
-> (PTargetAutoAttachRelated -> PTargetAutoAttachRelated -> Bool)
-> Eq PTargetAutoAttachRelated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetAutoAttachRelated -> PTargetAutoAttachRelated -> Bool
$c/= :: PTargetAutoAttachRelated -> PTargetAutoAttachRelated -> Bool
== :: PTargetAutoAttachRelated -> PTargetAutoAttachRelated -> Bool
$c== :: PTargetAutoAttachRelated -> PTargetAutoAttachRelated -> Bool
Eq, Int -> PTargetAutoAttachRelated -> ShowS
[PTargetAutoAttachRelated] -> ShowS
PTargetAutoAttachRelated -> String
(Int -> PTargetAutoAttachRelated -> ShowS)
-> (PTargetAutoAttachRelated -> String)
-> ([PTargetAutoAttachRelated] -> ShowS)
-> Show PTargetAutoAttachRelated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetAutoAttachRelated] -> ShowS
$cshowList :: [PTargetAutoAttachRelated] -> ShowS
show :: PTargetAutoAttachRelated -> String
$cshow :: PTargetAutoAttachRelated -> String
showsPrec :: Int -> PTargetAutoAttachRelated -> ShowS
$cshowsPrec :: Int -> PTargetAutoAttachRelated -> ShowS
Show)
pTargetAutoAttachRelated
  :: TargetTargetID
  {-
  -- | Whether to pause new targets when attaching to them. Use `Runtime.runIfWaitingForDebugger`
  --   to run paused targets.
  -}
  -> Bool
  -> PTargetAutoAttachRelated
pTargetAutoAttachRelated :: Text -> Bool -> PTargetAutoAttachRelated
pTargetAutoAttachRelated
  Text
arg_pTargetAutoAttachRelatedTargetId
  Bool
arg_pTargetAutoAttachRelatedWaitForDebuggerOnStart
  = Text
-> Bool -> Maybe [TargetFilterEntry] -> PTargetAutoAttachRelated
PTargetAutoAttachRelated
    Text
arg_pTargetAutoAttachRelatedTargetId
    Bool
arg_pTargetAutoAttachRelatedWaitForDebuggerOnStart
    Maybe [TargetFilterEntry]
forall a. Maybe a
Nothing
instance ToJSON PTargetAutoAttachRelated where
  toJSON :: PTargetAutoAttachRelated -> Value
toJSON PTargetAutoAttachRelated
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
"targetId" 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 (PTargetAutoAttachRelated -> Text
pTargetAutoAttachRelatedTargetId PTargetAutoAttachRelated
p),
    (Text
"waitForDebuggerOnStart" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (PTargetAutoAttachRelated -> Bool
pTargetAutoAttachRelatedWaitForDebuggerOnStart PTargetAutoAttachRelated
p),
    (Text
"filter" Text -> [TargetFilterEntry] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([TargetFilterEntry] -> Pair)
-> Maybe [TargetFilterEntry] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PTargetAutoAttachRelated -> Maybe [TargetFilterEntry]
pTargetAutoAttachRelatedFilter PTargetAutoAttachRelated
p)
    ]
instance Command PTargetAutoAttachRelated where
  type CommandResponse PTargetAutoAttachRelated = ()
  commandName :: Proxy PTargetAutoAttachRelated -> String
commandName Proxy PTargetAutoAttachRelated
_ = String
"Target.autoAttachRelated"
  fromJSON :: Proxy PTargetAutoAttachRelated
-> Value -> Result (CommandResponse PTargetAutoAttachRelated)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PTargetAutoAttachRelated -> Result ())
-> Proxy PTargetAutoAttachRelated
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PTargetAutoAttachRelated -> ())
-> Proxy PTargetAutoAttachRelated
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PTargetAutoAttachRelated -> ()
forall a b. a -> b -> a
const ()

-- | Controls whether to discover available targets and notify via
--   `targetCreated/targetInfoChanged/targetDestroyed` events.

-- | Parameters of the 'Target.setDiscoverTargets' command.
data PTargetSetDiscoverTargets = PTargetSetDiscoverTargets
  {
    -- | Whether to discover available targets.
    PTargetSetDiscoverTargets -> Bool
pTargetSetDiscoverTargetsDiscover :: Bool,
    -- | Only targets matching filter will be attached. If `discover` is false,
    --   `filter` must be omitted or empty.
    PTargetSetDiscoverTargets -> Maybe [TargetFilterEntry]
pTargetSetDiscoverTargetsFilter :: Maybe TargetTargetFilter
  }
  deriving (PTargetSetDiscoverTargets -> PTargetSetDiscoverTargets -> Bool
(PTargetSetDiscoverTargets -> PTargetSetDiscoverTargets -> Bool)
-> (PTargetSetDiscoverTargets -> PTargetSetDiscoverTargets -> Bool)
-> Eq PTargetSetDiscoverTargets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetSetDiscoverTargets -> PTargetSetDiscoverTargets -> Bool
$c/= :: PTargetSetDiscoverTargets -> PTargetSetDiscoverTargets -> Bool
== :: PTargetSetDiscoverTargets -> PTargetSetDiscoverTargets -> Bool
$c== :: PTargetSetDiscoverTargets -> PTargetSetDiscoverTargets -> Bool
Eq, Int -> PTargetSetDiscoverTargets -> ShowS
[PTargetSetDiscoverTargets] -> ShowS
PTargetSetDiscoverTargets -> String
(Int -> PTargetSetDiscoverTargets -> ShowS)
-> (PTargetSetDiscoverTargets -> String)
-> ([PTargetSetDiscoverTargets] -> ShowS)
-> Show PTargetSetDiscoverTargets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetSetDiscoverTargets] -> ShowS
$cshowList :: [PTargetSetDiscoverTargets] -> ShowS
show :: PTargetSetDiscoverTargets -> String
$cshow :: PTargetSetDiscoverTargets -> String
showsPrec :: Int -> PTargetSetDiscoverTargets -> ShowS
$cshowsPrec :: Int -> PTargetSetDiscoverTargets -> ShowS
Show)
pTargetSetDiscoverTargets
  {-
  -- | Whether to discover available targets.
  -}
  :: Bool
  -> PTargetSetDiscoverTargets
pTargetSetDiscoverTargets :: Bool -> PTargetSetDiscoverTargets
pTargetSetDiscoverTargets
  Bool
arg_pTargetSetDiscoverTargetsDiscover
  = Bool -> Maybe [TargetFilterEntry] -> PTargetSetDiscoverTargets
PTargetSetDiscoverTargets
    Bool
arg_pTargetSetDiscoverTargetsDiscover
    Maybe [TargetFilterEntry]
forall a. Maybe a
Nothing
instance ToJSON PTargetSetDiscoverTargets where
  toJSON :: PTargetSetDiscoverTargets -> Value
toJSON PTargetSetDiscoverTargets
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
"discover" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (PTargetSetDiscoverTargets -> Bool
pTargetSetDiscoverTargetsDiscover PTargetSetDiscoverTargets
p),
    (Text
"filter" Text -> [TargetFilterEntry] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([TargetFilterEntry] -> Pair)
-> Maybe [TargetFilterEntry] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PTargetSetDiscoverTargets -> Maybe [TargetFilterEntry]
pTargetSetDiscoverTargetsFilter PTargetSetDiscoverTargets
p)
    ]
instance Command PTargetSetDiscoverTargets where
  type CommandResponse PTargetSetDiscoverTargets = ()
  commandName :: Proxy PTargetSetDiscoverTargets -> String
commandName Proxy PTargetSetDiscoverTargets
_ = String
"Target.setDiscoverTargets"
  fromJSON :: Proxy PTargetSetDiscoverTargets
-> Value -> Result (CommandResponse PTargetSetDiscoverTargets)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PTargetSetDiscoverTargets -> Result ())
-> Proxy PTargetSetDiscoverTargets
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PTargetSetDiscoverTargets -> ())
-> Proxy PTargetSetDiscoverTargets
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PTargetSetDiscoverTargets -> ()
forall a b. a -> b -> a
const ()

-- | Enables target discovery for the specified locations, when `setDiscoverTargets` was set to
--   `true`.

-- | Parameters of the 'Target.setRemoteLocations' command.
data PTargetSetRemoteLocations = PTargetSetRemoteLocations
  {
    -- | List of remote locations.
    PTargetSetRemoteLocations -> [TargetRemoteLocation]
pTargetSetRemoteLocationsLocations :: [TargetRemoteLocation]
  }
  deriving (PTargetSetRemoteLocations -> PTargetSetRemoteLocations -> Bool
(PTargetSetRemoteLocations -> PTargetSetRemoteLocations -> Bool)
-> (PTargetSetRemoteLocations -> PTargetSetRemoteLocations -> Bool)
-> Eq PTargetSetRemoteLocations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTargetSetRemoteLocations -> PTargetSetRemoteLocations -> Bool
$c/= :: PTargetSetRemoteLocations -> PTargetSetRemoteLocations -> Bool
== :: PTargetSetRemoteLocations -> PTargetSetRemoteLocations -> Bool
$c== :: PTargetSetRemoteLocations -> PTargetSetRemoteLocations -> Bool
Eq, Int -> PTargetSetRemoteLocations -> ShowS
[PTargetSetRemoteLocations] -> ShowS
PTargetSetRemoteLocations -> String
(Int -> PTargetSetRemoteLocations -> ShowS)
-> (PTargetSetRemoteLocations -> String)
-> ([PTargetSetRemoteLocations] -> ShowS)
-> Show PTargetSetRemoteLocations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTargetSetRemoteLocations] -> ShowS
$cshowList :: [PTargetSetRemoteLocations] -> ShowS
show :: PTargetSetRemoteLocations -> String
$cshow :: PTargetSetRemoteLocations -> String
showsPrec :: Int -> PTargetSetRemoteLocations -> ShowS
$cshowsPrec :: Int -> PTargetSetRemoteLocations -> ShowS
Show)
pTargetSetRemoteLocations
  {-
  -- | List of remote locations.
  -}
  :: [TargetRemoteLocation]
  -> PTargetSetRemoteLocations
pTargetSetRemoteLocations :: [TargetRemoteLocation] -> PTargetSetRemoteLocations
pTargetSetRemoteLocations
  [TargetRemoteLocation]
arg_pTargetSetRemoteLocationsLocations
  = [TargetRemoteLocation] -> PTargetSetRemoteLocations
PTargetSetRemoteLocations
    [TargetRemoteLocation]
arg_pTargetSetRemoteLocationsLocations
instance ToJSON PTargetSetRemoteLocations where
  toJSON :: PTargetSetRemoteLocations -> Value
toJSON PTargetSetRemoteLocations
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
"locations" Text -> [TargetRemoteLocation] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([TargetRemoteLocation] -> Pair)
-> Maybe [TargetRemoteLocation] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TargetRemoteLocation] -> Maybe [TargetRemoteLocation]
forall a. a -> Maybe a
Just (PTargetSetRemoteLocations -> [TargetRemoteLocation]
pTargetSetRemoteLocationsLocations PTargetSetRemoteLocations
p)
    ]
instance Command PTargetSetRemoteLocations where
  type CommandResponse PTargetSetRemoteLocations = ()
  commandName :: Proxy PTargetSetRemoteLocations -> String
commandName Proxy PTargetSetRemoteLocations
_ = String
"Target.setRemoteLocations"
  fromJSON :: Proxy PTargetSetRemoteLocations
-> Value -> Result (CommandResponse PTargetSetRemoteLocations)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PTargetSetRemoteLocations -> Result ())
-> Proxy PTargetSetRemoteLocations
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PTargetSetRemoteLocations -> ())
-> Proxy PTargetSetRemoteLocations
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PTargetSetRemoteLocations -> ()
forall a b. a -> b -> a
const ()