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


{- |
= IndexedDB

-}


module CDP.Domains.IndexedDB (module CDP.Domains.IndexedDB) where

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

import CDP.Internal.Utils


import CDP.Domains.Runtime as Runtime


-- | Type 'IndexedDB.DatabaseWithObjectStores'.
--   Database with an array of object stores.
data IndexedDBDatabaseWithObjectStores = IndexedDBDatabaseWithObjectStores
  {
    -- | Database name.
    IndexedDBDatabaseWithObjectStores -> Text
indexedDBDatabaseWithObjectStoresName :: T.Text,
    -- | Database version (type is not 'integer', as the standard
    --   requires the version number to be 'unsigned long long')
    IndexedDBDatabaseWithObjectStores -> Double
indexedDBDatabaseWithObjectStoresVersion :: Double,
    -- | Object stores in this database.
    IndexedDBDatabaseWithObjectStores -> [IndexedDBObjectStore]
indexedDBDatabaseWithObjectStoresObjectStores :: [IndexedDBObjectStore]
  }
  deriving (IndexedDBDatabaseWithObjectStores
-> IndexedDBDatabaseWithObjectStores -> Bool
(IndexedDBDatabaseWithObjectStores
 -> IndexedDBDatabaseWithObjectStores -> Bool)
-> (IndexedDBDatabaseWithObjectStores
    -> IndexedDBDatabaseWithObjectStores -> Bool)
-> Eq IndexedDBDatabaseWithObjectStores
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDBDatabaseWithObjectStores
-> IndexedDBDatabaseWithObjectStores -> Bool
$c/= :: IndexedDBDatabaseWithObjectStores
-> IndexedDBDatabaseWithObjectStores -> Bool
== :: IndexedDBDatabaseWithObjectStores
-> IndexedDBDatabaseWithObjectStores -> Bool
$c== :: IndexedDBDatabaseWithObjectStores
-> IndexedDBDatabaseWithObjectStores -> Bool
Eq, Int -> IndexedDBDatabaseWithObjectStores -> ShowS
[IndexedDBDatabaseWithObjectStores] -> ShowS
IndexedDBDatabaseWithObjectStores -> String
(Int -> IndexedDBDatabaseWithObjectStores -> ShowS)
-> (IndexedDBDatabaseWithObjectStores -> String)
-> ([IndexedDBDatabaseWithObjectStores] -> ShowS)
-> Show IndexedDBDatabaseWithObjectStores
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDBDatabaseWithObjectStores] -> ShowS
$cshowList :: [IndexedDBDatabaseWithObjectStores] -> ShowS
show :: IndexedDBDatabaseWithObjectStores -> String
$cshow :: IndexedDBDatabaseWithObjectStores -> String
showsPrec :: Int -> IndexedDBDatabaseWithObjectStores -> ShowS
$cshowsPrec :: Int -> IndexedDBDatabaseWithObjectStores -> ShowS
Show)
instance FromJSON IndexedDBDatabaseWithObjectStores where
  parseJSON :: Value -> Parser IndexedDBDatabaseWithObjectStores
parseJSON = String
-> (Object -> Parser IndexedDBDatabaseWithObjectStores)
-> Value
-> Parser IndexedDBDatabaseWithObjectStores
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IndexedDBDatabaseWithObjectStores" ((Object -> Parser IndexedDBDatabaseWithObjectStores)
 -> Value -> Parser IndexedDBDatabaseWithObjectStores)
-> (Object -> Parser IndexedDBDatabaseWithObjectStores)
-> Value
-> Parser IndexedDBDatabaseWithObjectStores
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Double
-> [IndexedDBObjectStore]
-> IndexedDBDatabaseWithObjectStores
IndexedDBDatabaseWithObjectStores
    (Text
 -> Double
 -> [IndexedDBObjectStore]
 -> IndexedDBDatabaseWithObjectStores)
-> Parser Text
-> Parser
     (Double
      -> [IndexedDBObjectStore] -> IndexedDBDatabaseWithObjectStores)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    Parser
  (Double
   -> [IndexedDBObjectStore] -> IndexedDBDatabaseWithObjectStores)
-> Parser Double
-> Parser
     ([IndexedDBObjectStore] -> IndexedDBDatabaseWithObjectStores)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"version"
    Parser
  ([IndexedDBObjectStore] -> IndexedDBDatabaseWithObjectStores)
-> Parser [IndexedDBObjectStore]
-> Parser IndexedDBDatabaseWithObjectStores
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [IndexedDBObjectStore]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"objectStores"
instance ToJSON IndexedDBDatabaseWithObjectStores where
  toJSON :: IndexedDBDatabaseWithObjectStores -> Value
toJSON IndexedDBDatabaseWithObjectStores
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (IndexedDBDatabaseWithObjectStores -> Text
indexedDBDatabaseWithObjectStoresName IndexedDBDatabaseWithObjectStores
p),
    (Text
"version" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (IndexedDBDatabaseWithObjectStores -> Double
indexedDBDatabaseWithObjectStoresVersion IndexedDBDatabaseWithObjectStores
p),
    (Text
"objectStores" Text -> [IndexedDBObjectStore] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([IndexedDBObjectStore] -> Pair)
-> Maybe [IndexedDBObjectStore] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IndexedDBObjectStore] -> Maybe [IndexedDBObjectStore]
forall a. a -> Maybe a
Just (IndexedDBDatabaseWithObjectStores -> [IndexedDBObjectStore]
indexedDBDatabaseWithObjectStoresObjectStores IndexedDBDatabaseWithObjectStores
p)
    ]

-- | Type 'IndexedDB.ObjectStore'.
--   Object store.
data IndexedDBObjectStore = IndexedDBObjectStore
  {
    -- | Object store name.
    IndexedDBObjectStore -> Text
indexedDBObjectStoreName :: T.Text,
    -- | Object store key path.
    IndexedDBObjectStore -> IndexedDBKeyPath
indexedDBObjectStoreKeyPath :: IndexedDBKeyPath,
    -- | If true, object store has auto increment flag set.
    IndexedDBObjectStore -> Bool
indexedDBObjectStoreAutoIncrement :: Bool,
    -- | Indexes in this object store.
    IndexedDBObjectStore -> [IndexedDBObjectStoreIndex]
indexedDBObjectStoreIndexes :: [IndexedDBObjectStoreIndex]
  }
  deriving (IndexedDBObjectStore -> IndexedDBObjectStore -> Bool
(IndexedDBObjectStore -> IndexedDBObjectStore -> Bool)
-> (IndexedDBObjectStore -> IndexedDBObjectStore -> Bool)
-> Eq IndexedDBObjectStore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDBObjectStore -> IndexedDBObjectStore -> Bool
$c/= :: IndexedDBObjectStore -> IndexedDBObjectStore -> Bool
== :: IndexedDBObjectStore -> IndexedDBObjectStore -> Bool
$c== :: IndexedDBObjectStore -> IndexedDBObjectStore -> Bool
Eq, Int -> IndexedDBObjectStore -> ShowS
[IndexedDBObjectStore] -> ShowS
IndexedDBObjectStore -> String
(Int -> IndexedDBObjectStore -> ShowS)
-> (IndexedDBObjectStore -> String)
-> ([IndexedDBObjectStore] -> ShowS)
-> Show IndexedDBObjectStore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDBObjectStore] -> ShowS
$cshowList :: [IndexedDBObjectStore] -> ShowS
show :: IndexedDBObjectStore -> String
$cshow :: IndexedDBObjectStore -> String
showsPrec :: Int -> IndexedDBObjectStore -> ShowS
$cshowsPrec :: Int -> IndexedDBObjectStore -> ShowS
Show)
instance FromJSON IndexedDBObjectStore where
  parseJSON :: Value -> Parser IndexedDBObjectStore
parseJSON = String
-> (Object -> Parser IndexedDBObjectStore)
-> Value
-> Parser IndexedDBObjectStore
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IndexedDBObjectStore" ((Object -> Parser IndexedDBObjectStore)
 -> Value -> Parser IndexedDBObjectStore)
-> (Object -> Parser IndexedDBObjectStore)
-> Value
-> Parser IndexedDBObjectStore
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> IndexedDBKeyPath
-> Bool
-> [IndexedDBObjectStoreIndex]
-> IndexedDBObjectStore
IndexedDBObjectStore
    (Text
 -> IndexedDBKeyPath
 -> Bool
 -> [IndexedDBObjectStoreIndex]
 -> IndexedDBObjectStore)
-> Parser Text
-> Parser
     (IndexedDBKeyPath
      -> Bool -> [IndexedDBObjectStoreIndex] -> IndexedDBObjectStore)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    Parser
  (IndexedDBKeyPath
   -> Bool -> [IndexedDBObjectStoreIndex] -> IndexedDBObjectStore)
-> Parser IndexedDBKeyPath
-> Parser
     (Bool -> [IndexedDBObjectStoreIndex] -> IndexedDBObjectStore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser IndexedDBKeyPath
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"keyPath"
    Parser
  (Bool -> [IndexedDBObjectStoreIndex] -> IndexedDBObjectStore)
-> Parser Bool
-> Parser ([IndexedDBObjectStoreIndex] -> IndexedDBObjectStore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"autoIncrement"
    Parser ([IndexedDBObjectStoreIndex] -> IndexedDBObjectStore)
-> Parser [IndexedDBObjectStoreIndex]
-> Parser IndexedDBObjectStore
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [IndexedDBObjectStoreIndex]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"indexes"
instance ToJSON IndexedDBObjectStore where
  toJSON :: IndexedDBObjectStore -> Value
toJSON IndexedDBObjectStore
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (IndexedDBObjectStore -> Text
indexedDBObjectStoreName IndexedDBObjectStore
p),
    (Text
"keyPath" Text -> IndexedDBKeyPath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (IndexedDBKeyPath -> Pair) -> Maybe IndexedDBKeyPath -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IndexedDBKeyPath -> Maybe IndexedDBKeyPath
forall a. a -> Maybe a
Just (IndexedDBObjectStore -> IndexedDBKeyPath
indexedDBObjectStoreKeyPath IndexedDBObjectStore
p),
    (Text
"autoIncrement" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (IndexedDBObjectStore -> Bool
indexedDBObjectStoreAutoIncrement IndexedDBObjectStore
p),
    (Text
"indexes" Text -> [IndexedDBObjectStoreIndex] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([IndexedDBObjectStoreIndex] -> Pair)
-> Maybe [IndexedDBObjectStoreIndex] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IndexedDBObjectStoreIndex] -> Maybe [IndexedDBObjectStoreIndex]
forall a. a -> Maybe a
Just (IndexedDBObjectStore -> [IndexedDBObjectStoreIndex]
indexedDBObjectStoreIndexes IndexedDBObjectStore
p)
    ]

-- | Type 'IndexedDB.ObjectStoreIndex'.
--   Object store index.
data IndexedDBObjectStoreIndex = IndexedDBObjectStoreIndex
  {
    -- | Index name.
    IndexedDBObjectStoreIndex -> Text
indexedDBObjectStoreIndexName :: T.Text,
    -- | Index key path.
    IndexedDBObjectStoreIndex -> IndexedDBKeyPath
indexedDBObjectStoreIndexKeyPath :: IndexedDBKeyPath,
    -- | If true, index is unique.
    IndexedDBObjectStoreIndex -> Bool
indexedDBObjectStoreIndexUnique :: Bool,
    -- | If true, index allows multiple entries for a key.
    IndexedDBObjectStoreIndex -> Bool
indexedDBObjectStoreIndexMultiEntry :: Bool
  }
  deriving (IndexedDBObjectStoreIndex -> IndexedDBObjectStoreIndex -> Bool
(IndexedDBObjectStoreIndex -> IndexedDBObjectStoreIndex -> Bool)
-> (IndexedDBObjectStoreIndex -> IndexedDBObjectStoreIndex -> Bool)
-> Eq IndexedDBObjectStoreIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDBObjectStoreIndex -> IndexedDBObjectStoreIndex -> Bool
$c/= :: IndexedDBObjectStoreIndex -> IndexedDBObjectStoreIndex -> Bool
== :: IndexedDBObjectStoreIndex -> IndexedDBObjectStoreIndex -> Bool
$c== :: IndexedDBObjectStoreIndex -> IndexedDBObjectStoreIndex -> Bool
Eq, Int -> IndexedDBObjectStoreIndex -> ShowS
[IndexedDBObjectStoreIndex] -> ShowS
IndexedDBObjectStoreIndex -> String
(Int -> IndexedDBObjectStoreIndex -> ShowS)
-> (IndexedDBObjectStoreIndex -> String)
-> ([IndexedDBObjectStoreIndex] -> ShowS)
-> Show IndexedDBObjectStoreIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDBObjectStoreIndex] -> ShowS
$cshowList :: [IndexedDBObjectStoreIndex] -> ShowS
show :: IndexedDBObjectStoreIndex -> String
$cshow :: IndexedDBObjectStoreIndex -> String
showsPrec :: Int -> IndexedDBObjectStoreIndex -> ShowS
$cshowsPrec :: Int -> IndexedDBObjectStoreIndex -> ShowS
Show)
instance FromJSON IndexedDBObjectStoreIndex where
  parseJSON :: Value -> Parser IndexedDBObjectStoreIndex
parseJSON = String
-> (Object -> Parser IndexedDBObjectStoreIndex)
-> Value
-> Parser IndexedDBObjectStoreIndex
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IndexedDBObjectStoreIndex" ((Object -> Parser IndexedDBObjectStoreIndex)
 -> Value -> Parser IndexedDBObjectStoreIndex)
-> (Object -> Parser IndexedDBObjectStoreIndex)
-> Value
-> Parser IndexedDBObjectStoreIndex
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> IndexedDBKeyPath -> Bool -> Bool -> IndexedDBObjectStoreIndex
IndexedDBObjectStoreIndex
    (Text
 -> IndexedDBKeyPath -> Bool -> Bool -> IndexedDBObjectStoreIndex)
-> Parser Text
-> Parser
     (IndexedDBKeyPath -> Bool -> Bool -> IndexedDBObjectStoreIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    Parser
  (IndexedDBKeyPath -> Bool -> Bool -> IndexedDBObjectStoreIndex)
-> Parser IndexedDBKeyPath
-> Parser (Bool -> Bool -> IndexedDBObjectStoreIndex)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser IndexedDBKeyPath
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"keyPath"
    Parser (Bool -> Bool -> IndexedDBObjectStoreIndex)
-> Parser Bool -> Parser (Bool -> IndexedDBObjectStoreIndex)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"unique"
    Parser (Bool -> IndexedDBObjectStoreIndex)
-> Parser Bool -> Parser IndexedDBObjectStoreIndex
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"multiEntry"
instance ToJSON IndexedDBObjectStoreIndex where
  toJSON :: IndexedDBObjectStoreIndex -> Value
toJSON IndexedDBObjectStoreIndex
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (IndexedDBObjectStoreIndex -> Text
indexedDBObjectStoreIndexName IndexedDBObjectStoreIndex
p),
    (Text
"keyPath" Text -> IndexedDBKeyPath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (IndexedDBKeyPath -> Pair) -> Maybe IndexedDBKeyPath -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IndexedDBKeyPath -> Maybe IndexedDBKeyPath
forall a. a -> Maybe a
Just (IndexedDBObjectStoreIndex -> IndexedDBKeyPath
indexedDBObjectStoreIndexKeyPath IndexedDBObjectStoreIndex
p),
    (Text
"unique" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (IndexedDBObjectStoreIndex -> Bool
indexedDBObjectStoreIndexUnique IndexedDBObjectStoreIndex
p),
    (Text
"multiEntry" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (IndexedDBObjectStoreIndex -> Bool
indexedDBObjectStoreIndexMultiEntry IndexedDBObjectStoreIndex
p)
    ]

-- | Type 'IndexedDB.Key'.
--   Key.
data IndexedDBKeyType = IndexedDBKeyTypeNumber | IndexedDBKeyTypeString | IndexedDBKeyTypeDate | IndexedDBKeyTypeArray
  deriving (Eq IndexedDBKeyType
Eq IndexedDBKeyType
-> (IndexedDBKeyType -> IndexedDBKeyType -> Ordering)
-> (IndexedDBKeyType -> IndexedDBKeyType -> Bool)
-> (IndexedDBKeyType -> IndexedDBKeyType -> Bool)
-> (IndexedDBKeyType -> IndexedDBKeyType -> Bool)
-> (IndexedDBKeyType -> IndexedDBKeyType -> Bool)
-> (IndexedDBKeyType -> IndexedDBKeyType -> IndexedDBKeyType)
-> (IndexedDBKeyType -> IndexedDBKeyType -> IndexedDBKeyType)
-> Ord IndexedDBKeyType
IndexedDBKeyType -> IndexedDBKeyType -> Bool
IndexedDBKeyType -> IndexedDBKeyType -> Ordering
IndexedDBKeyType -> IndexedDBKeyType -> IndexedDBKeyType
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 :: IndexedDBKeyType -> IndexedDBKeyType -> IndexedDBKeyType
$cmin :: IndexedDBKeyType -> IndexedDBKeyType -> IndexedDBKeyType
max :: IndexedDBKeyType -> IndexedDBKeyType -> IndexedDBKeyType
$cmax :: IndexedDBKeyType -> IndexedDBKeyType -> IndexedDBKeyType
>= :: IndexedDBKeyType -> IndexedDBKeyType -> Bool
$c>= :: IndexedDBKeyType -> IndexedDBKeyType -> Bool
> :: IndexedDBKeyType -> IndexedDBKeyType -> Bool
$c> :: IndexedDBKeyType -> IndexedDBKeyType -> Bool
<= :: IndexedDBKeyType -> IndexedDBKeyType -> Bool
$c<= :: IndexedDBKeyType -> IndexedDBKeyType -> Bool
< :: IndexedDBKeyType -> IndexedDBKeyType -> Bool
$c< :: IndexedDBKeyType -> IndexedDBKeyType -> Bool
compare :: IndexedDBKeyType -> IndexedDBKeyType -> Ordering
$ccompare :: IndexedDBKeyType -> IndexedDBKeyType -> Ordering
$cp1Ord :: Eq IndexedDBKeyType
Ord, IndexedDBKeyType -> IndexedDBKeyType -> Bool
(IndexedDBKeyType -> IndexedDBKeyType -> Bool)
-> (IndexedDBKeyType -> IndexedDBKeyType -> Bool)
-> Eq IndexedDBKeyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDBKeyType -> IndexedDBKeyType -> Bool
$c/= :: IndexedDBKeyType -> IndexedDBKeyType -> Bool
== :: IndexedDBKeyType -> IndexedDBKeyType -> Bool
$c== :: IndexedDBKeyType -> IndexedDBKeyType -> Bool
Eq, Int -> IndexedDBKeyType -> ShowS
[IndexedDBKeyType] -> ShowS
IndexedDBKeyType -> String
(Int -> IndexedDBKeyType -> ShowS)
-> (IndexedDBKeyType -> String)
-> ([IndexedDBKeyType] -> ShowS)
-> Show IndexedDBKeyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDBKeyType] -> ShowS
$cshowList :: [IndexedDBKeyType] -> ShowS
show :: IndexedDBKeyType -> String
$cshow :: IndexedDBKeyType -> String
showsPrec :: Int -> IndexedDBKeyType -> ShowS
$cshowsPrec :: Int -> IndexedDBKeyType -> ShowS
Show, ReadPrec [IndexedDBKeyType]
ReadPrec IndexedDBKeyType
Int -> ReadS IndexedDBKeyType
ReadS [IndexedDBKeyType]
(Int -> ReadS IndexedDBKeyType)
-> ReadS [IndexedDBKeyType]
-> ReadPrec IndexedDBKeyType
-> ReadPrec [IndexedDBKeyType]
-> Read IndexedDBKeyType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IndexedDBKeyType]
$creadListPrec :: ReadPrec [IndexedDBKeyType]
readPrec :: ReadPrec IndexedDBKeyType
$creadPrec :: ReadPrec IndexedDBKeyType
readList :: ReadS [IndexedDBKeyType]
$creadList :: ReadS [IndexedDBKeyType]
readsPrec :: Int -> ReadS IndexedDBKeyType
$creadsPrec :: Int -> ReadS IndexedDBKeyType
Read)
instance FromJSON IndexedDBKeyType where
  parseJSON :: Value -> Parser IndexedDBKeyType
parseJSON = String
-> (Text -> Parser IndexedDBKeyType)
-> Value
-> Parser IndexedDBKeyType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"IndexedDBKeyType" ((Text -> Parser IndexedDBKeyType)
 -> Value -> Parser IndexedDBKeyType)
-> (Text -> Parser IndexedDBKeyType)
-> Value
-> Parser IndexedDBKeyType
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"number" -> IndexedDBKeyType -> Parser IndexedDBKeyType
forall (f :: * -> *) a. Applicative f => a -> f a
pure IndexedDBKeyType
IndexedDBKeyTypeNumber
    Text
"string" -> IndexedDBKeyType -> Parser IndexedDBKeyType
forall (f :: * -> *) a. Applicative f => a -> f a
pure IndexedDBKeyType
IndexedDBKeyTypeString
    Text
"date" -> IndexedDBKeyType -> Parser IndexedDBKeyType
forall (f :: * -> *) a. Applicative f => a -> f a
pure IndexedDBKeyType
IndexedDBKeyTypeDate
    Text
"array" -> IndexedDBKeyType -> Parser IndexedDBKeyType
forall (f :: * -> *) a. Applicative f => a -> f a
pure IndexedDBKeyType
IndexedDBKeyTypeArray
    Text
"_" -> String -> Parser IndexedDBKeyType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse IndexedDBKeyType"
instance ToJSON IndexedDBKeyType where
  toJSON :: IndexedDBKeyType -> Value
toJSON IndexedDBKeyType
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case IndexedDBKeyType
v of
    IndexedDBKeyType
IndexedDBKeyTypeNumber -> Text
"number"
    IndexedDBKeyType
IndexedDBKeyTypeString -> Text
"string"
    IndexedDBKeyType
IndexedDBKeyTypeDate -> Text
"date"
    IndexedDBKeyType
IndexedDBKeyTypeArray -> Text
"array"
data IndexedDBKey = IndexedDBKey
  {
    -- | Key type.
    IndexedDBKey -> IndexedDBKeyType
indexedDBKeyType :: IndexedDBKeyType,
    -- | Number value.
    IndexedDBKey -> Maybe Double
indexedDBKeyNumber :: Maybe Double,
    -- | String value.
    IndexedDBKey -> Maybe Text
indexedDBKeyString :: Maybe T.Text,
    -- | Date value.
    IndexedDBKey -> Maybe Double
indexedDBKeyDate :: Maybe Double,
    -- | Array value.
    IndexedDBKey -> Maybe [IndexedDBKey]
indexedDBKeyArray :: Maybe [IndexedDBKey]
  }
  deriving (IndexedDBKey -> IndexedDBKey -> Bool
(IndexedDBKey -> IndexedDBKey -> Bool)
-> (IndexedDBKey -> IndexedDBKey -> Bool) -> Eq IndexedDBKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDBKey -> IndexedDBKey -> Bool
$c/= :: IndexedDBKey -> IndexedDBKey -> Bool
== :: IndexedDBKey -> IndexedDBKey -> Bool
$c== :: IndexedDBKey -> IndexedDBKey -> Bool
Eq, Int -> IndexedDBKey -> ShowS
[IndexedDBKey] -> ShowS
IndexedDBKey -> String
(Int -> IndexedDBKey -> ShowS)
-> (IndexedDBKey -> String)
-> ([IndexedDBKey] -> ShowS)
-> Show IndexedDBKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDBKey] -> ShowS
$cshowList :: [IndexedDBKey] -> ShowS
show :: IndexedDBKey -> String
$cshow :: IndexedDBKey -> String
showsPrec :: Int -> IndexedDBKey -> ShowS
$cshowsPrec :: Int -> IndexedDBKey -> ShowS
Show)
instance FromJSON IndexedDBKey where
  parseJSON :: Value -> Parser IndexedDBKey
parseJSON = String
-> (Object -> Parser IndexedDBKey) -> Value -> Parser IndexedDBKey
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IndexedDBKey" ((Object -> Parser IndexedDBKey) -> Value -> Parser IndexedDBKey)
-> (Object -> Parser IndexedDBKey) -> Value -> Parser IndexedDBKey
forall a b. (a -> b) -> a -> b
$ \Object
o -> IndexedDBKeyType
-> Maybe Double
-> Maybe Text
-> Maybe Double
-> Maybe [IndexedDBKey]
-> IndexedDBKey
IndexedDBKey
    (IndexedDBKeyType
 -> Maybe Double
 -> Maybe Text
 -> Maybe Double
 -> Maybe [IndexedDBKey]
 -> IndexedDBKey)
-> Parser IndexedDBKeyType
-> Parser
     (Maybe Double
      -> Maybe Text
      -> Maybe Double
      -> Maybe [IndexedDBKey]
      -> IndexedDBKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser IndexedDBKeyType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"type"
    Parser
  (Maybe Double
   -> Maybe Text
   -> Maybe Double
   -> Maybe [IndexedDBKey]
   -> IndexedDBKey)
-> Parser (Maybe Double)
-> Parser
     (Maybe Text
      -> Maybe Double -> Maybe [IndexedDBKey] -> IndexedDBKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"number"
    Parser
  (Maybe Text
   -> Maybe Double -> Maybe [IndexedDBKey] -> IndexedDBKey)
-> Parser (Maybe Text)
-> Parser (Maybe Double -> Maybe [IndexedDBKey] -> IndexedDBKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"string"
    Parser (Maybe Double -> Maybe [IndexedDBKey] -> IndexedDBKey)
-> Parser (Maybe Double)
-> Parser (Maybe [IndexedDBKey] -> IndexedDBKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"date"
    Parser (Maybe [IndexedDBKey] -> IndexedDBKey)
-> Parser (Maybe [IndexedDBKey]) -> Parser IndexedDBKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [IndexedDBKey])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"array"
instance ToJSON IndexedDBKey where
  toJSON :: IndexedDBKey -> Value
toJSON IndexedDBKey
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"type" Text -> IndexedDBKeyType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (IndexedDBKeyType -> Pair) -> Maybe IndexedDBKeyType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IndexedDBKeyType -> Maybe IndexedDBKeyType
forall a. a -> Maybe a
Just (IndexedDBKey -> IndexedDBKeyType
indexedDBKeyType IndexedDBKey
p),
    (Text
"number" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IndexedDBKey -> Maybe Double
indexedDBKeyNumber IndexedDBKey
p),
    (Text
"string" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IndexedDBKey -> Maybe Text
indexedDBKeyString IndexedDBKey
p),
    (Text
"date" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IndexedDBKey -> Maybe Double
indexedDBKeyDate IndexedDBKey
p),
    (Text
"array" Text -> [IndexedDBKey] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([IndexedDBKey] -> Pair) -> Maybe [IndexedDBKey] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IndexedDBKey -> Maybe [IndexedDBKey]
indexedDBKeyArray IndexedDBKey
p)
    ]

-- | Type 'IndexedDB.KeyRange'.
--   Key range.
data IndexedDBKeyRange = IndexedDBKeyRange
  {
    -- | Lower bound.
    IndexedDBKeyRange -> Maybe IndexedDBKey
indexedDBKeyRangeLower :: Maybe IndexedDBKey,
    -- | Upper bound.
    IndexedDBKeyRange -> Maybe IndexedDBKey
indexedDBKeyRangeUpper :: Maybe IndexedDBKey,
    -- | If true lower bound is open.
    IndexedDBKeyRange -> Bool
indexedDBKeyRangeLowerOpen :: Bool,
    -- | If true upper bound is open.
    IndexedDBKeyRange -> Bool
indexedDBKeyRangeUpperOpen :: Bool
  }
  deriving (IndexedDBKeyRange -> IndexedDBKeyRange -> Bool
(IndexedDBKeyRange -> IndexedDBKeyRange -> Bool)
-> (IndexedDBKeyRange -> IndexedDBKeyRange -> Bool)
-> Eq IndexedDBKeyRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDBKeyRange -> IndexedDBKeyRange -> Bool
$c/= :: IndexedDBKeyRange -> IndexedDBKeyRange -> Bool
== :: IndexedDBKeyRange -> IndexedDBKeyRange -> Bool
$c== :: IndexedDBKeyRange -> IndexedDBKeyRange -> Bool
Eq, Int -> IndexedDBKeyRange -> ShowS
[IndexedDBKeyRange] -> ShowS
IndexedDBKeyRange -> String
(Int -> IndexedDBKeyRange -> ShowS)
-> (IndexedDBKeyRange -> String)
-> ([IndexedDBKeyRange] -> ShowS)
-> Show IndexedDBKeyRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDBKeyRange] -> ShowS
$cshowList :: [IndexedDBKeyRange] -> ShowS
show :: IndexedDBKeyRange -> String
$cshow :: IndexedDBKeyRange -> String
showsPrec :: Int -> IndexedDBKeyRange -> ShowS
$cshowsPrec :: Int -> IndexedDBKeyRange -> ShowS
Show)
instance FromJSON IndexedDBKeyRange where
  parseJSON :: Value -> Parser IndexedDBKeyRange
parseJSON = String
-> (Object -> Parser IndexedDBKeyRange)
-> Value
-> Parser IndexedDBKeyRange
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IndexedDBKeyRange" ((Object -> Parser IndexedDBKeyRange)
 -> Value -> Parser IndexedDBKeyRange)
-> (Object -> Parser IndexedDBKeyRange)
-> Value
-> Parser IndexedDBKeyRange
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe IndexedDBKey
-> Maybe IndexedDBKey -> Bool -> Bool -> IndexedDBKeyRange
IndexedDBKeyRange
    (Maybe IndexedDBKey
 -> Maybe IndexedDBKey -> Bool -> Bool -> IndexedDBKeyRange)
-> Parser (Maybe IndexedDBKey)
-> Parser (Maybe IndexedDBKey -> Bool -> Bool -> IndexedDBKeyRange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe IndexedDBKey)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"lower"
    Parser (Maybe IndexedDBKey -> Bool -> Bool -> IndexedDBKeyRange)
-> Parser (Maybe IndexedDBKey)
-> Parser (Bool -> Bool -> IndexedDBKeyRange)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe IndexedDBKey)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"upper"
    Parser (Bool -> Bool -> IndexedDBKeyRange)
-> Parser Bool -> Parser (Bool -> IndexedDBKeyRange)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"lowerOpen"
    Parser (Bool -> IndexedDBKeyRange)
-> Parser Bool -> Parser IndexedDBKeyRange
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"upperOpen"
instance ToJSON IndexedDBKeyRange where
  toJSON :: IndexedDBKeyRange -> Value
toJSON IndexedDBKeyRange
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"lower" Text -> IndexedDBKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (IndexedDBKey -> Pair) -> Maybe IndexedDBKey -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IndexedDBKeyRange -> Maybe IndexedDBKey
indexedDBKeyRangeLower IndexedDBKeyRange
p),
    (Text
"upper" Text -> IndexedDBKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (IndexedDBKey -> Pair) -> Maybe IndexedDBKey -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IndexedDBKeyRange -> Maybe IndexedDBKey
indexedDBKeyRangeUpper IndexedDBKeyRange
p),
    (Text
"lowerOpen" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (IndexedDBKeyRange -> Bool
indexedDBKeyRangeLowerOpen IndexedDBKeyRange
p),
    (Text
"upperOpen" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (IndexedDBKeyRange -> Bool
indexedDBKeyRangeUpperOpen IndexedDBKeyRange
p)
    ]

-- | Type 'IndexedDB.DataEntry'.
--   Data entry.
data IndexedDBDataEntry = IndexedDBDataEntry
  {
    -- | Key object.
    IndexedDBDataEntry -> RuntimeRemoteObject
indexedDBDataEntryKey :: Runtime.RuntimeRemoteObject,
    -- | Primary key object.
    IndexedDBDataEntry -> RuntimeRemoteObject
indexedDBDataEntryPrimaryKey :: Runtime.RuntimeRemoteObject,
    -- | Value object.
    IndexedDBDataEntry -> RuntimeRemoteObject
indexedDBDataEntryValue :: Runtime.RuntimeRemoteObject
  }
  deriving (IndexedDBDataEntry -> IndexedDBDataEntry -> Bool
(IndexedDBDataEntry -> IndexedDBDataEntry -> Bool)
-> (IndexedDBDataEntry -> IndexedDBDataEntry -> Bool)
-> Eq IndexedDBDataEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDBDataEntry -> IndexedDBDataEntry -> Bool
$c/= :: IndexedDBDataEntry -> IndexedDBDataEntry -> Bool
== :: IndexedDBDataEntry -> IndexedDBDataEntry -> Bool
$c== :: IndexedDBDataEntry -> IndexedDBDataEntry -> Bool
Eq, Int -> IndexedDBDataEntry -> ShowS
[IndexedDBDataEntry] -> ShowS
IndexedDBDataEntry -> String
(Int -> IndexedDBDataEntry -> ShowS)
-> (IndexedDBDataEntry -> String)
-> ([IndexedDBDataEntry] -> ShowS)
-> Show IndexedDBDataEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDBDataEntry] -> ShowS
$cshowList :: [IndexedDBDataEntry] -> ShowS
show :: IndexedDBDataEntry -> String
$cshow :: IndexedDBDataEntry -> String
showsPrec :: Int -> IndexedDBDataEntry -> ShowS
$cshowsPrec :: Int -> IndexedDBDataEntry -> ShowS
Show)
instance FromJSON IndexedDBDataEntry where
  parseJSON :: Value -> Parser IndexedDBDataEntry
parseJSON = String
-> (Object -> Parser IndexedDBDataEntry)
-> Value
-> Parser IndexedDBDataEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IndexedDBDataEntry" ((Object -> Parser IndexedDBDataEntry)
 -> Value -> Parser IndexedDBDataEntry)
-> (Object -> Parser IndexedDBDataEntry)
-> Value
-> Parser IndexedDBDataEntry
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeRemoteObject
-> RuntimeRemoteObject -> RuntimeRemoteObject -> IndexedDBDataEntry
IndexedDBDataEntry
    (RuntimeRemoteObject
 -> RuntimeRemoteObject
 -> RuntimeRemoteObject
 -> IndexedDBDataEntry)
-> Parser RuntimeRemoteObject
-> Parser
     (RuntimeRemoteObject -> RuntimeRemoteObject -> IndexedDBDataEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeRemoteObject
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"key"
    Parser
  (RuntimeRemoteObject -> RuntimeRemoteObject -> IndexedDBDataEntry)
-> Parser RuntimeRemoteObject
-> Parser (RuntimeRemoteObject -> IndexedDBDataEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser RuntimeRemoteObject
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"primaryKey"
    Parser (RuntimeRemoteObject -> IndexedDBDataEntry)
-> Parser RuntimeRemoteObject -> Parser IndexedDBDataEntry
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser RuntimeRemoteObject
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"value"
instance ToJSON IndexedDBDataEntry where
  toJSON :: IndexedDBDataEntry -> Value
toJSON IndexedDBDataEntry
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"key" Text -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeRemoteObject -> Maybe RuntimeRemoteObject
forall a. a -> Maybe a
Just (IndexedDBDataEntry -> RuntimeRemoteObject
indexedDBDataEntryKey IndexedDBDataEntry
p),
    (Text
"primaryKey" Text -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeRemoteObject -> Maybe RuntimeRemoteObject
forall a. a -> Maybe a
Just (IndexedDBDataEntry -> RuntimeRemoteObject
indexedDBDataEntryPrimaryKey IndexedDBDataEntry
p),
    (Text
"value" Text -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeRemoteObject -> Maybe RuntimeRemoteObject
forall a. a -> Maybe a
Just (IndexedDBDataEntry -> RuntimeRemoteObject
indexedDBDataEntryValue IndexedDBDataEntry
p)
    ]

-- | Type 'IndexedDB.KeyPath'.
--   Key path.
data IndexedDBKeyPathType = IndexedDBKeyPathTypeNull | IndexedDBKeyPathTypeString | IndexedDBKeyPathTypeArray
  deriving (Eq IndexedDBKeyPathType
Eq IndexedDBKeyPathType
-> (IndexedDBKeyPathType -> IndexedDBKeyPathType -> Ordering)
-> (IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool)
-> (IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool)
-> (IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool)
-> (IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool)
-> (IndexedDBKeyPathType
    -> IndexedDBKeyPathType -> IndexedDBKeyPathType)
-> (IndexedDBKeyPathType
    -> IndexedDBKeyPathType -> IndexedDBKeyPathType)
-> Ord IndexedDBKeyPathType
IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool
IndexedDBKeyPathType -> IndexedDBKeyPathType -> Ordering
IndexedDBKeyPathType
-> IndexedDBKeyPathType -> IndexedDBKeyPathType
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 :: IndexedDBKeyPathType
-> IndexedDBKeyPathType -> IndexedDBKeyPathType
$cmin :: IndexedDBKeyPathType
-> IndexedDBKeyPathType -> IndexedDBKeyPathType
max :: IndexedDBKeyPathType
-> IndexedDBKeyPathType -> IndexedDBKeyPathType
$cmax :: IndexedDBKeyPathType
-> IndexedDBKeyPathType -> IndexedDBKeyPathType
>= :: IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool
$c>= :: IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool
> :: IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool
$c> :: IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool
<= :: IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool
$c<= :: IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool
< :: IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool
$c< :: IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool
compare :: IndexedDBKeyPathType -> IndexedDBKeyPathType -> Ordering
$ccompare :: IndexedDBKeyPathType -> IndexedDBKeyPathType -> Ordering
$cp1Ord :: Eq IndexedDBKeyPathType
Ord, IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool
(IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool)
-> (IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool)
-> Eq IndexedDBKeyPathType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool
$c/= :: IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool
== :: IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool
$c== :: IndexedDBKeyPathType -> IndexedDBKeyPathType -> Bool
Eq, Int -> IndexedDBKeyPathType -> ShowS
[IndexedDBKeyPathType] -> ShowS
IndexedDBKeyPathType -> String
(Int -> IndexedDBKeyPathType -> ShowS)
-> (IndexedDBKeyPathType -> String)
-> ([IndexedDBKeyPathType] -> ShowS)
-> Show IndexedDBKeyPathType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDBKeyPathType] -> ShowS
$cshowList :: [IndexedDBKeyPathType] -> ShowS
show :: IndexedDBKeyPathType -> String
$cshow :: IndexedDBKeyPathType -> String
showsPrec :: Int -> IndexedDBKeyPathType -> ShowS
$cshowsPrec :: Int -> IndexedDBKeyPathType -> ShowS
Show, ReadPrec [IndexedDBKeyPathType]
ReadPrec IndexedDBKeyPathType
Int -> ReadS IndexedDBKeyPathType
ReadS [IndexedDBKeyPathType]
(Int -> ReadS IndexedDBKeyPathType)
-> ReadS [IndexedDBKeyPathType]
-> ReadPrec IndexedDBKeyPathType
-> ReadPrec [IndexedDBKeyPathType]
-> Read IndexedDBKeyPathType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IndexedDBKeyPathType]
$creadListPrec :: ReadPrec [IndexedDBKeyPathType]
readPrec :: ReadPrec IndexedDBKeyPathType
$creadPrec :: ReadPrec IndexedDBKeyPathType
readList :: ReadS [IndexedDBKeyPathType]
$creadList :: ReadS [IndexedDBKeyPathType]
readsPrec :: Int -> ReadS IndexedDBKeyPathType
$creadsPrec :: Int -> ReadS IndexedDBKeyPathType
Read)
instance FromJSON IndexedDBKeyPathType where
  parseJSON :: Value -> Parser IndexedDBKeyPathType
parseJSON = String
-> (Text -> Parser IndexedDBKeyPathType)
-> Value
-> Parser IndexedDBKeyPathType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"IndexedDBKeyPathType" ((Text -> Parser IndexedDBKeyPathType)
 -> Value -> Parser IndexedDBKeyPathType)
-> (Text -> Parser IndexedDBKeyPathType)
-> Value
-> Parser IndexedDBKeyPathType
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"null" -> IndexedDBKeyPathType -> Parser IndexedDBKeyPathType
forall (f :: * -> *) a. Applicative f => a -> f a
pure IndexedDBKeyPathType
IndexedDBKeyPathTypeNull
    Text
"string" -> IndexedDBKeyPathType -> Parser IndexedDBKeyPathType
forall (f :: * -> *) a. Applicative f => a -> f a
pure IndexedDBKeyPathType
IndexedDBKeyPathTypeString
    Text
"array" -> IndexedDBKeyPathType -> Parser IndexedDBKeyPathType
forall (f :: * -> *) a. Applicative f => a -> f a
pure IndexedDBKeyPathType
IndexedDBKeyPathTypeArray
    Text
"_" -> String -> Parser IndexedDBKeyPathType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse IndexedDBKeyPathType"
instance ToJSON IndexedDBKeyPathType where
  toJSON :: IndexedDBKeyPathType -> Value
toJSON IndexedDBKeyPathType
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case IndexedDBKeyPathType
v of
    IndexedDBKeyPathType
IndexedDBKeyPathTypeNull -> Text
"null"
    IndexedDBKeyPathType
IndexedDBKeyPathTypeString -> Text
"string"
    IndexedDBKeyPathType
IndexedDBKeyPathTypeArray -> Text
"array"
data IndexedDBKeyPath = IndexedDBKeyPath
  {
    -- | Key path type.
    IndexedDBKeyPath -> IndexedDBKeyPathType
indexedDBKeyPathType :: IndexedDBKeyPathType,
    -- | String value.
    IndexedDBKeyPath -> Maybe Text
indexedDBKeyPathString :: Maybe T.Text,
    -- | Array value.
    IndexedDBKeyPath -> Maybe [Text]
indexedDBKeyPathArray :: Maybe [T.Text]
  }
  deriving (IndexedDBKeyPath -> IndexedDBKeyPath -> Bool
(IndexedDBKeyPath -> IndexedDBKeyPath -> Bool)
-> (IndexedDBKeyPath -> IndexedDBKeyPath -> Bool)
-> Eq IndexedDBKeyPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDBKeyPath -> IndexedDBKeyPath -> Bool
$c/= :: IndexedDBKeyPath -> IndexedDBKeyPath -> Bool
== :: IndexedDBKeyPath -> IndexedDBKeyPath -> Bool
$c== :: IndexedDBKeyPath -> IndexedDBKeyPath -> Bool
Eq, Int -> IndexedDBKeyPath -> ShowS
[IndexedDBKeyPath] -> ShowS
IndexedDBKeyPath -> String
(Int -> IndexedDBKeyPath -> ShowS)
-> (IndexedDBKeyPath -> String)
-> ([IndexedDBKeyPath] -> ShowS)
-> Show IndexedDBKeyPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDBKeyPath] -> ShowS
$cshowList :: [IndexedDBKeyPath] -> ShowS
show :: IndexedDBKeyPath -> String
$cshow :: IndexedDBKeyPath -> String
showsPrec :: Int -> IndexedDBKeyPath -> ShowS
$cshowsPrec :: Int -> IndexedDBKeyPath -> ShowS
Show)
instance FromJSON IndexedDBKeyPath where
  parseJSON :: Value -> Parser IndexedDBKeyPath
parseJSON = String
-> (Object -> Parser IndexedDBKeyPath)
-> Value
-> Parser IndexedDBKeyPath
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IndexedDBKeyPath" ((Object -> Parser IndexedDBKeyPath)
 -> Value -> Parser IndexedDBKeyPath)
-> (Object -> Parser IndexedDBKeyPath)
-> Value
-> Parser IndexedDBKeyPath
forall a b. (a -> b) -> a -> b
$ \Object
o -> IndexedDBKeyPathType
-> Maybe Text -> Maybe [Text] -> IndexedDBKeyPath
IndexedDBKeyPath
    (IndexedDBKeyPathType
 -> Maybe Text -> Maybe [Text] -> IndexedDBKeyPath)
-> Parser IndexedDBKeyPathType
-> Parser (Maybe Text -> Maybe [Text] -> IndexedDBKeyPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser IndexedDBKeyPathType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"type"
    Parser (Maybe Text -> Maybe [Text] -> IndexedDBKeyPath)
-> Parser (Maybe Text) -> Parser (Maybe [Text] -> IndexedDBKeyPath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"string"
    Parser (Maybe [Text] -> IndexedDBKeyPath)
-> Parser (Maybe [Text]) -> Parser IndexedDBKeyPath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"array"
instance ToJSON IndexedDBKeyPath where
  toJSON :: IndexedDBKeyPath -> Value
toJSON IndexedDBKeyPath
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"type" Text -> IndexedDBKeyPathType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (IndexedDBKeyPathType -> Pair)
-> Maybe IndexedDBKeyPathType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IndexedDBKeyPathType -> Maybe IndexedDBKeyPathType
forall a. a -> Maybe a
Just (IndexedDBKeyPath -> IndexedDBKeyPathType
indexedDBKeyPathType IndexedDBKeyPath
p),
    (Text
"string" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IndexedDBKeyPath -> Maybe Text
indexedDBKeyPathString IndexedDBKeyPath
p),
    (Text
"array" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IndexedDBKeyPath -> Maybe [Text]
indexedDBKeyPathArray IndexedDBKeyPath
p)
    ]

-- | Clears all entries from an object store.

-- | Parameters of the 'IndexedDB.clearObjectStore' command.
data PIndexedDBClearObjectStore = PIndexedDBClearObjectStore
  {
    -- | At least and at most one of securityOrigin, storageKey must be specified.
    --   Security origin.
    PIndexedDBClearObjectStore -> Maybe Text
pIndexedDBClearObjectStoreSecurityOrigin :: Maybe T.Text,
    -- | Storage key.
    PIndexedDBClearObjectStore -> Maybe Text
pIndexedDBClearObjectStoreStorageKey :: Maybe T.Text,
    -- | Database name.
    PIndexedDBClearObjectStore -> Text
pIndexedDBClearObjectStoreDatabaseName :: T.Text,
    -- | Object store name.
    PIndexedDBClearObjectStore -> Text
pIndexedDBClearObjectStoreObjectStoreName :: T.Text
  }
  deriving (PIndexedDBClearObjectStore -> PIndexedDBClearObjectStore -> Bool
(PIndexedDBClearObjectStore -> PIndexedDBClearObjectStore -> Bool)
-> (PIndexedDBClearObjectStore
    -> PIndexedDBClearObjectStore -> Bool)
-> Eq PIndexedDBClearObjectStore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PIndexedDBClearObjectStore -> PIndexedDBClearObjectStore -> Bool
$c/= :: PIndexedDBClearObjectStore -> PIndexedDBClearObjectStore -> Bool
== :: PIndexedDBClearObjectStore -> PIndexedDBClearObjectStore -> Bool
$c== :: PIndexedDBClearObjectStore -> PIndexedDBClearObjectStore -> Bool
Eq, Int -> PIndexedDBClearObjectStore -> ShowS
[PIndexedDBClearObjectStore] -> ShowS
PIndexedDBClearObjectStore -> String
(Int -> PIndexedDBClearObjectStore -> ShowS)
-> (PIndexedDBClearObjectStore -> String)
-> ([PIndexedDBClearObjectStore] -> ShowS)
-> Show PIndexedDBClearObjectStore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PIndexedDBClearObjectStore] -> ShowS
$cshowList :: [PIndexedDBClearObjectStore] -> ShowS
show :: PIndexedDBClearObjectStore -> String
$cshow :: PIndexedDBClearObjectStore -> String
showsPrec :: Int -> PIndexedDBClearObjectStore -> ShowS
$cshowsPrec :: Int -> PIndexedDBClearObjectStore -> ShowS
Show)
pIndexedDBClearObjectStore
  {-
  -- | Database name.
  -}
  :: T.Text
  {-
  -- | Object store name.
  -}
  -> T.Text
  -> PIndexedDBClearObjectStore
pIndexedDBClearObjectStore :: Text -> Text -> PIndexedDBClearObjectStore
pIndexedDBClearObjectStore
  Text
arg_pIndexedDBClearObjectStoreDatabaseName
  Text
arg_pIndexedDBClearObjectStoreObjectStoreName
  = Maybe Text
-> Maybe Text -> Text -> Text -> PIndexedDBClearObjectStore
PIndexedDBClearObjectStore
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Text
arg_pIndexedDBClearObjectStoreDatabaseName
    Text
arg_pIndexedDBClearObjectStoreObjectStoreName
instance ToJSON PIndexedDBClearObjectStore where
  toJSON :: PIndexedDBClearObjectStore -> Value
toJSON PIndexedDBClearObjectStore
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"securityOrigin" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBClearObjectStore -> Maybe Text
pIndexedDBClearObjectStoreSecurityOrigin PIndexedDBClearObjectStore
p),
    (Text
"storageKey" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBClearObjectStore -> Maybe Text
pIndexedDBClearObjectStoreStorageKey PIndexedDBClearObjectStore
p),
    (Text
"databaseName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PIndexedDBClearObjectStore -> Text
pIndexedDBClearObjectStoreDatabaseName PIndexedDBClearObjectStore
p),
    (Text
"objectStoreName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PIndexedDBClearObjectStore -> Text
pIndexedDBClearObjectStoreObjectStoreName PIndexedDBClearObjectStore
p)
    ]
instance Command PIndexedDBClearObjectStore where
  type CommandResponse PIndexedDBClearObjectStore = ()
  commandName :: Proxy PIndexedDBClearObjectStore -> String
commandName Proxy PIndexedDBClearObjectStore
_ = String
"IndexedDB.clearObjectStore"
  fromJSON :: Proxy PIndexedDBClearObjectStore
-> Value -> Result (CommandResponse PIndexedDBClearObjectStore)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PIndexedDBClearObjectStore -> Result ())
-> Proxy PIndexedDBClearObjectStore
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PIndexedDBClearObjectStore -> ())
-> Proxy PIndexedDBClearObjectStore
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PIndexedDBClearObjectStore -> ()
forall a b. a -> b -> a
const ()

-- | Deletes a database.

-- | Parameters of the 'IndexedDB.deleteDatabase' command.
data PIndexedDBDeleteDatabase = PIndexedDBDeleteDatabase
  {
    -- | At least and at most one of securityOrigin, storageKey must be specified.
    --   Security origin.
    PIndexedDBDeleteDatabase -> Maybe Text
pIndexedDBDeleteDatabaseSecurityOrigin :: Maybe T.Text,
    -- | Storage key.
    PIndexedDBDeleteDatabase -> Maybe Text
pIndexedDBDeleteDatabaseStorageKey :: Maybe T.Text,
    -- | Database name.
    PIndexedDBDeleteDatabase -> Text
pIndexedDBDeleteDatabaseDatabaseName :: T.Text
  }
  deriving (PIndexedDBDeleteDatabase -> PIndexedDBDeleteDatabase -> Bool
(PIndexedDBDeleteDatabase -> PIndexedDBDeleteDatabase -> Bool)
-> (PIndexedDBDeleteDatabase -> PIndexedDBDeleteDatabase -> Bool)
-> Eq PIndexedDBDeleteDatabase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PIndexedDBDeleteDatabase -> PIndexedDBDeleteDatabase -> Bool
$c/= :: PIndexedDBDeleteDatabase -> PIndexedDBDeleteDatabase -> Bool
== :: PIndexedDBDeleteDatabase -> PIndexedDBDeleteDatabase -> Bool
$c== :: PIndexedDBDeleteDatabase -> PIndexedDBDeleteDatabase -> Bool
Eq, Int -> PIndexedDBDeleteDatabase -> ShowS
[PIndexedDBDeleteDatabase] -> ShowS
PIndexedDBDeleteDatabase -> String
(Int -> PIndexedDBDeleteDatabase -> ShowS)
-> (PIndexedDBDeleteDatabase -> String)
-> ([PIndexedDBDeleteDatabase] -> ShowS)
-> Show PIndexedDBDeleteDatabase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PIndexedDBDeleteDatabase] -> ShowS
$cshowList :: [PIndexedDBDeleteDatabase] -> ShowS
show :: PIndexedDBDeleteDatabase -> String
$cshow :: PIndexedDBDeleteDatabase -> String
showsPrec :: Int -> PIndexedDBDeleteDatabase -> ShowS
$cshowsPrec :: Int -> PIndexedDBDeleteDatabase -> ShowS
Show)
pIndexedDBDeleteDatabase
  {-
  -- | Database name.
  -}
  :: T.Text
  -> PIndexedDBDeleteDatabase
pIndexedDBDeleteDatabase :: Text -> PIndexedDBDeleteDatabase
pIndexedDBDeleteDatabase
  Text
arg_pIndexedDBDeleteDatabaseDatabaseName
  = Maybe Text -> Maybe Text -> Text -> PIndexedDBDeleteDatabase
PIndexedDBDeleteDatabase
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Text
arg_pIndexedDBDeleteDatabaseDatabaseName
instance ToJSON PIndexedDBDeleteDatabase where
  toJSON :: PIndexedDBDeleteDatabase -> Value
toJSON PIndexedDBDeleteDatabase
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"securityOrigin" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBDeleteDatabase -> Maybe Text
pIndexedDBDeleteDatabaseSecurityOrigin PIndexedDBDeleteDatabase
p),
    (Text
"storageKey" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBDeleteDatabase -> Maybe Text
pIndexedDBDeleteDatabaseStorageKey PIndexedDBDeleteDatabase
p),
    (Text
"databaseName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PIndexedDBDeleteDatabase -> Text
pIndexedDBDeleteDatabaseDatabaseName PIndexedDBDeleteDatabase
p)
    ]
instance Command PIndexedDBDeleteDatabase where
  type CommandResponse PIndexedDBDeleteDatabase = ()
  commandName :: Proxy PIndexedDBDeleteDatabase -> String
commandName Proxy PIndexedDBDeleteDatabase
_ = String
"IndexedDB.deleteDatabase"
  fromJSON :: Proxy PIndexedDBDeleteDatabase
-> Value -> Result (CommandResponse PIndexedDBDeleteDatabase)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PIndexedDBDeleteDatabase -> Result ())
-> Proxy PIndexedDBDeleteDatabase
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PIndexedDBDeleteDatabase -> ())
-> Proxy PIndexedDBDeleteDatabase
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PIndexedDBDeleteDatabase -> ()
forall a b. a -> b -> a
const ()

-- | Delete a range of entries from an object store

-- | Parameters of the 'IndexedDB.deleteObjectStoreEntries' command.
data PIndexedDBDeleteObjectStoreEntries = PIndexedDBDeleteObjectStoreEntries
  {
    -- | At least and at most one of securityOrigin, storageKey must be specified.
    --   Security origin.
    PIndexedDBDeleteObjectStoreEntries -> Maybe Text
pIndexedDBDeleteObjectStoreEntriesSecurityOrigin :: Maybe T.Text,
    -- | Storage key.
    PIndexedDBDeleteObjectStoreEntries -> Maybe Text
pIndexedDBDeleteObjectStoreEntriesStorageKey :: Maybe T.Text,
    PIndexedDBDeleteObjectStoreEntries -> Text
pIndexedDBDeleteObjectStoreEntriesDatabaseName :: T.Text,
    PIndexedDBDeleteObjectStoreEntries -> Text
pIndexedDBDeleteObjectStoreEntriesObjectStoreName :: T.Text,
    -- | Range of entry keys to delete
    PIndexedDBDeleteObjectStoreEntries -> IndexedDBKeyRange
pIndexedDBDeleteObjectStoreEntriesKeyRange :: IndexedDBKeyRange
  }
  deriving (PIndexedDBDeleteObjectStoreEntries
-> PIndexedDBDeleteObjectStoreEntries -> Bool
(PIndexedDBDeleteObjectStoreEntries
 -> PIndexedDBDeleteObjectStoreEntries -> Bool)
-> (PIndexedDBDeleteObjectStoreEntries
    -> PIndexedDBDeleteObjectStoreEntries -> Bool)
-> Eq PIndexedDBDeleteObjectStoreEntries
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PIndexedDBDeleteObjectStoreEntries
-> PIndexedDBDeleteObjectStoreEntries -> Bool
$c/= :: PIndexedDBDeleteObjectStoreEntries
-> PIndexedDBDeleteObjectStoreEntries -> Bool
== :: PIndexedDBDeleteObjectStoreEntries
-> PIndexedDBDeleteObjectStoreEntries -> Bool
$c== :: PIndexedDBDeleteObjectStoreEntries
-> PIndexedDBDeleteObjectStoreEntries -> Bool
Eq, Int -> PIndexedDBDeleteObjectStoreEntries -> ShowS
[PIndexedDBDeleteObjectStoreEntries] -> ShowS
PIndexedDBDeleteObjectStoreEntries -> String
(Int -> PIndexedDBDeleteObjectStoreEntries -> ShowS)
-> (PIndexedDBDeleteObjectStoreEntries -> String)
-> ([PIndexedDBDeleteObjectStoreEntries] -> ShowS)
-> Show PIndexedDBDeleteObjectStoreEntries
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PIndexedDBDeleteObjectStoreEntries] -> ShowS
$cshowList :: [PIndexedDBDeleteObjectStoreEntries] -> ShowS
show :: PIndexedDBDeleteObjectStoreEntries -> String
$cshow :: PIndexedDBDeleteObjectStoreEntries -> String
showsPrec :: Int -> PIndexedDBDeleteObjectStoreEntries -> ShowS
$cshowsPrec :: Int -> PIndexedDBDeleteObjectStoreEntries -> ShowS
Show)
pIndexedDBDeleteObjectStoreEntries
  :: T.Text
  -> T.Text
  {-
  -- | Range of entry keys to delete
  -}
  -> IndexedDBKeyRange
  -> PIndexedDBDeleteObjectStoreEntries
pIndexedDBDeleteObjectStoreEntries :: Text
-> Text -> IndexedDBKeyRange -> PIndexedDBDeleteObjectStoreEntries
pIndexedDBDeleteObjectStoreEntries
  Text
arg_pIndexedDBDeleteObjectStoreEntriesDatabaseName
  Text
arg_pIndexedDBDeleteObjectStoreEntriesObjectStoreName
  IndexedDBKeyRange
arg_pIndexedDBDeleteObjectStoreEntriesKeyRange
  = Maybe Text
-> Maybe Text
-> Text
-> Text
-> IndexedDBKeyRange
-> PIndexedDBDeleteObjectStoreEntries
PIndexedDBDeleteObjectStoreEntries
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Text
arg_pIndexedDBDeleteObjectStoreEntriesDatabaseName
    Text
arg_pIndexedDBDeleteObjectStoreEntriesObjectStoreName
    IndexedDBKeyRange
arg_pIndexedDBDeleteObjectStoreEntriesKeyRange
instance ToJSON PIndexedDBDeleteObjectStoreEntries where
  toJSON :: PIndexedDBDeleteObjectStoreEntries -> Value
toJSON PIndexedDBDeleteObjectStoreEntries
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"securityOrigin" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBDeleteObjectStoreEntries -> Maybe Text
pIndexedDBDeleteObjectStoreEntriesSecurityOrigin PIndexedDBDeleteObjectStoreEntries
p),
    (Text
"storageKey" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBDeleteObjectStoreEntries -> Maybe Text
pIndexedDBDeleteObjectStoreEntriesStorageKey PIndexedDBDeleteObjectStoreEntries
p),
    (Text
"databaseName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PIndexedDBDeleteObjectStoreEntries -> Text
pIndexedDBDeleteObjectStoreEntriesDatabaseName PIndexedDBDeleteObjectStoreEntries
p),
    (Text
"objectStoreName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PIndexedDBDeleteObjectStoreEntries -> Text
pIndexedDBDeleteObjectStoreEntriesObjectStoreName PIndexedDBDeleteObjectStoreEntries
p),
    (Text
"keyRange" Text -> IndexedDBKeyRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (IndexedDBKeyRange -> Pair)
-> Maybe IndexedDBKeyRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IndexedDBKeyRange -> Maybe IndexedDBKeyRange
forall a. a -> Maybe a
Just (PIndexedDBDeleteObjectStoreEntries -> IndexedDBKeyRange
pIndexedDBDeleteObjectStoreEntriesKeyRange PIndexedDBDeleteObjectStoreEntries
p)
    ]
instance Command PIndexedDBDeleteObjectStoreEntries where
  type CommandResponse PIndexedDBDeleteObjectStoreEntries = ()
  commandName :: Proxy PIndexedDBDeleteObjectStoreEntries -> String
commandName Proxy PIndexedDBDeleteObjectStoreEntries
_ = String
"IndexedDB.deleteObjectStoreEntries"
  fromJSON :: Proxy PIndexedDBDeleteObjectStoreEntries
-> Value
-> Result (CommandResponse PIndexedDBDeleteObjectStoreEntries)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PIndexedDBDeleteObjectStoreEntries -> Result ())
-> Proxy PIndexedDBDeleteObjectStoreEntries
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PIndexedDBDeleteObjectStoreEntries -> ())
-> Proxy PIndexedDBDeleteObjectStoreEntries
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PIndexedDBDeleteObjectStoreEntries -> ()
forall a b. a -> b -> a
const ()

-- | Disables events from backend.

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

-- | Enables events from backend.

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

-- | Requests data from object store or index.

-- | Parameters of the 'IndexedDB.requestData' command.
data PIndexedDBRequestData = PIndexedDBRequestData
  {
    -- | At least and at most one of securityOrigin, storageKey must be specified.
    --   Security origin.
    PIndexedDBRequestData -> Maybe Text
pIndexedDBRequestDataSecurityOrigin :: Maybe T.Text,
    -- | Storage key.
    PIndexedDBRequestData -> Maybe Text
pIndexedDBRequestDataStorageKey :: Maybe T.Text,
    -- | Database name.
    PIndexedDBRequestData -> Text
pIndexedDBRequestDataDatabaseName :: T.Text,
    -- | Object store name.
    PIndexedDBRequestData -> Text
pIndexedDBRequestDataObjectStoreName :: T.Text,
    -- | Index name, empty string for object store data requests.
    PIndexedDBRequestData -> Text
pIndexedDBRequestDataIndexName :: T.Text,
    -- | Number of records to skip.
    PIndexedDBRequestData -> Int
pIndexedDBRequestDataSkipCount :: Int,
    -- | Number of records to fetch.
    PIndexedDBRequestData -> Int
pIndexedDBRequestDataPageSize :: Int,
    -- | Key range.
    PIndexedDBRequestData -> Maybe IndexedDBKeyRange
pIndexedDBRequestDataKeyRange :: Maybe IndexedDBKeyRange
  }
  deriving (PIndexedDBRequestData -> PIndexedDBRequestData -> Bool
(PIndexedDBRequestData -> PIndexedDBRequestData -> Bool)
-> (PIndexedDBRequestData -> PIndexedDBRequestData -> Bool)
-> Eq PIndexedDBRequestData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PIndexedDBRequestData -> PIndexedDBRequestData -> Bool
$c/= :: PIndexedDBRequestData -> PIndexedDBRequestData -> Bool
== :: PIndexedDBRequestData -> PIndexedDBRequestData -> Bool
$c== :: PIndexedDBRequestData -> PIndexedDBRequestData -> Bool
Eq, Int -> PIndexedDBRequestData -> ShowS
[PIndexedDBRequestData] -> ShowS
PIndexedDBRequestData -> String
(Int -> PIndexedDBRequestData -> ShowS)
-> (PIndexedDBRequestData -> String)
-> ([PIndexedDBRequestData] -> ShowS)
-> Show PIndexedDBRequestData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PIndexedDBRequestData] -> ShowS
$cshowList :: [PIndexedDBRequestData] -> ShowS
show :: PIndexedDBRequestData -> String
$cshow :: PIndexedDBRequestData -> String
showsPrec :: Int -> PIndexedDBRequestData -> ShowS
$cshowsPrec :: Int -> PIndexedDBRequestData -> ShowS
Show)
pIndexedDBRequestData
  {-
  -- | Database name.
  -}
  :: T.Text
  {-
  -- | Object store name.
  -}
  -> T.Text
  {-
  -- | Index name, empty string for object store data requests.
  -}
  -> T.Text
  {-
  -- | Number of records to skip.
  -}
  -> Int
  {-
  -- | Number of records to fetch.
  -}
  -> Int
  -> PIndexedDBRequestData
pIndexedDBRequestData :: Text -> Text -> Text -> Int -> Int -> PIndexedDBRequestData
pIndexedDBRequestData
  Text
arg_pIndexedDBRequestDataDatabaseName
  Text
arg_pIndexedDBRequestDataObjectStoreName
  Text
arg_pIndexedDBRequestDataIndexName
  Int
arg_pIndexedDBRequestDataSkipCount
  Int
arg_pIndexedDBRequestDataPageSize
  = Maybe Text
-> Maybe Text
-> Text
-> Text
-> Text
-> Int
-> Int
-> Maybe IndexedDBKeyRange
-> PIndexedDBRequestData
PIndexedDBRequestData
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Text
arg_pIndexedDBRequestDataDatabaseName
    Text
arg_pIndexedDBRequestDataObjectStoreName
    Text
arg_pIndexedDBRequestDataIndexName
    Int
arg_pIndexedDBRequestDataSkipCount
    Int
arg_pIndexedDBRequestDataPageSize
    Maybe IndexedDBKeyRange
forall a. Maybe a
Nothing
instance ToJSON PIndexedDBRequestData where
  toJSON :: PIndexedDBRequestData -> Value
toJSON PIndexedDBRequestData
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"securityOrigin" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBRequestData -> Maybe Text
pIndexedDBRequestDataSecurityOrigin PIndexedDBRequestData
p),
    (Text
"storageKey" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBRequestData -> Maybe Text
pIndexedDBRequestDataStorageKey PIndexedDBRequestData
p),
    (Text
"databaseName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PIndexedDBRequestData -> Text
pIndexedDBRequestDataDatabaseName PIndexedDBRequestData
p),
    (Text
"objectStoreName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PIndexedDBRequestData -> Text
pIndexedDBRequestDataObjectStoreName PIndexedDBRequestData
p),
    (Text
"indexName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PIndexedDBRequestData -> Text
pIndexedDBRequestDataIndexName PIndexedDBRequestData
p),
    (Text
"skipCount" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (PIndexedDBRequestData -> Int
pIndexedDBRequestDataSkipCount PIndexedDBRequestData
p),
    (Text
"pageSize" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (PIndexedDBRequestData -> Int
pIndexedDBRequestDataPageSize PIndexedDBRequestData
p),
    (Text
"keyRange" Text -> IndexedDBKeyRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (IndexedDBKeyRange -> Pair)
-> Maybe IndexedDBKeyRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBRequestData -> Maybe IndexedDBKeyRange
pIndexedDBRequestDataKeyRange PIndexedDBRequestData
p)
    ]
data IndexedDBRequestData = IndexedDBRequestData
  {
    -- | Array of object store data entries.
    IndexedDBRequestData -> [IndexedDBDataEntry]
indexedDBRequestDataObjectStoreDataEntries :: [IndexedDBDataEntry],
    -- | If true, there are more entries to fetch in the given range.
    IndexedDBRequestData -> Bool
indexedDBRequestDataHasMore :: Bool
  }
  deriving (IndexedDBRequestData -> IndexedDBRequestData -> Bool
(IndexedDBRequestData -> IndexedDBRequestData -> Bool)
-> (IndexedDBRequestData -> IndexedDBRequestData -> Bool)
-> Eq IndexedDBRequestData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDBRequestData -> IndexedDBRequestData -> Bool
$c/= :: IndexedDBRequestData -> IndexedDBRequestData -> Bool
== :: IndexedDBRequestData -> IndexedDBRequestData -> Bool
$c== :: IndexedDBRequestData -> IndexedDBRequestData -> Bool
Eq, Int -> IndexedDBRequestData -> ShowS
[IndexedDBRequestData] -> ShowS
IndexedDBRequestData -> String
(Int -> IndexedDBRequestData -> ShowS)
-> (IndexedDBRequestData -> String)
-> ([IndexedDBRequestData] -> ShowS)
-> Show IndexedDBRequestData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDBRequestData] -> ShowS
$cshowList :: [IndexedDBRequestData] -> ShowS
show :: IndexedDBRequestData -> String
$cshow :: IndexedDBRequestData -> String
showsPrec :: Int -> IndexedDBRequestData -> ShowS
$cshowsPrec :: Int -> IndexedDBRequestData -> ShowS
Show)
instance FromJSON IndexedDBRequestData where
  parseJSON :: Value -> Parser IndexedDBRequestData
parseJSON = String
-> (Object -> Parser IndexedDBRequestData)
-> Value
-> Parser IndexedDBRequestData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IndexedDBRequestData" ((Object -> Parser IndexedDBRequestData)
 -> Value -> Parser IndexedDBRequestData)
-> (Object -> Parser IndexedDBRequestData)
-> Value
-> Parser IndexedDBRequestData
forall a b. (a -> b) -> a -> b
$ \Object
o -> [IndexedDBDataEntry] -> Bool -> IndexedDBRequestData
IndexedDBRequestData
    ([IndexedDBDataEntry] -> Bool -> IndexedDBRequestData)
-> Parser [IndexedDBDataEntry]
-> Parser (Bool -> IndexedDBRequestData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [IndexedDBDataEntry]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"objectStoreDataEntries"
    Parser (Bool -> IndexedDBRequestData)
-> Parser Bool -> Parser IndexedDBRequestData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"hasMore"
instance Command PIndexedDBRequestData where
  type CommandResponse PIndexedDBRequestData = IndexedDBRequestData
  commandName :: Proxy PIndexedDBRequestData -> String
commandName Proxy PIndexedDBRequestData
_ = String
"IndexedDB.requestData"

-- | Gets metadata of an object store

-- | Parameters of the 'IndexedDB.getMetadata' command.
data PIndexedDBGetMetadata = PIndexedDBGetMetadata
  {
    -- | At least and at most one of securityOrigin, storageKey must be specified.
    --   Security origin.
    PIndexedDBGetMetadata -> Maybe Text
pIndexedDBGetMetadataSecurityOrigin :: Maybe T.Text,
    -- | Storage key.
    PIndexedDBGetMetadata -> Maybe Text
pIndexedDBGetMetadataStorageKey :: Maybe T.Text,
    -- | Database name.
    PIndexedDBGetMetadata -> Text
pIndexedDBGetMetadataDatabaseName :: T.Text,
    -- | Object store name.
    PIndexedDBGetMetadata -> Text
pIndexedDBGetMetadataObjectStoreName :: T.Text
  }
  deriving (PIndexedDBGetMetadata -> PIndexedDBGetMetadata -> Bool
(PIndexedDBGetMetadata -> PIndexedDBGetMetadata -> Bool)
-> (PIndexedDBGetMetadata -> PIndexedDBGetMetadata -> Bool)
-> Eq PIndexedDBGetMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PIndexedDBGetMetadata -> PIndexedDBGetMetadata -> Bool
$c/= :: PIndexedDBGetMetadata -> PIndexedDBGetMetadata -> Bool
== :: PIndexedDBGetMetadata -> PIndexedDBGetMetadata -> Bool
$c== :: PIndexedDBGetMetadata -> PIndexedDBGetMetadata -> Bool
Eq, Int -> PIndexedDBGetMetadata -> ShowS
[PIndexedDBGetMetadata] -> ShowS
PIndexedDBGetMetadata -> String
(Int -> PIndexedDBGetMetadata -> ShowS)
-> (PIndexedDBGetMetadata -> String)
-> ([PIndexedDBGetMetadata] -> ShowS)
-> Show PIndexedDBGetMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PIndexedDBGetMetadata] -> ShowS
$cshowList :: [PIndexedDBGetMetadata] -> ShowS
show :: PIndexedDBGetMetadata -> String
$cshow :: PIndexedDBGetMetadata -> String
showsPrec :: Int -> PIndexedDBGetMetadata -> ShowS
$cshowsPrec :: Int -> PIndexedDBGetMetadata -> ShowS
Show)
pIndexedDBGetMetadata
  {-
  -- | Database name.
  -}
  :: T.Text
  {-
  -- | Object store name.
  -}
  -> T.Text
  -> PIndexedDBGetMetadata
pIndexedDBGetMetadata :: Text -> Text -> PIndexedDBGetMetadata
pIndexedDBGetMetadata
  Text
arg_pIndexedDBGetMetadataDatabaseName
  Text
arg_pIndexedDBGetMetadataObjectStoreName
  = Maybe Text -> Maybe Text -> Text -> Text -> PIndexedDBGetMetadata
PIndexedDBGetMetadata
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Text
arg_pIndexedDBGetMetadataDatabaseName
    Text
arg_pIndexedDBGetMetadataObjectStoreName
instance ToJSON PIndexedDBGetMetadata where
  toJSON :: PIndexedDBGetMetadata -> Value
toJSON PIndexedDBGetMetadata
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"securityOrigin" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBGetMetadata -> Maybe Text
pIndexedDBGetMetadataSecurityOrigin PIndexedDBGetMetadata
p),
    (Text
"storageKey" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBGetMetadata -> Maybe Text
pIndexedDBGetMetadataStorageKey PIndexedDBGetMetadata
p),
    (Text
"databaseName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PIndexedDBGetMetadata -> Text
pIndexedDBGetMetadataDatabaseName PIndexedDBGetMetadata
p),
    (Text
"objectStoreName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PIndexedDBGetMetadata -> Text
pIndexedDBGetMetadataObjectStoreName PIndexedDBGetMetadata
p)
    ]
data IndexedDBGetMetadata = IndexedDBGetMetadata
  {
    -- | the entries count
    IndexedDBGetMetadata -> Double
indexedDBGetMetadataEntriesCount :: Double,
    -- | the current value of key generator, to become the next inserted
    --   key into the object store. Valid if objectStore.autoIncrement
    --   is true.
    IndexedDBGetMetadata -> Double
indexedDBGetMetadataKeyGeneratorValue :: Double
  }
  deriving (IndexedDBGetMetadata -> IndexedDBGetMetadata -> Bool
(IndexedDBGetMetadata -> IndexedDBGetMetadata -> Bool)
-> (IndexedDBGetMetadata -> IndexedDBGetMetadata -> Bool)
-> Eq IndexedDBGetMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDBGetMetadata -> IndexedDBGetMetadata -> Bool
$c/= :: IndexedDBGetMetadata -> IndexedDBGetMetadata -> Bool
== :: IndexedDBGetMetadata -> IndexedDBGetMetadata -> Bool
$c== :: IndexedDBGetMetadata -> IndexedDBGetMetadata -> Bool
Eq, Int -> IndexedDBGetMetadata -> ShowS
[IndexedDBGetMetadata] -> ShowS
IndexedDBGetMetadata -> String
(Int -> IndexedDBGetMetadata -> ShowS)
-> (IndexedDBGetMetadata -> String)
-> ([IndexedDBGetMetadata] -> ShowS)
-> Show IndexedDBGetMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDBGetMetadata] -> ShowS
$cshowList :: [IndexedDBGetMetadata] -> ShowS
show :: IndexedDBGetMetadata -> String
$cshow :: IndexedDBGetMetadata -> String
showsPrec :: Int -> IndexedDBGetMetadata -> ShowS
$cshowsPrec :: Int -> IndexedDBGetMetadata -> ShowS
Show)
instance FromJSON IndexedDBGetMetadata where
  parseJSON :: Value -> Parser IndexedDBGetMetadata
parseJSON = String
-> (Object -> Parser IndexedDBGetMetadata)
-> Value
-> Parser IndexedDBGetMetadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IndexedDBGetMetadata" ((Object -> Parser IndexedDBGetMetadata)
 -> Value -> Parser IndexedDBGetMetadata)
-> (Object -> Parser IndexedDBGetMetadata)
-> Value
-> Parser IndexedDBGetMetadata
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double -> Double -> IndexedDBGetMetadata
IndexedDBGetMetadata
    (Double -> Double -> IndexedDBGetMetadata)
-> Parser Double -> Parser (Double -> IndexedDBGetMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"entriesCount"
    Parser (Double -> IndexedDBGetMetadata)
-> Parser Double -> Parser IndexedDBGetMetadata
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"keyGeneratorValue"
instance Command PIndexedDBGetMetadata where
  type CommandResponse PIndexedDBGetMetadata = IndexedDBGetMetadata
  commandName :: Proxy PIndexedDBGetMetadata -> String
commandName Proxy PIndexedDBGetMetadata
_ = String
"IndexedDB.getMetadata"

-- | Requests database with given name in given frame.

-- | Parameters of the 'IndexedDB.requestDatabase' command.
data PIndexedDBRequestDatabase = PIndexedDBRequestDatabase
  {
    -- | At least and at most one of securityOrigin, storageKey must be specified.
    --   Security origin.
    PIndexedDBRequestDatabase -> Maybe Text
pIndexedDBRequestDatabaseSecurityOrigin :: Maybe T.Text,
    -- | Storage key.
    PIndexedDBRequestDatabase -> Maybe Text
pIndexedDBRequestDatabaseStorageKey :: Maybe T.Text,
    -- | Database name.
    PIndexedDBRequestDatabase -> Text
pIndexedDBRequestDatabaseDatabaseName :: T.Text
  }
  deriving (PIndexedDBRequestDatabase -> PIndexedDBRequestDatabase -> Bool
(PIndexedDBRequestDatabase -> PIndexedDBRequestDatabase -> Bool)
-> (PIndexedDBRequestDatabase -> PIndexedDBRequestDatabase -> Bool)
-> Eq PIndexedDBRequestDatabase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PIndexedDBRequestDatabase -> PIndexedDBRequestDatabase -> Bool
$c/= :: PIndexedDBRequestDatabase -> PIndexedDBRequestDatabase -> Bool
== :: PIndexedDBRequestDatabase -> PIndexedDBRequestDatabase -> Bool
$c== :: PIndexedDBRequestDatabase -> PIndexedDBRequestDatabase -> Bool
Eq, Int -> PIndexedDBRequestDatabase -> ShowS
[PIndexedDBRequestDatabase] -> ShowS
PIndexedDBRequestDatabase -> String
(Int -> PIndexedDBRequestDatabase -> ShowS)
-> (PIndexedDBRequestDatabase -> String)
-> ([PIndexedDBRequestDatabase] -> ShowS)
-> Show PIndexedDBRequestDatabase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PIndexedDBRequestDatabase] -> ShowS
$cshowList :: [PIndexedDBRequestDatabase] -> ShowS
show :: PIndexedDBRequestDatabase -> String
$cshow :: PIndexedDBRequestDatabase -> String
showsPrec :: Int -> PIndexedDBRequestDatabase -> ShowS
$cshowsPrec :: Int -> PIndexedDBRequestDatabase -> ShowS
Show)
pIndexedDBRequestDatabase
  {-
  -- | Database name.
  -}
  :: T.Text
  -> PIndexedDBRequestDatabase
pIndexedDBRequestDatabase :: Text -> PIndexedDBRequestDatabase
pIndexedDBRequestDatabase
  Text
arg_pIndexedDBRequestDatabaseDatabaseName
  = Maybe Text -> Maybe Text -> Text -> PIndexedDBRequestDatabase
PIndexedDBRequestDatabase
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Text
arg_pIndexedDBRequestDatabaseDatabaseName
instance ToJSON PIndexedDBRequestDatabase where
  toJSON :: PIndexedDBRequestDatabase -> Value
toJSON PIndexedDBRequestDatabase
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"securityOrigin" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBRequestDatabase -> Maybe Text
pIndexedDBRequestDatabaseSecurityOrigin PIndexedDBRequestDatabase
p),
    (Text
"storageKey" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBRequestDatabase -> Maybe Text
pIndexedDBRequestDatabaseStorageKey PIndexedDBRequestDatabase
p),
    (Text
"databaseName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PIndexedDBRequestDatabase -> Text
pIndexedDBRequestDatabaseDatabaseName PIndexedDBRequestDatabase
p)
    ]
data IndexedDBRequestDatabase = IndexedDBRequestDatabase
  {
    -- | Database with an array of object stores.
    IndexedDBRequestDatabase -> IndexedDBDatabaseWithObjectStores
indexedDBRequestDatabaseDatabaseWithObjectStores :: IndexedDBDatabaseWithObjectStores
  }
  deriving (IndexedDBRequestDatabase -> IndexedDBRequestDatabase -> Bool
(IndexedDBRequestDatabase -> IndexedDBRequestDatabase -> Bool)
-> (IndexedDBRequestDatabase -> IndexedDBRequestDatabase -> Bool)
-> Eq IndexedDBRequestDatabase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDBRequestDatabase -> IndexedDBRequestDatabase -> Bool
$c/= :: IndexedDBRequestDatabase -> IndexedDBRequestDatabase -> Bool
== :: IndexedDBRequestDatabase -> IndexedDBRequestDatabase -> Bool
$c== :: IndexedDBRequestDatabase -> IndexedDBRequestDatabase -> Bool
Eq, Int -> IndexedDBRequestDatabase -> ShowS
[IndexedDBRequestDatabase] -> ShowS
IndexedDBRequestDatabase -> String
(Int -> IndexedDBRequestDatabase -> ShowS)
-> (IndexedDBRequestDatabase -> String)
-> ([IndexedDBRequestDatabase] -> ShowS)
-> Show IndexedDBRequestDatabase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDBRequestDatabase] -> ShowS
$cshowList :: [IndexedDBRequestDatabase] -> ShowS
show :: IndexedDBRequestDatabase -> String
$cshow :: IndexedDBRequestDatabase -> String
showsPrec :: Int -> IndexedDBRequestDatabase -> ShowS
$cshowsPrec :: Int -> IndexedDBRequestDatabase -> ShowS
Show)
instance FromJSON IndexedDBRequestDatabase where
  parseJSON :: Value -> Parser IndexedDBRequestDatabase
parseJSON = String
-> (Object -> Parser IndexedDBRequestDatabase)
-> Value
-> Parser IndexedDBRequestDatabase
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IndexedDBRequestDatabase" ((Object -> Parser IndexedDBRequestDatabase)
 -> Value -> Parser IndexedDBRequestDatabase)
-> (Object -> Parser IndexedDBRequestDatabase)
-> Value
-> Parser IndexedDBRequestDatabase
forall a b. (a -> b) -> a -> b
$ \Object
o -> IndexedDBDatabaseWithObjectStores -> IndexedDBRequestDatabase
IndexedDBRequestDatabase
    (IndexedDBDatabaseWithObjectStores -> IndexedDBRequestDatabase)
-> Parser IndexedDBDatabaseWithObjectStores
-> Parser IndexedDBRequestDatabase
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser IndexedDBDatabaseWithObjectStores
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"databaseWithObjectStores"
instance Command PIndexedDBRequestDatabase where
  type CommandResponse PIndexedDBRequestDatabase = IndexedDBRequestDatabase
  commandName :: Proxy PIndexedDBRequestDatabase -> String
commandName Proxy PIndexedDBRequestDatabase
_ = String
"IndexedDB.requestDatabase"

-- | Requests database names for given security origin.

-- | Parameters of the 'IndexedDB.requestDatabaseNames' command.
data PIndexedDBRequestDatabaseNames = PIndexedDBRequestDatabaseNames
  {
    -- | At least and at most one of securityOrigin, storageKey must be specified.
    --   Security origin.
    PIndexedDBRequestDatabaseNames -> Maybe Text
pIndexedDBRequestDatabaseNamesSecurityOrigin :: Maybe T.Text,
    -- | Storage key.
    PIndexedDBRequestDatabaseNames -> Maybe Text
pIndexedDBRequestDatabaseNamesStorageKey :: Maybe T.Text
  }
  deriving (PIndexedDBRequestDatabaseNames
-> PIndexedDBRequestDatabaseNames -> Bool
(PIndexedDBRequestDatabaseNames
 -> PIndexedDBRequestDatabaseNames -> Bool)
-> (PIndexedDBRequestDatabaseNames
    -> PIndexedDBRequestDatabaseNames -> Bool)
-> Eq PIndexedDBRequestDatabaseNames
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PIndexedDBRequestDatabaseNames
-> PIndexedDBRequestDatabaseNames -> Bool
$c/= :: PIndexedDBRequestDatabaseNames
-> PIndexedDBRequestDatabaseNames -> Bool
== :: PIndexedDBRequestDatabaseNames
-> PIndexedDBRequestDatabaseNames -> Bool
$c== :: PIndexedDBRequestDatabaseNames
-> PIndexedDBRequestDatabaseNames -> Bool
Eq, Int -> PIndexedDBRequestDatabaseNames -> ShowS
[PIndexedDBRequestDatabaseNames] -> ShowS
PIndexedDBRequestDatabaseNames -> String
(Int -> PIndexedDBRequestDatabaseNames -> ShowS)
-> (PIndexedDBRequestDatabaseNames -> String)
-> ([PIndexedDBRequestDatabaseNames] -> ShowS)
-> Show PIndexedDBRequestDatabaseNames
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PIndexedDBRequestDatabaseNames] -> ShowS
$cshowList :: [PIndexedDBRequestDatabaseNames] -> ShowS
show :: PIndexedDBRequestDatabaseNames -> String
$cshow :: PIndexedDBRequestDatabaseNames -> String
showsPrec :: Int -> PIndexedDBRequestDatabaseNames -> ShowS
$cshowsPrec :: Int -> PIndexedDBRequestDatabaseNames -> ShowS
Show)
pIndexedDBRequestDatabaseNames
  :: PIndexedDBRequestDatabaseNames
pIndexedDBRequestDatabaseNames :: PIndexedDBRequestDatabaseNames
pIndexedDBRequestDatabaseNames
  = Maybe Text -> Maybe Text -> PIndexedDBRequestDatabaseNames
PIndexedDBRequestDatabaseNames
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PIndexedDBRequestDatabaseNames where
  toJSON :: PIndexedDBRequestDatabaseNames -> Value
toJSON PIndexedDBRequestDatabaseNames
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"securityOrigin" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBRequestDatabaseNames -> Maybe Text
pIndexedDBRequestDatabaseNamesSecurityOrigin PIndexedDBRequestDatabaseNames
p),
    (Text
"storageKey" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIndexedDBRequestDatabaseNames -> Maybe Text
pIndexedDBRequestDatabaseNamesStorageKey PIndexedDBRequestDatabaseNames
p)
    ]
data IndexedDBRequestDatabaseNames = IndexedDBRequestDatabaseNames
  {
    -- | Database names for origin.
    IndexedDBRequestDatabaseNames -> [Text]
indexedDBRequestDatabaseNamesDatabaseNames :: [T.Text]
  }
  deriving (IndexedDBRequestDatabaseNames
-> IndexedDBRequestDatabaseNames -> Bool
(IndexedDBRequestDatabaseNames
 -> IndexedDBRequestDatabaseNames -> Bool)
-> (IndexedDBRequestDatabaseNames
    -> IndexedDBRequestDatabaseNames -> Bool)
-> Eq IndexedDBRequestDatabaseNames
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDBRequestDatabaseNames
-> IndexedDBRequestDatabaseNames -> Bool
$c/= :: IndexedDBRequestDatabaseNames
-> IndexedDBRequestDatabaseNames -> Bool
== :: IndexedDBRequestDatabaseNames
-> IndexedDBRequestDatabaseNames -> Bool
$c== :: IndexedDBRequestDatabaseNames
-> IndexedDBRequestDatabaseNames -> Bool
Eq, Int -> IndexedDBRequestDatabaseNames -> ShowS
[IndexedDBRequestDatabaseNames] -> ShowS
IndexedDBRequestDatabaseNames -> String
(Int -> IndexedDBRequestDatabaseNames -> ShowS)
-> (IndexedDBRequestDatabaseNames -> String)
-> ([IndexedDBRequestDatabaseNames] -> ShowS)
-> Show IndexedDBRequestDatabaseNames
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDBRequestDatabaseNames] -> ShowS
$cshowList :: [IndexedDBRequestDatabaseNames] -> ShowS
show :: IndexedDBRequestDatabaseNames -> String
$cshow :: IndexedDBRequestDatabaseNames -> String
showsPrec :: Int -> IndexedDBRequestDatabaseNames -> ShowS
$cshowsPrec :: Int -> IndexedDBRequestDatabaseNames -> ShowS
Show)
instance FromJSON IndexedDBRequestDatabaseNames where
  parseJSON :: Value -> Parser IndexedDBRequestDatabaseNames
parseJSON = String
-> (Object -> Parser IndexedDBRequestDatabaseNames)
-> Value
-> Parser IndexedDBRequestDatabaseNames
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IndexedDBRequestDatabaseNames" ((Object -> Parser IndexedDBRequestDatabaseNames)
 -> Value -> Parser IndexedDBRequestDatabaseNames)
-> (Object -> Parser IndexedDBRequestDatabaseNames)
-> Value
-> Parser IndexedDBRequestDatabaseNames
forall a b. (a -> b) -> a -> b
$ \Object
o -> [Text] -> IndexedDBRequestDatabaseNames
IndexedDBRequestDatabaseNames
    ([Text] -> IndexedDBRequestDatabaseNames)
-> Parser [Text] -> Parser IndexedDBRequestDatabaseNames
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"databaseNames"
instance Command PIndexedDBRequestDatabaseNames where
  type CommandResponse PIndexedDBRequestDatabaseNames = IndexedDBRequestDatabaseNames
  commandName :: Proxy PIndexedDBRequestDatabaseNames -> String
commandName Proxy PIndexedDBRequestDatabaseNames
_ = String
"IndexedDB.requestDatabaseNames"