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


{- |
= ServiceWorker

-}


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


-- | Type 'ServiceWorker.RegistrationID'.
type ServiceWorkerRegistrationID = T.Text

-- | Type 'ServiceWorker.ServiceWorkerRegistration'.
--   ServiceWorker registration.
data ServiceWorkerServiceWorkerRegistration = ServiceWorkerServiceWorkerRegistration
  {
    ServiceWorkerServiceWorkerRegistration
-> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerRegistrationRegistrationId :: ServiceWorkerRegistrationID,
    ServiceWorkerServiceWorkerRegistration
-> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerRegistrationScopeURL :: T.Text,
    ServiceWorkerServiceWorkerRegistration -> Bool
serviceWorkerServiceWorkerRegistrationIsDeleted :: Bool
  }
  deriving (ServiceWorkerServiceWorkerRegistration
-> ServiceWorkerServiceWorkerRegistration -> Bool
(ServiceWorkerServiceWorkerRegistration
 -> ServiceWorkerServiceWorkerRegistration -> Bool)
-> (ServiceWorkerServiceWorkerRegistration
    -> ServiceWorkerServiceWorkerRegistration -> Bool)
-> Eq ServiceWorkerServiceWorkerRegistration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServiceWorkerServiceWorkerRegistration
-> ServiceWorkerServiceWorkerRegistration -> Bool
$c/= :: ServiceWorkerServiceWorkerRegistration
-> ServiceWorkerServiceWorkerRegistration -> Bool
== :: ServiceWorkerServiceWorkerRegistration
-> ServiceWorkerServiceWorkerRegistration -> Bool
$c== :: ServiceWorkerServiceWorkerRegistration
-> ServiceWorkerServiceWorkerRegistration -> Bool
Eq, Int -> ServiceWorkerServiceWorkerRegistration -> ShowS
[ServiceWorkerServiceWorkerRegistration] -> ShowS
ServiceWorkerServiceWorkerRegistration -> String
(Int -> ServiceWorkerServiceWorkerRegistration -> ShowS)
-> (ServiceWorkerServiceWorkerRegistration -> String)
-> ([ServiceWorkerServiceWorkerRegistration] -> ShowS)
-> Show ServiceWorkerServiceWorkerRegistration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServiceWorkerServiceWorkerRegistration] -> ShowS
$cshowList :: [ServiceWorkerServiceWorkerRegistration] -> ShowS
show :: ServiceWorkerServiceWorkerRegistration -> String
$cshow :: ServiceWorkerServiceWorkerRegistration -> String
showsPrec :: Int -> ServiceWorkerServiceWorkerRegistration -> ShowS
$cshowsPrec :: Int -> ServiceWorkerServiceWorkerRegistration -> ShowS
Show)
instance FromJSON ServiceWorkerServiceWorkerRegistration where
  parseJSON :: Value -> Parser ServiceWorkerServiceWorkerRegistration
parseJSON = String
-> (Object -> Parser ServiceWorkerServiceWorkerRegistration)
-> Value
-> Parser ServiceWorkerServiceWorkerRegistration
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ServiceWorkerServiceWorkerRegistration" ((Object -> Parser ServiceWorkerServiceWorkerRegistration)
 -> Value -> Parser ServiceWorkerServiceWorkerRegistration)
-> (Object -> Parser ServiceWorkerServiceWorkerRegistration)
-> Value
-> Parser ServiceWorkerServiceWorkerRegistration
forall a b. (a -> b) -> a -> b
$ \Object
o -> ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> Bool
-> ServiceWorkerServiceWorkerRegistration
ServiceWorkerServiceWorkerRegistration
    (ServiceWorkerRegistrationID
 -> ServiceWorkerRegistrationID
 -> Bool
 -> ServiceWorkerServiceWorkerRegistration)
-> Parser ServiceWorkerRegistrationID
-> Parser
     (ServiceWorkerRegistrationID
      -> Bool -> ServiceWorkerServiceWorkerRegistration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object
-> ServiceWorkerRegistrationID
-> Parser ServiceWorkerRegistrationID
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser a
A..: ServiceWorkerRegistrationID
"registrationId"
    Parser
  (ServiceWorkerRegistrationID
   -> Bool -> ServiceWorkerServiceWorkerRegistration)
-> Parser ServiceWorkerRegistrationID
-> Parser (Bool -> ServiceWorkerServiceWorkerRegistration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> ServiceWorkerRegistrationID
-> Parser ServiceWorkerRegistrationID
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser a
A..: ServiceWorkerRegistrationID
"scopeURL"
    Parser (Bool -> ServiceWorkerServiceWorkerRegistration)
-> Parser Bool -> Parser ServiceWorkerServiceWorkerRegistration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> ServiceWorkerRegistrationID -> Parser Bool
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser a
A..: ServiceWorkerRegistrationID
"isDeleted"
instance ToJSON ServiceWorkerServiceWorkerRegistration where
  toJSON :: ServiceWorkerServiceWorkerRegistration -> Value
toJSON ServiceWorkerServiceWorkerRegistration
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 [
    (ServiceWorkerRegistrationID
"registrationId" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (ServiceWorkerServiceWorkerRegistration
-> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerRegistrationRegistrationId ServiceWorkerServiceWorkerRegistration
p),
    (ServiceWorkerRegistrationID
"scopeURL" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (ServiceWorkerServiceWorkerRegistration
-> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerRegistrationScopeURL ServiceWorkerServiceWorkerRegistration
p),
    (ServiceWorkerRegistrationID
"isDeleted" ServiceWorkerRegistrationID -> Bool -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> 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 (ServiceWorkerServiceWorkerRegistration -> Bool
serviceWorkerServiceWorkerRegistrationIsDeleted ServiceWorkerServiceWorkerRegistration
p)
    ]

-- | Type 'ServiceWorker.ServiceWorkerVersionRunningStatus'.
data ServiceWorkerServiceWorkerVersionRunningStatus = ServiceWorkerServiceWorkerVersionRunningStatusStopped | ServiceWorkerServiceWorkerVersionRunningStatusStarting | ServiceWorkerServiceWorkerVersionRunningStatusRunning | ServiceWorkerServiceWorkerVersionRunningStatusStopping
  deriving (Eq ServiceWorkerServiceWorkerVersionRunningStatus
Eq ServiceWorkerServiceWorkerVersionRunningStatus
-> (ServiceWorkerServiceWorkerVersionRunningStatus
    -> ServiceWorkerServiceWorkerVersionRunningStatus -> Ordering)
-> (ServiceWorkerServiceWorkerVersionRunningStatus
    -> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool)
-> (ServiceWorkerServiceWorkerVersionRunningStatus
    -> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool)
-> (ServiceWorkerServiceWorkerVersionRunningStatus
    -> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool)
-> (ServiceWorkerServiceWorkerVersionRunningStatus
    -> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool)
-> (ServiceWorkerServiceWorkerVersionRunningStatus
    -> ServiceWorkerServiceWorkerVersionRunningStatus
    -> ServiceWorkerServiceWorkerVersionRunningStatus)
-> (ServiceWorkerServiceWorkerVersionRunningStatus
    -> ServiceWorkerServiceWorkerVersionRunningStatus
    -> ServiceWorkerServiceWorkerVersionRunningStatus)
-> Ord ServiceWorkerServiceWorkerVersionRunningStatus
ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool
ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Ordering
ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus
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 :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus
$cmin :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus
max :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus
$cmax :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus
>= :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool
$c>= :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool
> :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool
$c> :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool
<= :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool
$c<= :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool
< :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool
$c< :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool
compare :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Ordering
$ccompare :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Ordering
$cp1Ord :: Eq ServiceWorkerServiceWorkerVersionRunningStatus
Ord, ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool
(ServiceWorkerServiceWorkerVersionRunningStatus
 -> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool)
-> (ServiceWorkerServiceWorkerVersionRunningStatus
    -> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool)
-> Eq ServiceWorkerServiceWorkerVersionRunningStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool
$c/= :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool
== :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool
$c== :: ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Bool
Eq, Int -> ServiceWorkerServiceWorkerVersionRunningStatus -> ShowS
[ServiceWorkerServiceWorkerVersionRunningStatus] -> ShowS
ServiceWorkerServiceWorkerVersionRunningStatus -> String
(Int -> ServiceWorkerServiceWorkerVersionRunningStatus -> ShowS)
-> (ServiceWorkerServiceWorkerVersionRunningStatus -> String)
-> ([ServiceWorkerServiceWorkerVersionRunningStatus] -> ShowS)
-> Show ServiceWorkerServiceWorkerVersionRunningStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServiceWorkerServiceWorkerVersionRunningStatus] -> ShowS
$cshowList :: [ServiceWorkerServiceWorkerVersionRunningStatus] -> ShowS
show :: ServiceWorkerServiceWorkerVersionRunningStatus -> String
$cshow :: ServiceWorkerServiceWorkerVersionRunningStatus -> String
showsPrec :: Int -> ServiceWorkerServiceWorkerVersionRunningStatus -> ShowS
$cshowsPrec :: Int -> ServiceWorkerServiceWorkerVersionRunningStatus -> ShowS
Show, ReadPrec [ServiceWorkerServiceWorkerVersionRunningStatus]
ReadPrec ServiceWorkerServiceWorkerVersionRunningStatus
Int -> ReadS ServiceWorkerServiceWorkerVersionRunningStatus
ReadS [ServiceWorkerServiceWorkerVersionRunningStatus]
(Int -> ReadS ServiceWorkerServiceWorkerVersionRunningStatus)
-> ReadS [ServiceWorkerServiceWorkerVersionRunningStatus]
-> ReadPrec ServiceWorkerServiceWorkerVersionRunningStatus
-> ReadPrec [ServiceWorkerServiceWorkerVersionRunningStatus]
-> Read ServiceWorkerServiceWorkerVersionRunningStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ServiceWorkerServiceWorkerVersionRunningStatus]
$creadListPrec :: ReadPrec [ServiceWorkerServiceWorkerVersionRunningStatus]
readPrec :: ReadPrec ServiceWorkerServiceWorkerVersionRunningStatus
$creadPrec :: ReadPrec ServiceWorkerServiceWorkerVersionRunningStatus
readList :: ReadS [ServiceWorkerServiceWorkerVersionRunningStatus]
$creadList :: ReadS [ServiceWorkerServiceWorkerVersionRunningStatus]
readsPrec :: Int -> ReadS ServiceWorkerServiceWorkerVersionRunningStatus
$creadsPrec :: Int -> ReadS ServiceWorkerServiceWorkerVersionRunningStatus
Read)
instance FromJSON ServiceWorkerServiceWorkerVersionRunningStatus where
  parseJSON :: Value -> Parser ServiceWorkerServiceWorkerVersionRunningStatus
parseJSON = String
-> (ServiceWorkerRegistrationID
    -> Parser ServiceWorkerServiceWorkerVersionRunningStatus)
-> Value
-> Parser ServiceWorkerServiceWorkerVersionRunningStatus
forall a.
String
-> (ServiceWorkerRegistrationID -> Parser a) -> Value -> Parser a
A.withText String
"ServiceWorkerServiceWorkerVersionRunningStatus" ((ServiceWorkerRegistrationID
  -> Parser ServiceWorkerServiceWorkerVersionRunningStatus)
 -> Value -> Parser ServiceWorkerServiceWorkerVersionRunningStatus)
-> (ServiceWorkerRegistrationID
    -> Parser ServiceWorkerServiceWorkerVersionRunningStatus)
-> Value
-> Parser ServiceWorkerServiceWorkerVersionRunningStatus
forall a b. (a -> b) -> a -> b
$ \ServiceWorkerRegistrationID
v -> case ServiceWorkerRegistrationID
v of
    ServiceWorkerRegistrationID
"stopped" -> ServiceWorkerServiceWorkerVersionRunningStatus
-> Parser ServiceWorkerServiceWorkerVersionRunningStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServiceWorkerServiceWorkerVersionRunningStatus
ServiceWorkerServiceWorkerVersionRunningStatusStopped
    ServiceWorkerRegistrationID
"starting" -> ServiceWorkerServiceWorkerVersionRunningStatus
-> Parser ServiceWorkerServiceWorkerVersionRunningStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServiceWorkerServiceWorkerVersionRunningStatus
ServiceWorkerServiceWorkerVersionRunningStatusStarting
    ServiceWorkerRegistrationID
"running" -> ServiceWorkerServiceWorkerVersionRunningStatus
-> Parser ServiceWorkerServiceWorkerVersionRunningStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServiceWorkerServiceWorkerVersionRunningStatus
ServiceWorkerServiceWorkerVersionRunningStatusRunning
    ServiceWorkerRegistrationID
"stopping" -> ServiceWorkerServiceWorkerVersionRunningStatus
-> Parser ServiceWorkerServiceWorkerVersionRunningStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServiceWorkerServiceWorkerVersionRunningStatus
ServiceWorkerServiceWorkerVersionRunningStatusStopping
    ServiceWorkerRegistrationID
"_" -> String -> Parser ServiceWorkerServiceWorkerVersionRunningStatus
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse ServiceWorkerServiceWorkerVersionRunningStatus"
instance ToJSON ServiceWorkerServiceWorkerVersionRunningStatus where
  toJSON :: ServiceWorkerServiceWorkerVersionRunningStatus -> Value
toJSON ServiceWorkerServiceWorkerVersionRunningStatus
v = ServiceWorkerRegistrationID -> Value
A.String (ServiceWorkerRegistrationID -> Value)
-> ServiceWorkerRegistrationID -> Value
forall a b. (a -> b) -> a -> b
$ case ServiceWorkerServiceWorkerVersionRunningStatus
v of
    ServiceWorkerServiceWorkerVersionRunningStatus
ServiceWorkerServiceWorkerVersionRunningStatusStopped -> ServiceWorkerRegistrationID
"stopped"
    ServiceWorkerServiceWorkerVersionRunningStatus
ServiceWorkerServiceWorkerVersionRunningStatusStarting -> ServiceWorkerRegistrationID
"starting"
    ServiceWorkerServiceWorkerVersionRunningStatus
ServiceWorkerServiceWorkerVersionRunningStatusRunning -> ServiceWorkerRegistrationID
"running"
    ServiceWorkerServiceWorkerVersionRunningStatus
ServiceWorkerServiceWorkerVersionRunningStatusStopping -> ServiceWorkerRegistrationID
"stopping"

-- | Type 'ServiceWorker.ServiceWorkerVersionStatus'.
data ServiceWorkerServiceWorkerVersionStatus = ServiceWorkerServiceWorkerVersionStatusNew | ServiceWorkerServiceWorkerVersionStatusInstalling | ServiceWorkerServiceWorkerVersionStatusInstalled | ServiceWorkerServiceWorkerVersionStatusActivating | ServiceWorkerServiceWorkerVersionStatusActivated | ServiceWorkerServiceWorkerVersionStatusRedundant
  deriving (Eq ServiceWorkerServiceWorkerVersionStatus
Eq ServiceWorkerServiceWorkerVersionStatus
-> (ServiceWorkerServiceWorkerVersionStatus
    -> ServiceWorkerServiceWorkerVersionStatus -> Ordering)
-> (ServiceWorkerServiceWorkerVersionStatus
    -> ServiceWorkerServiceWorkerVersionStatus -> Bool)
-> (ServiceWorkerServiceWorkerVersionStatus
    -> ServiceWorkerServiceWorkerVersionStatus -> Bool)
-> (ServiceWorkerServiceWorkerVersionStatus
    -> ServiceWorkerServiceWorkerVersionStatus -> Bool)
-> (ServiceWorkerServiceWorkerVersionStatus
    -> ServiceWorkerServiceWorkerVersionStatus -> Bool)
-> (ServiceWorkerServiceWorkerVersionStatus
    -> ServiceWorkerServiceWorkerVersionStatus
    -> ServiceWorkerServiceWorkerVersionStatus)
-> (ServiceWorkerServiceWorkerVersionStatus
    -> ServiceWorkerServiceWorkerVersionStatus
    -> ServiceWorkerServiceWorkerVersionStatus)
-> Ord ServiceWorkerServiceWorkerVersionStatus
ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Bool
ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Ordering
ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus
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 :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus
$cmin :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus
max :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus
$cmax :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus
>= :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Bool
$c>= :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Bool
> :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Bool
$c> :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Bool
<= :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Bool
$c<= :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Bool
< :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Bool
$c< :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Bool
compare :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Ordering
$ccompare :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Ordering
$cp1Ord :: Eq ServiceWorkerServiceWorkerVersionStatus
Ord, ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Bool
(ServiceWorkerServiceWorkerVersionStatus
 -> ServiceWorkerServiceWorkerVersionStatus -> Bool)
-> (ServiceWorkerServiceWorkerVersionStatus
    -> ServiceWorkerServiceWorkerVersionStatus -> Bool)
-> Eq ServiceWorkerServiceWorkerVersionStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Bool
$c/= :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Bool
== :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Bool
$c== :: ServiceWorkerServiceWorkerVersionStatus
-> ServiceWorkerServiceWorkerVersionStatus -> Bool
Eq, Int -> ServiceWorkerServiceWorkerVersionStatus -> ShowS
[ServiceWorkerServiceWorkerVersionStatus] -> ShowS
ServiceWorkerServiceWorkerVersionStatus -> String
(Int -> ServiceWorkerServiceWorkerVersionStatus -> ShowS)
-> (ServiceWorkerServiceWorkerVersionStatus -> String)
-> ([ServiceWorkerServiceWorkerVersionStatus] -> ShowS)
-> Show ServiceWorkerServiceWorkerVersionStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServiceWorkerServiceWorkerVersionStatus] -> ShowS
$cshowList :: [ServiceWorkerServiceWorkerVersionStatus] -> ShowS
show :: ServiceWorkerServiceWorkerVersionStatus -> String
$cshow :: ServiceWorkerServiceWorkerVersionStatus -> String
showsPrec :: Int -> ServiceWorkerServiceWorkerVersionStatus -> ShowS
$cshowsPrec :: Int -> ServiceWorkerServiceWorkerVersionStatus -> ShowS
Show, ReadPrec [ServiceWorkerServiceWorkerVersionStatus]
ReadPrec ServiceWorkerServiceWorkerVersionStatus
Int -> ReadS ServiceWorkerServiceWorkerVersionStatus
ReadS [ServiceWorkerServiceWorkerVersionStatus]
(Int -> ReadS ServiceWorkerServiceWorkerVersionStatus)
-> ReadS [ServiceWorkerServiceWorkerVersionStatus]
-> ReadPrec ServiceWorkerServiceWorkerVersionStatus
-> ReadPrec [ServiceWorkerServiceWorkerVersionStatus]
-> Read ServiceWorkerServiceWorkerVersionStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ServiceWorkerServiceWorkerVersionStatus]
$creadListPrec :: ReadPrec [ServiceWorkerServiceWorkerVersionStatus]
readPrec :: ReadPrec ServiceWorkerServiceWorkerVersionStatus
$creadPrec :: ReadPrec ServiceWorkerServiceWorkerVersionStatus
readList :: ReadS [ServiceWorkerServiceWorkerVersionStatus]
$creadList :: ReadS [ServiceWorkerServiceWorkerVersionStatus]
readsPrec :: Int -> ReadS ServiceWorkerServiceWorkerVersionStatus
$creadsPrec :: Int -> ReadS ServiceWorkerServiceWorkerVersionStatus
Read)
instance FromJSON ServiceWorkerServiceWorkerVersionStatus where
  parseJSON :: Value -> Parser ServiceWorkerServiceWorkerVersionStatus
parseJSON = String
-> (ServiceWorkerRegistrationID
    -> Parser ServiceWorkerServiceWorkerVersionStatus)
-> Value
-> Parser ServiceWorkerServiceWorkerVersionStatus
forall a.
String
-> (ServiceWorkerRegistrationID -> Parser a) -> Value -> Parser a
A.withText String
"ServiceWorkerServiceWorkerVersionStatus" ((ServiceWorkerRegistrationID
  -> Parser ServiceWorkerServiceWorkerVersionStatus)
 -> Value -> Parser ServiceWorkerServiceWorkerVersionStatus)
-> (ServiceWorkerRegistrationID
    -> Parser ServiceWorkerServiceWorkerVersionStatus)
-> Value
-> Parser ServiceWorkerServiceWorkerVersionStatus
forall a b. (a -> b) -> a -> b
$ \ServiceWorkerRegistrationID
v -> case ServiceWorkerRegistrationID
v of
    ServiceWorkerRegistrationID
"new" -> ServiceWorkerServiceWorkerVersionStatus
-> Parser ServiceWorkerServiceWorkerVersionStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServiceWorkerServiceWorkerVersionStatus
ServiceWorkerServiceWorkerVersionStatusNew
    ServiceWorkerRegistrationID
"installing" -> ServiceWorkerServiceWorkerVersionStatus
-> Parser ServiceWorkerServiceWorkerVersionStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServiceWorkerServiceWorkerVersionStatus
ServiceWorkerServiceWorkerVersionStatusInstalling
    ServiceWorkerRegistrationID
"installed" -> ServiceWorkerServiceWorkerVersionStatus
-> Parser ServiceWorkerServiceWorkerVersionStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServiceWorkerServiceWorkerVersionStatus
ServiceWorkerServiceWorkerVersionStatusInstalled
    ServiceWorkerRegistrationID
"activating" -> ServiceWorkerServiceWorkerVersionStatus
-> Parser ServiceWorkerServiceWorkerVersionStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServiceWorkerServiceWorkerVersionStatus
ServiceWorkerServiceWorkerVersionStatusActivating
    ServiceWorkerRegistrationID
"activated" -> ServiceWorkerServiceWorkerVersionStatus
-> Parser ServiceWorkerServiceWorkerVersionStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServiceWorkerServiceWorkerVersionStatus
ServiceWorkerServiceWorkerVersionStatusActivated
    ServiceWorkerRegistrationID
"redundant" -> ServiceWorkerServiceWorkerVersionStatus
-> Parser ServiceWorkerServiceWorkerVersionStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServiceWorkerServiceWorkerVersionStatus
ServiceWorkerServiceWorkerVersionStatusRedundant
    ServiceWorkerRegistrationID
"_" -> String -> Parser ServiceWorkerServiceWorkerVersionStatus
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse ServiceWorkerServiceWorkerVersionStatus"
instance ToJSON ServiceWorkerServiceWorkerVersionStatus where
  toJSON :: ServiceWorkerServiceWorkerVersionStatus -> Value
toJSON ServiceWorkerServiceWorkerVersionStatus
v = ServiceWorkerRegistrationID -> Value
A.String (ServiceWorkerRegistrationID -> Value)
-> ServiceWorkerRegistrationID -> Value
forall a b. (a -> b) -> a -> b
$ case ServiceWorkerServiceWorkerVersionStatus
v of
    ServiceWorkerServiceWorkerVersionStatus
ServiceWorkerServiceWorkerVersionStatusNew -> ServiceWorkerRegistrationID
"new"
    ServiceWorkerServiceWorkerVersionStatus
ServiceWorkerServiceWorkerVersionStatusInstalling -> ServiceWorkerRegistrationID
"installing"
    ServiceWorkerServiceWorkerVersionStatus
ServiceWorkerServiceWorkerVersionStatusInstalled -> ServiceWorkerRegistrationID
"installed"
    ServiceWorkerServiceWorkerVersionStatus
ServiceWorkerServiceWorkerVersionStatusActivating -> ServiceWorkerRegistrationID
"activating"
    ServiceWorkerServiceWorkerVersionStatus
ServiceWorkerServiceWorkerVersionStatusActivated -> ServiceWorkerRegistrationID
"activated"
    ServiceWorkerServiceWorkerVersionStatus
ServiceWorkerServiceWorkerVersionStatusRedundant -> ServiceWorkerRegistrationID
"redundant"

-- | Type 'ServiceWorker.ServiceWorkerVersion'.
--   ServiceWorker version.
data ServiceWorkerServiceWorkerVersion = ServiceWorkerServiceWorkerVersion
  {
    ServiceWorkerServiceWorkerVersion -> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerVersionVersionId :: T.Text,
    ServiceWorkerServiceWorkerVersion -> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerVersionRegistrationId :: ServiceWorkerRegistrationID,
    ServiceWorkerServiceWorkerVersion -> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerVersionScriptURL :: T.Text,
    ServiceWorkerServiceWorkerVersion
-> ServiceWorkerServiceWorkerVersionRunningStatus
serviceWorkerServiceWorkerVersionRunningStatus :: ServiceWorkerServiceWorkerVersionRunningStatus,
    ServiceWorkerServiceWorkerVersion
-> ServiceWorkerServiceWorkerVersionStatus
serviceWorkerServiceWorkerVersionStatus :: ServiceWorkerServiceWorkerVersionStatus,
    -- | The Last-Modified header value of the main script.
    ServiceWorkerServiceWorkerVersion -> Maybe Double
serviceWorkerServiceWorkerVersionScriptLastModified :: Maybe Double,
    -- | The time at which the response headers of the main script were received from the server.
    --   For cached script it is the last time the cache entry was validated.
    ServiceWorkerServiceWorkerVersion -> Maybe Double
serviceWorkerServiceWorkerVersionScriptResponseTime :: Maybe Double,
    ServiceWorkerServiceWorkerVersion
-> Maybe [ServiceWorkerRegistrationID]
serviceWorkerServiceWorkerVersionControlledClients :: Maybe [BrowserTarget.TargetTargetID],
    ServiceWorkerServiceWorkerVersion
-> Maybe ServiceWorkerRegistrationID
serviceWorkerServiceWorkerVersionTargetId :: Maybe BrowserTarget.TargetTargetID
  }
  deriving (ServiceWorkerServiceWorkerVersion
-> ServiceWorkerServiceWorkerVersion -> Bool
(ServiceWorkerServiceWorkerVersion
 -> ServiceWorkerServiceWorkerVersion -> Bool)
-> (ServiceWorkerServiceWorkerVersion
    -> ServiceWorkerServiceWorkerVersion -> Bool)
-> Eq ServiceWorkerServiceWorkerVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServiceWorkerServiceWorkerVersion
-> ServiceWorkerServiceWorkerVersion -> Bool
$c/= :: ServiceWorkerServiceWorkerVersion
-> ServiceWorkerServiceWorkerVersion -> Bool
== :: ServiceWorkerServiceWorkerVersion
-> ServiceWorkerServiceWorkerVersion -> Bool
$c== :: ServiceWorkerServiceWorkerVersion
-> ServiceWorkerServiceWorkerVersion -> Bool
Eq, Int -> ServiceWorkerServiceWorkerVersion -> ShowS
[ServiceWorkerServiceWorkerVersion] -> ShowS
ServiceWorkerServiceWorkerVersion -> String
(Int -> ServiceWorkerServiceWorkerVersion -> ShowS)
-> (ServiceWorkerServiceWorkerVersion -> String)
-> ([ServiceWorkerServiceWorkerVersion] -> ShowS)
-> Show ServiceWorkerServiceWorkerVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServiceWorkerServiceWorkerVersion] -> ShowS
$cshowList :: [ServiceWorkerServiceWorkerVersion] -> ShowS
show :: ServiceWorkerServiceWorkerVersion -> String
$cshow :: ServiceWorkerServiceWorkerVersion -> String
showsPrec :: Int -> ServiceWorkerServiceWorkerVersion -> ShowS
$cshowsPrec :: Int -> ServiceWorkerServiceWorkerVersion -> ShowS
Show)
instance FromJSON ServiceWorkerServiceWorkerVersion where
  parseJSON :: Value -> Parser ServiceWorkerServiceWorkerVersion
parseJSON = String
-> (Object -> Parser ServiceWorkerServiceWorkerVersion)
-> Value
-> Parser ServiceWorkerServiceWorkerVersion
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ServiceWorkerServiceWorkerVersion" ((Object -> Parser ServiceWorkerServiceWorkerVersion)
 -> Value -> Parser ServiceWorkerServiceWorkerVersion)
-> (Object -> Parser ServiceWorkerServiceWorkerVersion)
-> Value
-> Parser ServiceWorkerServiceWorkerVersion
forall a b. (a -> b) -> a -> b
$ \Object
o -> ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> ServiceWorkerServiceWorkerVersionRunningStatus
-> ServiceWorkerServiceWorkerVersionStatus
-> Maybe Double
-> Maybe Double
-> Maybe [ServiceWorkerRegistrationID]
-> Maybe ServiceWorkerRegistrationID
-> ServiceWorkerServiceWorkerVersion
ServiceWorkerServiceWorkerVersion
    (ServiceWorkerRegistrationID
 -> ServiceWorkerRegistrationID
 -> ServiceWorkerRegistrationID
 -> ServiceWorkerServiceWorkerVersionRunningStatus
 -> ServiceWorkerServiceWorkerVersionStatus
 -> Maybe Double
 -> Maybe Double
 -> Maybe [ServiceWorkerRegistrationID]
 -> Maybe ServiceWorkerRegistrationID
 -> ServiceWorkerServiceWorkerVersion)
-> Parser ServiceWorkerRegistrationID
-> Parser
     (ServiceWorkerRegistrationID
      -> ServiceWorkerRegistrationID
      -> ServiceWorkerServiceWorkerVersionRunningStatus
      -> ServiceWorkerServiceWorkerVersionStatus
      -> Maybe Double
      -> Maybe Double
      -> Maybe [ServiceWorkerRegistrationID]
      -> Maybe ServiceWorkerRegistrationID
      -> ServiceWorkerServiceWorkerVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object
-> ServiceWorkerRegistrationID
-> Parser ServiceWorkerRegistrationID
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser a
A..: ServiceWorkerRegistrationID
"versionId"
    Parser
  (ServiceWorkerRegistrationID
   -> ServiceWorkerRegistrationID
   -> ServiceWorkerServiceWorkerVersionRunningStatus
   -> ServiceWorkerServiceWorkerVersionStatus
   -> Maybe Double
   -> Maybe Double
   -> Maybe [ServiceWorkerRegistrationID]
   -> Maybe ServiceWorkerRegistrationID
   -> ServiceWorkerServiceWorkerVersion)
-> Parser ServiceWorkerRegistrationID
-> Parser
     (ServiceWorkerRegistrationID
      -> ServiceWorkerServiceWorkerVersionRunningStatus
      -> ServiceWorkerServiceWorkerVersionStatus
      -> Maybe Double
      -> Maybe Double
      -> Maybe [ServiceWorkerRegistrationID]
      -> Maybe ServiceWorkerRegistrationID
      -> ServiceWorkerServiceWorkerVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> ServiceWorkerRegistrationID
-> Parser ServiceWorkerRegistrationID
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser a
A..: ServiceWorkerRegistrationID
"registrationId"
    Parser
  (ServiceWorkerRegistrationID
   -> ServiceWorkerServiceWorkerVersionRunningStatus
   -> ServiceWorkerServiceWorkerVersionStatus
   -> Maybe Double
   -> Maybe Double
   -> Maybe [ServiceWorkerRegistrationID]
   -> Maybe ServiceWorkerRegistrationID
   -> ServiceWorkerServiceWorkerVersion)
-> Parser ServiceWorkerRegistrationID
-> Parser
     (ServiceWorkerServiceWorkerVersionRunningStatus
      -> ServiceWorkerServiceWorkerVersionStatus
      -> Maybe Double
      -> Maybe Double
      -> Maybe [ServiceWorkerRegistrationID]
      -> Maybe ServiceWorkerRegistrationID
      -> ServiceWorkerServiceWorkerVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> ServiceWorkerRegistrationID
-> Parser ServiceWorkerRegistrationID
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser a
A..: ServiceWorkerRegistrationID
"scriptURL"
    Parser
  (ServiceWorkerServiceWorkerVersionRunningStatus
   -> ServiceWorkerServiceWorkerVersionStatus
   -> Maybe Double
   -> Maybe Double
   -> Maybe [ServiceWorkerRegistrationID]
   -> Maybe ServiceWorkerRegistrationID
   -> ServiceWorkerServiceWorkerVersion)
-> Parser ServiceWorkerServiceWorkerVersionRunningStatus
-> Parser
     (ServiceWorkerServiceWorkerVersionStatus
      -> Maybe Double
      -> Maybe Double
      -> Maybe [ServiceWorkerRegistrationID]
      -> Maybe ServiceWorkerRegistrationID
      -> ServiceWorkerServiceWorkerVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> ServiceWorkerRegistrationID
-> Parser ServiceWorkerServiceWorkerVersionRunningStatus
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser a
A..: ServiceWorkerRegistrationID
"runningStatus"
    Parser
  (ServiceWorkerServiceWorkerVersionStatus
   -> Maybe Double
   -> Maybe Double
   -> Maybe [ServiceWorkerRegistrationID]
   -> Maybe ServiceWorkerRegistrationID
   -> ServiceWorkerServiceWorkerVersion)
-> Parser ServiceWorkerServiceWorkerVersionStatus
-> Parser
     (Maybe Double
      -> Maybe Double
      -> Maybe [ServiceWorkerRegistrationID]
      -> Maybe ServiceWorkerRegistrationID
      -> ServiceWorkerServiceWorkerVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> ServiceWorkerRegistrationID
-> Parser ServiceWorkerServiceWorkerVersionStatus
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser a
A..: ServiceWorkerRegistrationID
"status"
    Parser
  (Maybe Double
   -> Maybe Double
   -> Maybe [ServiceWorkerRegistrationID]
   -> Maybe ServiceWorkerRegistrationID
   -> ServiceWorkerServiceWorkerVersion)
-> Parser (Maybe Double)
-> Parser
     (Maybe Double
      -> Maybe [ServiceWorkerRegistrationID]
      -> Maybe ServiceWorkerRegistrationID
      -> ServiceWorkerServiceWorkerVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> ServiceWorkerRegistrationID -> Parser (Maybe Double)
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser (Maybe a)
A..:? ServiceWorkerRegistrationID
"scriptLastModified"
    Parser
  (Maybe Double
   -> Maybe [ServiceWorkerRegistrationID]
   -> Maybe ServiceWorkerRegistrationID
   -> ServiceWorkerServiceWorkerVersion)
-> Parser (Maybe Double)
-> Parser
     (Maybe [ServiceWorkerRegistrationID]
      -> Maybe ServiceWorkerRegistrationID
      -> ServiceWorkerServiceWorkerVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> ServiceWorkerRegistrationID -> Parser (Maybe Double)
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser (Maybe a)
A..:? ServiceWorkerRegistrationID
"scriptResponseTime"
    Parser
  (Maybe [ServiceWorkerRegistrationID]
   -> Maybe ServiceWorkerRegistrationID
   -> ServiceWorkerServiceWorkerVersion)
-> Parser (Maybe [ServiceWorkerRegistrationID])
-> Parser
     (Maybe ServiceWorkerRegistrationID
      -> ServiceWorkerServiceWorkerVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> ServiceWorkerRegistrationID
-> Parser (Maybe [ServiceWorkerRegistrationID])
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser (Maybe a)
A..:? ServiceWorkerRegistrationID
"controlledClients"
    Parser
  (Maybe ServiceWorkerRegistrationID
   -> ServiceWorkerServiceWorkerVersion)
-> Parser (Maybe ServiceWorkerRegistrationID)
-> Parser ServiceWorkerServiceWorkerVersion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> ServiceWorkerRegistrationID
-> Parser (Maybe ServiceWorkerRegistrationID)
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser (Maybe a)
A..:? ServiceWorkerRegistrationID
"targetId"
instance ToJSON ServiceWorkerServiceWorkerVersion where
  toJSON :: ServiceWorkerServiceWorkerVersion -> Value
toJSON ServiceWorkerServiceWorkerVersion
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 [
    (ServiceWorkerRegistrationID
"versionId" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (ServiceWorkerServiceWorkerVersion -> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerVersionVersionId ServiceWorkerServiceWorkerVersion
p),
    (ServiceWorkerRegistrationID
"registrationId" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (ServiceWorkerServiceWorkerVersion -> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerVersionRegistrationId ServiceWorkerServiceWorkerVersion
p),
    (ServiceWorkerRegistrationID
"scriptURL" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (ServiceWorkerServiceWorkerVersion -> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerVersionScriptURL ServiceWorkerServiceWorkerVersion
p),
    (ServiceWorkerRegistrationID
"runningStatus" ServiceWorkerRegistrationID
-> ServiceWorkerServiceWorkerVersionRunningStatus -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerServiceWorkerVersionRunningStatus -> Pair)
-> Maybe ServiceWorkerServiceWorkerVersionRunningStatus
-> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerServiceWorkerVersionRunningStatus
-> Maybe ServiceWorkerServiceWorkerVersionRunningStatus
forall a. a -> Maybe a
Just (ServiceWorkerServiceWorkerVersion
-> ServiceWorkerServiceWorkerVersionRunningStatus
serviceWorkerServiceWorkerVersionRunningStatus ServiceWorkerServiceWorkerVersion
p),
    (ServiceWorkerRegistrationID
"status" ServiceWorkerRegistrationID
-> ServiceWorkerServiceWorkerVersionStatus -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerServiceWorkerVersionStatus -> Pair)
-> Maybe ServiceWorkerServiceWorkerVersionStatus -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerServiceWorkerVersionStatus
-> Maybe ServiceWorkerServiceWorkerVersionStatus
forall a. a -> Maybe a
Just (ServiceWorkerServiceWorkerVersion
-> ServiceWorkerServiceWorkerVersionStatus
serviceWorkerServiceWorkerVersionStatus ServiceWorkerServiceWorkerVersion
p),
    (ServiceWorkerRegistrationID
"scriptLastModified" ServiceWorkerRegistrationID -> Double -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ServiceWorkerServiceWorkerVersion -> Maybe Double
serviceWorkerServiceWorkerVersionScriptLastModified ServiceWorkerServiceWorkerVersion
p),
    (ServiceWorkerRegistrationID
"scriptResponseTime" ServiceWorkerRegistrationID -> Double -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ServiceWorkerServiceWorkerVersion -> Maybe Double
serviceWorkerServiceWorkerVersionScriptResponseTime ServiceWorkerServiceWorkerVersion
p),
    (ServiceWorkerRegistrationID
"controlledClients" ServiceWorkerRegistrationID
-> [ServiceWorkerRegistrationID] -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) ([ServiceWorkerRegistrationID] -> Pair)
-> Maybe [ServiceWorkerRegistrationID] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ServiceWorkerServiceWorkerVersion
-> Maybe [ServiceWorkerRegistrationID]
serviceWorkerServiceWorkerVersionControlledClients ServiceWorkerServiceWorkerVersion
p),
    (ServiceWorkerRegistrationID
"targetId" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ServiceWorkerServiceWorkerVersion
-> Maybe ServiceWorkerRegistrationID
serviceWorkerServiceWorkerVersionTargetId ServiceWorkerServiceWorkerVersion
p)
    ]

-- | Type 'ServiceWorker.ServiceWorkerErrorMessage'.
--   ServiceWorker error message.
data ServiceWorkerServiceWorkerErrorMessage = ServiceWorkerServiceWorkerErrorMessage
  {
    ServiceWorkerServiceWorkerErrorMessage
-> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerErrorMessageErrorMessage :: T.Text,
    ServiceWorkerServiceWorkerErrorMessage
-> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerErrorMessageRegistrationId :: ServiceWorkerRegistrationID,
    ServiceWorkerServiceWorkerErrorMessage
-> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerErrorMessageVersionId :: T.Text,
    ServiceWorkerServiceWorkerErrorMessage
-> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerErrorMessageSourceURL :: T.Text,
    ServiceWorkerServiceWorkerErrorMessage -> Int
serviceWorkerServiceWorkerErrorMessageLineNumber :: Int,
    ServiceWorkerServiceWorkerErrorMessage -> Int
serviceWorkerServiceWorkerErrorMessageColumnNumber :: Int
  }
  deriving (ServiceWorkerServiceWorkerErrorMessage
-> ServiceWorkerServiceWorkerErrorMessage -> Bool
(ServiceWorkerServiceWorkerErrorMessage
 -> ServiceWorkerServiceWorkerErrorMessage -> Bool)
-> (ServiceWorkerServiceWorkerErrorMessage
    -> ServiceWorkerServiceWorkerErrorMessage -> Bool)
-> Eq ServiceWorkerServiceWorkerErrorMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServiceWorkerServiceWorkerErrorMessage
-> ServiceWorkerServiceWorkerErrorMessage -> Bool
$c/= :: ServiceWorkerServiceWorkerErrorMessage
-> ServiceWorkerServiceWorkerErrorMessage -> Bool
== :: ServiceWorkerServiceWorkerErrorMessage
-> ServiceWorkerServiceWorkerErrorMessage -> Bool
$c== :: ServiceWorkerServiceWorkerErrorMessage
-> ServiceWorkerServiceWorkerErrorMessage -> Bool
Eq, Int -> ServiceWorkerServiceWorkerErrorMessage -> ShowS
[ServiceWorkerServiceWorkerErrorMessage] -> ShowS
ServiceWorkerServiceWorkerErrorMessage -> String
(Int -> ServiceWorkerServiceWorkerErrorMessage -> ShowS)
-> (ServiceWorkerServiceWorkerErrorMessage -> String)
-> ([ServiceWorkerServiceWorkerErrorMessage] -> ShowS)
-> Show ServiceWorkerServiceWorkerErrorMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServiceWorkerServiceWorkerErrorMessage] -> ShowS
$cshowList :: [ServiceWorkerServiceWorkerErrorMessage] -> ShowS
show :: ServiceWorkerServiceWorkerErrorMessage -> String
$cshow :: ServiceWorkerServiceWorkerErrorMessage -> String
showsPrec :: Int -> ServiceWorkerServiceWorkerErrorMessage -> ShowS
$cshowsPrec :: Int -> ServiceWorkerServiceWorkerErrorMessage -> ShowS
Show)
instance FromJSON ServiceWorkerServiceWorkerErrorMessage where
  parseJSON :: Value -> Parser ServiceWorkerServiceWorkerErrorMessage
parseJSON = String
-> (Object -> Parser ServiceWorkerServiceWorkerErrorMessage)
-> Value
-> Parser ServiceWorkerServiceWorkerErrorMessage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ServiceWorkerServiceWorkerErrorMessage" ((Object -> Parser ServiceWorkerServiceWorkerErrorMessage)
 -> Value -> Parser ServiceWorkerServiceWorkerErrorMessage)
-> (Object -> Parser ServiceWorkerServiceWorkerErrorMessage)
-> Value
-> Parser ServiceWorkerServiceWorkerErrorMessage
forall a b. (a -> b) -> a -> b
$ \Object
o -> ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> Int
-> Int
-> ServiceWorkerServiceWorkerErrorMessage
ServiceWorkerServiceWorkerErrorMessage
    (ServiceWorkerRegistrationID
 -> ServiceWorkerRegistrationID
 -> ServiceWorkerRegistrationID
 -> ServiceWorkerRegistrationID
 -> Int
 -> Int
 -> ServiceWorkerServiceWorkerErrorMessage)
-> Parser ServiceWorkerRegistrationID
-> Parser
     (ServiceWorkerRegistrationID
      -> ServiceWorkerRegistrationID
      -> ServiceWorkerRegistrationID
      -> Int
      -> Int
      -> ServiceWorkerServiceWorkerErrorMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object
-> ServiceWorkerRegistrationID
-> Parser ServiceWorkerRegistrationID
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser a
A..: ServiceWorkerRegistrationID
"errorMessage"
    Parser
  (ServiceWorkerRegistrationID
   -> ServiceWorkerRegistrationID
   -> ServiceWorkerRegistrationID
   -> Int
   -> Int
   -> ServiceWorkerServiceWorkerErrorMessage)
-> Parser ServiceWorkerRegistrationID
-> Parser
     (ServiceWorkerRegistrationID
      -> ServiceWorkerRegistrationID
      -> Int
      -> Int
      -> ServiceWorkerServiceWorkerErrorMessage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> ServiceWorkerRegistrationID
-> Parser ServiceWorkerRegistrationID
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser a
A..: ServiceWorkerRegistrationID
"registrationId"
    Parser
  (ServiceWorkerRegistrationID
   -> ServiceWorkerRegistrationID
   -> Int
   -> Int
   -> ServiceWorkerServiceWorkerErrorMessage)
-> Parser ServiceWorkerRegistrationID
-> Parser
     (ServiceWorkerRegistrationID
      -> Int -> Int -> ServiceWorkerServiceWorkerErrorMessage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> ServiceWorkerRegistrationID
-> Parser ServiceWorkerRegistrationID
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser a
A..: ServiceWorkerRegistrationID
"versionId"
    Parser
  (ServiceWorkerRegistrationID
   -> Int -> Int -> ServiceWorkerServiceWorkerErrorMessage)
-> Parser ServiceWorkerRegistrationID
-> Parser (Int -> Int -> ServiceWorkerServiceWorkerErrorMessage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> ServiceWorkerRegistrationID
-> Parser ServiceWorkerRegistrationID
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser a
A..: ServiceWorkerRegistrationID
"sourceURL"
    Parser (Int -> Int -> ServiceWorkerServiceWorkerErrorMessage)
-> Parser Int
-> Parser (Int -> ServiceWorkerServiceWorkerErrorMessage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> ServiceWorkerRegistrationID -> Parser Int
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser a
A..: ServiceWorkerRegistrationID
"lineNumber"
    Parser (Int -> ServiceWorkerServiceWorkerErrorMessage)
-> Parser Int -> Parser ServiceWorkerServiceWorkerErrorMessage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> ServiceWorkerRegistrationID -> Parser Int
forall a.
FromJSON a =>
Object -> ServiceWorkerRegistrationID -> Parser a
A..: ServiceWorkerRegistrationID
"columnNumber"
instance ToJSON ServiceWorkerServiceWorkerErrorMessage where
  toJSON :: ServiceWorkerServiceWorkerErrorMessage -> Value
toJSON ServiceWorkerServiceWorkerErrorMessage
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 [
    (ServiceWorkerRegistrationID
"errorMessage" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (ServiceWorkerServiceWorkerErrorMessage
-> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerErrorMessageErrorMessage ServiceWorkerServiceWorkerErrorMessage
p),
    (ServiceWorkerRegistrationID
"registrationId" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (ServiceWorkerServiceWorkerErrorMessage
-> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerErrorMessageRegistrationId ServiceWorkerServiceWorkerErrorMessage
p),
    (ServiceWorkerRegistrationID
"versionId" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (ServiceWorkerServiceWorkerErrorMessage
-> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerErrorMessageVersionId ServiceWorkerServiceWorkerErrorMessage
p),
    (ServiceWorkerRegistrationID
"sourceURL" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (ServiceWorkerServiceWorkerErrorMessage
-> ServiceWorkerRegistrationID
serviceWorkerServiceWorkerErrorMessageSourceURL ServiceWorkerServiceWorkerErrorMessage
p),
    (ServiceWorkerRegistrationID
"lineNumber" ServiceWorkerRegistrationID -> Int -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> 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 (ServiceWorkerServiceWorkerErrorMessage -> Int
serviceWorkerServiceWorkerErrorMessageLineNumber ServiceWorkerServiceWorkerErrorMessage
p),
    (ServiceWorkerRegistrationID
"columnNumber" ServiceWorkerRegistrationID -> Int -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> 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 (ServiceWorkerServiceWorkerErrorMessage -> Int
serviceWorkerServiceWorkerErrorMessageColumnNumber ServiceWorkerServiceWorkerErrorMessage
p)
    ]

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

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

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


-- | Parameters of the 'ServiceWorker.deliverPushMessage' command.
data PServiceWorkerDeliverPushMessage = PServiceWorkerDeliverPushMessage
  {
    PServiceWorkerDeliverPushMessage -> ServiceWorkerRegistrationID
pServiceWorkerDeliverPushMessageOrigin :: T.Text,
    PServiceWorkerDeliverPushMessage -> ServiceWorkerRegistrationID
pServiceWorkerDeliverPushMessageRegistrationId :: ServiceWorkerRegistrationID,
    PServiceWorkerDeliverPushMessage -> ServiceWorkerRegistrationID
pServiceWorkerDeliverPushMessageData :: T.Text
  }
  deriving (PServiceWorkerDeliverPushMessage
-> PServiceWorkerDeliverPushMessage -> Bool
(PServiceWorkerDeliverPushMessage
 -> PServiceWorkerDeliverPushMessage -> Bool)
-> (PServiceWorkerDeliverPushMessage
    -> PServiceWorkerDeliverPushMessage -> Bool)
-> Eq PServiceWorkerDeliverPushMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PServiceWorkerDeliverPushMessage
-> PServiceWorkerDeliverPushMessage -> Bool
$c/= :: PServiceWorkerDeliverPushMessage
-> PServiceWorkerDeliverPushMessage -> Bool
== :: PServiceWorkerDeliverPushMessage
-> PServiceWorkerDeliverPushMessage -> Bool
$c== :: PServiceWorkerDeliverPushMessage
-> PServiceWorkerDeliverPushMessage -> Bool
Eq, Int -> PServiceWorkerDeliverPushMessage -> ShowS
[PServiceWorkerDeliverPushMessage] -> ShowS
PServiceWorkerDeliverPushMessage -> String
(Int -> PServiceWorkerDeliverPushMessage -> ShowS)
-> (PServiceWorkerDeliverPushMessage -> String)
-> ([PServiceWorkerDeliverPushMessage] -> ShowS)
-> Show PServiceWorkerDeliverPushMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PServiceWorkerDeliverPushMessage] -> ShowS
$cshowList :: [PServiceWorkerDeliverPushMessage] -> ShowS
show :: PServiceWorkerDeliverPushMessage -> String
$cshow :: PServiceWorkerDeliverPushMessage -> String
showsPrec :: Int -> PServiceWorkerDeliverPushMessage -> ShowS
$cshowsPrec :: Int -> PServiceWorkerDeliverPushMessage -> ShowS
Show)
pServiceWorkerDeliverPushMessage
  :: T.Text
  -> ServiceWorkerRegistrationID
  -> T.Text
  -> PServiceWorkerDeliverPushMessage
pServiceWorkerDeliverPushMessage :: ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> PServiceWorkerDeliverPushMessage
pServiceWorkerDeliverPushMessage
  ServiceWorkerRegistrationID
arg_pServiceWorkerDeliverPushMessageOrigin
  ServiceWorkerRegistrationID
arg_pServiceWorkerDeliverPushMessageRegistrationId
  ServiceWorkerRegistrationID
arg_pServiceWorkerDeliverPushMessageData
  = ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> PServiceWorkerDeliverPushMessage
PServiceWorkerDeliverPushMessage
    ServiceWorkerRegistrationID
arg_pServiceWorkerDeliverPushMessageOrigin
    ServiceWorkerRegistrationID
arg_pServiceWorkerDeliverPushMessageRegistrationId
    ServiceWorkerRegistrationID
arg_pServiceWorkerDeliverPushMessageData
instance ToJSON PServiceWorkerDeliverPushMessage where
  toJSON :: PServiceWorkerDeliverPushMessage -> Value
toJSON PServiceWorkerDeliverPushMessage
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 [
    (ServiceWorkerRegistrationID
"origin" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (PServiceWorkerDeliverPushMessage -> ServiceWorkerRegistrationID
pServiceWorkerDeliverPushMessageOrigin PServiceWorkerDeliverPushMessage
p),
    (ServiceWorkerRegistrationID
"registrationId" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (PServiceWorkerDeliverPushMessage -> ServiceWorkerRegistrationID
pServiceWorkerDeliverPushMessageRegistrationId PServiceWorkerDeliverPushMessage
p),
    (ServiceWorkerRegistrationID
"data" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (PServiceWorkerDeliverPushMessage -> ServiceWorkerRegistrationID
pServiceWorkerDeliverPushMessageData PServiceWorkerDeliverPushMessage
p)
    ]
instance Command PServiceWorkerDeliverPushMessage where
  type CommandResponse PServiceWorkerDeliverPushMessage = ()
  commandName :: Proxy PServiceWorkerDeliverPushMessage -> String
commandName Proxy PServiceWorkerDeliverPushMessage
_ = String
"ServiceWorker.deliverPushMessage"
  fromJSON :: Proxy PServiceWorkerDeliverPushMessage
-> Value
-> Result (CommandResponse PServiceWorkerDeliverPushMessage)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PServiceWorkerDeliverPushMessage -> Result ())
-> Proxy PServiceWorkerDeliverPushMessage
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PServiceWorkerDeliverPushMessage -> ())
-> Proxy PServiceWorkerDeliverPushMessage
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PServiceWorkerDeliverPushMessage -> ()
forall a b. a -> b -> a
const ()


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


-- | Parameters of the 'ServiceWorker.dispatchSyncEvent' command.
data PServiceWorkerDispatchSyncEvent = PServiceWorkerDispatchSyncEvent
  {
    PServiceWorkerDispatchSyncEvent -> ServiceWorkerRegistrationID
pServiceWorkerDispatchSyncEventOrigin :: T.Text,
    PServiceWorkerDispatchSyncEvent -> ServiceWorkerRegistrationID
pServiceWorkerDispatchSyncEventRegistrationId :: ServiceWorkerRegistrationID,
    PServiceWorkerDispatchSyncEvent -> ServiceWorkerRegistrationID
pServiceWorkerDispatchSyncEventTag :: T.Text,
    PServiceWorkerDispatchSyncEvent -> Bool
pServiceWorkerDispatchSyncEventLastChance :: Bool
  }
  deriving (PServiceWorkerDispatchSyncEvent
-> PServiceWorkerDispatchSyncEvent -> Bool
(PServiceWorkerDispatchSyncEvent
 -> PServiceWorkerDispatchSyncEvent -> Bool)
-> (PServiceWorkerDispatchSyncEvent
    -> PServiceWorkerDispatchSyncEvent -> Bool)
-> Eq PServiceWorkerDispatchSyncEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PServiceWorkerDispatchSyncEvent
-> PServiceWorkerDispatchSyncEvent -> Bool
$c/= :: PServiceWorkerDispatchSyncEvent
-> PServiceWorkerDispatchSyncEvent -> Bool
== :: PServiceWorkerDispatchSyncEvent
-> PServiceWorkerDispatchSyncEvent -> Bool
$c== :: PServiceWorkerDispatchSyncEvent
-> PServiceWorkerDispatchSyncEvent -> Bool
Eq, Int -> PServiceWorkerDispatchSyncEvent -> ShowS
[PServiceWorkerDispatchSyncEvent] -> ShowS
PServiceWorkerDispatchSyncEvent -> String
(Int -> PServiceWorkerDispatchSyncEvent -> ShowS)
-> (PServiceWorkerDispatchSyncEvent -> String)
-> ([PServiceWorkerDispatchSyncEvent] -> ShowS)
-> Show PServiceWorkerDispatchSyncEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PServiceWorkerDispatchSyncEvent] -> ShowS
$cshowList :: [PServiceWorkerDispatchSyncEvent] -> ShowS
show :: PServiceWorkerDispatchSyncEvent -> String
$cshow :: PServiceWorkerDispatchSyncEvent -> String
showsPrec :: Int -> PServiceWorkerDispatchSyncEvent -> ShowS
$cshowsPrec :: Int -> PServiceWorkerDispatchSyncEvent -> ShowS
Show)
pServiceWorkerDispatchSyncEvent
  :: T.Text
  -> ServiceWorkerRegistrationID
  -> T.Text
  -> Bool
  -> PServiceWorkerDispatchSyncEvent
pServiceWorkerDispatchSyncEvent :: ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> Bool
-> PServiceWorkerDispatchSyncEvent
pServiceWorkerDispatchSyncEvent
  ServiceWorkerRegistrationID
arg_pServiceWorkerDispatchSyncEventOrigin
  ServiceWorkerRegistrationID
arg_pServiceWorkerDispatchSyncEventRegistrationId
  ServiceWorkerRegistrationID
arg_pServiceWorkerDispatchSyncEventTag
  Bool
arg_pServiceWorkerDispatchSyncEventLastChance
  = ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> Bool
-> PServiceWorkerDispatchSyncEvent
PServiceWorkerDispatchSyncEvent
    ServiceWorkerRegistrationID
arg_pServiceWorkerDispatchSyncEventOrigin
    ServiceWorkerRegistrationID
arg_pServiceWorkerDispatchSyncEventRegistrationId
    ServiceWorkerRegistrationID
arg_pServiceWorkerDispatchSyncEventTag
    Bool
arg_pServiceWorkerDispatchSyncEventLastChance
instance ToJSON PServiceWorkerDispatchSyncEvent where
  toJSON :: PServiceWorkerDispatchSyncEvent -> Value
toJSON PServiceWorkerDispatchSyncEvent
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 [
    (ServiceWorkerRegistrationID
"origin" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (PServiceWorkerDispatchSyncEvent -> ServiceWorkerRegistrationID
pServiceWorkerDispatchSyncEventOrigin PServiceWorkerDispatchSyncEvent
p),
    (ServiceWorkerRegistrationID
"registrationId" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (PServiceWorkerDispatchSyncEvent -> ServiceWorkerRegistrationID
pServiceWorkerDispatchSyncEventRegistrationId PServiceWorkerDispatchSyncEvent
p),
    (ServiceWorkerRegistrationID
"tag" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (PServiceWorkerDispatchSyncEvent -> ServiceWorkerRegistrationID
pServiceWorkerDispatchSyncEventTag PServiceWorkerDispatchSyncEvent
p),
    (ServiceWorkerRegistrationID
"lastChance" ServiceWorkerRegistrationID -> Bool -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> 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 (PServiceWorkerDispatchSyncEvent -> Bool
pServiceWorkerDispatchSyncEventLastChance PServiceWorkerDispatchSyncEvent
p)
    ]
instance Command PServiceWorkerDispatchSyncEvent where
  type CommandResponse PServiceWorkerDispatchSyncEvent = ()
  commandName :: Proxy PServiceWorkerDispatchSyncEvent -> String
commandName Proxy PServiceWorkerDispatchSyncEvent
_ = String
"ServiceWorker.dispatchSyncEvent"
  fromJSON :: Proxy PServiceWorkerDispatchSyncEvent
-> Value
-> Result (CommandResponse PServiceWorkerDispatchSyncEvent)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PServiceWorkerDispatchSyncEvent -> Result ())
-> Proxy PServiceWorkerDispatchSyncEvent
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PServiceWorkerDispatchSyncEvent -> ())
-> Proxy PServiceWorkerDispatchSyncEvent
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PServiceWorkerDispatchSyncEvent -> ()
forall a b. a -> b -> a
const ()


-- | Parameters of the 'ServiceWorker.dispatchPeriodicSyncEvent' command.
data PServiceWorkerDispatchPeriodicSyncEvent = PServiceWorkerDispatchPeriodicSyncEvent
  {
    PServiceWorkerDispatchPeriodicSyncEvent
-> ServiceWorkerRegistrationID
pServiceWorkerDispatchPeriodicSyncEventOrigin :: T.Text,
    PServiceWorkerDispatchPeriodicSyncEvent
-> ServiceWorkerRegistrationID
pServiceWorkerDispatchPeriodicSyncEventRegistrationId :: ServiceWorkerRegistrationID,
    PServiceWorkerDispatchPeriodicSyncEvent
-> ServiceWorkerRegistrationID
pServiceWorkerDispatchPeriodicSyncEventTag :: T.Text
  }
  deriving (PServiceWorkerDispatchPeriodicSyncEvent
-> PServiceWorkerDispatchPeriodicSyncEvent -> Bool
(PServiceWorkerDispatchPeriodicSyncEvent
 -> PServiceWorkerDispatchPeriodicSyncEvent -> Bool)
-> (PServiceWorkerDispatchPeriodicSyncEvent
    -> PServiceWorkerDispatchPeriodicSyncEvent -> Bool)
-> Eq PServiceWorkerDispatchPeriodicSyncEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PServiceWorkerDispatchPeriodicSyncEvent
-> PServiceWorkerDispatchPeriodicSyncEvent -> Bool
$c/= :: PServiceWorkerDispatchPeriodicSyncEvent
-> PServiceWorkerDispatchPeriodicSyncEvent -> Bool
== :: PServiceWorkerDispatchPeriodicSyncEvent
-> PServiceWorkerDispatchPeriodicSyncEvent -> Bool
$c== :: PServiceWorkerDispatchPeriodicSyncEvent
-> PServiceWorkerDispatchPeriodicSyncEvent -> Bool
Eq, Int -> PServiceWorkerDispatchPeriodicSyncEvent -> ShowS
[PServiceWorkerDispatchPeriodicSyncEvent] -> ShowS
PServiceWorkerDispatchPeriodicSyncEvent -> String
(Int -> PServiceWorkerDispatchPeriodicSyncEvent -> ShowS)
-> (PServiceWorkerDispatchPeriodicSyncEvent -> String)
-> ([PServiceWorkerDispatchPeriodicSyncEvent] -> ShowS)
-> Show PServiceWorkerDispatchPeriodicSyncEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PServiceWorkerDispatchPeriodicSyncEvent] -> ShowS
$cshowList :: [PServiceWorkerDispatchPeriodicSyncEvent] -> ShowS
show :: PServiceWorkerDispatchPeriodicSyncEvent -> String
$cshow :: PServiceWorkerDispatchPeriodicSyncEvent -> String
showsPrec :: Int -> PServiceWorkerDispatchPeriodicSyncEvent -> ShowS
$cshowsPrec :: Int -> PServiceWorkerDispatchPeriodicSyncEvent -> ShowS
Show)
pServiceWorkerDispatchPeriodicSyncEvent
  :: T.Text
  -> ServiceWorkerRegistrationID
  -> T.Text
  -> PServiceWorkerDispatchPeriodicSyncEvent
pServiceWorkerDispatchPeriodicSyncEvent :: ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> PServiceWorkerDispatchPeriodicSyncEvent
pServiceWorkerDispatchPeriodicSyncEvent
  ServiceWorkerRegistrationID
arg_pServiceWorkerDispatchPeriodicSyncEventOrigin
  ServiceWorkerRegistrationID
arg_pServiceWorkerDispatchPeriodicSyncEventRegistrationId
  ServiceWorkerRegistrationID
arg_pServiceWorkerDispatchPeriodicSyncEventTag
  = ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> ServiceWorkerRegistrationID
-> PServiceWorkerDispatchPeriodicSyncEvent
PServiceWorkerDispatchPeriodicSyncEvent
    ServiceWorkerRegistrationID
arg_pServiceWorkerDispatchPeriodicSyncEventOrigin
    ServiceWorkerRegistrationID
arg_pServiceWorkerDispatchPeriodicSyncEventRegistrationId
    ServiceWorkerRegistrationID
arg_pServiceWorkerDispatchPeriodicSyncEventTag
instance ToJSON PServiceWorkerDispatchPeriodicSyncEvent where
  toJSON :: PServiceWorkerDispatchPeriodicSyncEvent -> Value
toJSON PServiceWorkerDispatchPeriodicSyncEvent
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 [
    (ServiceWorkerRegistrationID
"origin" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (PServiceWorkerDispatchPeriodicSyncEvent
-> ServiceWorkerRegistrationID
pServiceWorkerDispatchPeriodicSyncEventOrigin PServiceWorkerDispatchPeriodicSyncEvent
p),
    (ServiceWorkerRegistrationID
"registrationId" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (PServiceWorkerDispatchPeriodicSyncEvent
-> ServiceWorkerRegistrationID
pServiceWorkerDispatchPeriodicSyncEventRegistrationId PServiceWorkerDispatchPeriodicSyncEvent
p),
    (ServiceWorkerRegistrationID
"tag" ServiceWorkerRegistrationID -> ServiceWorkerRegistrationID -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> v -> kv
A..=) (ServiceWorkerRegistrationID -> Pair)
-> Maybe ServiceWorkerRegistrationID -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceWorkerRegistrationID -> Maybe ServiceWorkerRegistrationID
forall a. a -> Maybe a
Just (PServiceWorkerDispatchPeriodicSyncEvent
-> ServiceWorkerRegistrationID
pServiceWorkerDispatchPeriodicSyncEventTag PServiceWorkerDispatchPeriodicSyncEvent
p)
    ]
instance Command PServiceWorkerDispatchPeriodicSyncEvent where
  type CommandResponse PServiceWorkerDispatchPeriodicSyncEvent = ()
  commandName :: Proxy PServiceWorkerDispatchPeriodicSyncEvent -> String
commandName Proxy PServiceWorkerDispatchPeriodicSyncEvent
_ = String
"ServiceWorker.dispatchPeriodicSyncEvent"
  fromJSON :: Proxy PServiceWorkerDispatchPeriodicSyncEvent
-> Value
-> Result (CommandResponse PServiceWorkerDispatchPeriodicSyncEvent)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PServiceWorkerDispatchPeriodicSyncEvent -> Result ())
-> Proxy PServiceWorkerDispatchPeriodicSyncEvent
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PServiceWorkerDispatchPeriodicSyncEvent -> ())
-> Proxy PServiceWorkerDispatchPeriodicSyncEvent
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PServiceWorkerDispatchPeriodicSyncEvent -> ()
forall a b. a -> b -> a
const ()


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


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


-- | Parameters of the 'ServiceWorker.setForceUpdateOnPageLoad' command.
data PServiceWorkerSetForceUpdateOnPageLoad = PServiceWorkerSetForceUpdateOnPageLoad
  {
    PServiceWorkerSetForceUpdateOnPageLoad -> Bool
pServiceWorkerSetForceUpdateOnPageLoadForceUpdateOnPageLoad :: Bool
  }
  deriving (PServiceWorkerSetForceUpdateOnPageLoad
-> PServiceWorkerSetForceUpdateOnPageLoad -> Bool
(PServiceWorkerSetForceUpdateOnPageLoad
 -> PServiceWorkerSetForceUpdateOnPageLoad -> Bool)
-> (PServiceWorkerSetForceUpdateOnPageLoad
    -> PServiceWorkerSetForceUpdateOnPageLoad -> Bool)
-> Eq PServiceWorkerSetForceUpdateOnPageLoad
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PServiceWorkerSetForceUpdateOnPageLoad
-> PServiceWorkerSetForceUpdateOnPageLoad -> Bool
$c/= :: PServiceWorkerSetForceUpdateOnPageLoad
-> PServiceWorkerSetForceUpdateOnPageLoad -> Bool
== :: PServiceWorkerSetForceUpdateOnPageLoad
-> PServiceWorkerSetForceUpdateOnPageLoad -> Bool
$c== :: PServiceWorkerSetForceUpdateOnPageLoad
-> PServiceWorkerSetForceUpdateOnPageLoad -> Bool
Eq, Int -> PServiceWorkerSetForceUpdateOnPageLoad -> ShowS
[PServiceWorkerSetForceUpdateOnPageLoad] -> ShowS
PServiceWorkerSetForceUpdateOnPageLoad -> String
(Int -> PServiceWorkerSetForceUpdateOnPageLoad -> ShowS)
-> (PServiceWorkerSetForceUpdateOnPageLoad -> String)
-> ([PServiceWorkerSetForceUpdateOnPageLoad] -> ShowS)
-> Show PServiceWorkerSetForceUpdateOnPageLoad
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PServiceWorkerSetForceUpdateOnPageLoad] -> ShowS
$cshowList :: [PServiceWorkerSetForceUpdateOnPageLoad] -> ShowS
show :: PServiceWorkerSetForceUpdateOnPageLoad -> String
$cshow :: PServiceWorkerSetForceUpdateOnPageLoad -> String
showsPrec :: Int -> PServiceWorkerSetForceUpdateOnPageLoad -> ShowS
$cshowsPrec :: Int -> PServiceWorkerSetForceUpdateOnPageLoad -> ShowS
Show)
pServiceWorkerSetForceUpdateOnPageLoad
  :: Bool
  -> PServiceWorkerSetForceUpdateOnPageLoad
pServiceWorkerSetForceUpdateOnPageLoad :: Bool -> PServiceWorkerSetForceUpdateOnPageLoad
pServiceWorkerSetForceUpdateOnPageLoad
  Bool
arg_pServiceWorkerSetForceUpdateOnPageLoadForceUpdateOnPageLoad
  = Bool -> PServiceWorkerSetForceUpdateOnPageLoad
PServiceWorkerSetForceUpdateOnPageLoad
    Bool
arg_pServiceWorkerSetForceUpdateOnPageLoadForceUpdateOnPageLoad
instance ToJSON PServiceWorkerSetForceUpdateOnPageLoad where
  toJSON :: PServiceWorkerSetForceUpdateOnPageLoad -> Value
toJSON PServiceWorkerSetForceUpdateOnPageLoad
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 [
    (ServiceWorkerRegistrationID
"forceUpdateOnPageLoad" ServiceWorkerRegistrationID -> Bool -> Pair
forall kv v.
(KeyValue kv, ToJSON v) =>
ServiceWorkerRegistrationID -> 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 (PServiceWorkerSetForceUpdateOnPageLoad -> Bool
pServiceWorkerSetForceUpdateOnPageLoadForceUpdateOnPageLoad PServiceWorkerSetForceUpdateOnPageLoad
p)
    ]
instance Command PServiceWorkerSetForceUpdateOnPageLoad where
  type CommandResponse PServiceWorkerSetForceUpdateOnPageLoad = ()
  commandName :: Proxy PServiceWorkerSetForceUpdateOnPageLoad -> String
commandName Proxy PServiceWorkerSetForceUpdateOnPageLoad
_ = String
"ServiceWorker.setForceUpdateOnPageLoad"
  fromJSON :: Proxy PServiceWorkerSetForceUpdateOnPageLoad
-> Value
-> Result (CommandResponse PServiceWorkerSetForceUpdateOnPageLoad)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PServiceWorkerSetForceUpdateOnPageLoad -> Result ())
-> Proxy PServiceWorkerSetForceUpdateOnPageLoad
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PServiceWorkerSetForceUpdateOnPageLoad -> ())
-> Proxy PServiceWorkerSetForceUpdateOnPageLoad
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PServiceWorkerSetForceUpdateOnPageLoad -> ()
forall a b. a -> b -> a
const ()


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


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


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


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


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


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