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


{- |
= Animation

-}


module CDP.Domains.Animation (module CDP.Domains.Animation) where

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

import CDP.Internal.Utils


import CDP.Domains.DOMPageNetworkEmulationSecurity as DOMPageNetworkEmulationSecurity
import CDP.Domains.Runtime as Runtime


-- | Type 'Animation.Animation'.
--   Animation instance.
data AnimationAnimationType = AnimationAnimationTypeCSSTransition | AnimationAnimationTypeCSSAnimation | AnimationAnimationTypeWebAnimation
  deriving (Eq AnimationAnimationType
Eq AnimationAnimationType
-> (AnimationAnimationType -> AnimationAnimationType -> Ordering)
-> (AnimationAnimationType -> AnimationAnimationType -> Bool)
-> (AnimationAnimationType -> AnimationAnimationType -> Bool)
-> (AnimationAnimationType -> AnimationAnimationType -> Bool)
-> (AnimationAnimationType -> AnimationAnimationType -> Bool)
-> (AnimationAnimationType
    -> AnimationAnimationType -> AnimationAnimationType)
-> (AnimationAnimationType
    -> AnimationAnimationType -> AnimationAnimationType)
-> Ord AnimationAnimationType
AnimationAnimationType -> AnimationAnimationType -> Bool
AnimationAnimationType -> AnimationAnimationType -> Ordering
AnimationAnimationType
-> AnimationAnimationType -> AnimationAnimationType
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 :: AnimationAnimationType
-> AnimationAnimationType -> AnimationAnimationType
$cmin :: AnimationAnimationType
-> AnimationAnimationType -> AnimationAnimationType
max :: AnimationAnimationType
-> AnimationAnimationType -> AnimationAnimationType
$cmax :: AnimationAnimationType
-> AnimationAnimationType -> AnimationAnimationType
>= :: AnimationAnimationType -> AnimationAnimationType -> Bool
$c>= :: AnimationAnimationType -> AnimationAnimationType -> Bool
> :: AnimationAnimationType -> AnimationAnimationType -> Bool
$c> :: AnimationAnimationType -> AnimationAnimationType -> Bool
<= :: AnimationAnimationType -> AnimationAnimationType -> Bool
$c<= :: AnimationAnimationType -> AnimationAnimationType -> Bool
< :: AnimationAnimationType -> AnimationAnimationType -> Bool
$c< :: AnimationAnimationType -> AnimationAnimationType -> Bool
compare :: AnimationAnimationType -> AnimationAnimationType -> Ordering
$ccompare :: AnimationAnimationType -> AnimationAnimationType -> Ordering
$cp1Ord :: Eq AnimationAnimationType
Ord, AnimationAnimationType -> AnimationAnimationType -> Bool
(AnimationAnimationType -> AnimationAnimationType -> Bool)
-> (AnimationAnimationType -> AnimationAnimationType -> Bool)
-> Eq AnimationAnimationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnimationAnimationType -> AnimationAnimationType -> Bool
$c/= :: AnimationAnimationType -> AnimationAnimationType -> Bool
== :: AnimationAnimationType -> AnimationAnimationType -> Bool
$c== :: AnimationAnimationType -> AnimationAnimationType -> Bool
Eq, Int -> AnimationAnimationType -> ShowS
[AnimationAnimationType] -> ShowS
AnimationAnimationType -> String
(Int -> AnimationAnimationType -> ShowS)
-> (AnimationAnimationType -> String)
-> ([AnimationAnimationType] -> ShowS)
-> Show AnimationAnimationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnimationAnimationType] -> ShowS
$cshowList :: [AnimationAnimationType] -> ShowS
show :: AnimationAnimationType -> String
$cshow :: AnimationAnimationType -> String
showsPrec :: Int -> AnimationAnimationType -> ShowS
$cshowsPrec :: Int -> AnimationAnimationType -> ShowS
Show, ReadPrec [AnimationAnimationType]
ReadPrec AnimationAnimationType
Int -> ReadS AnimationAnimationType
ReadS [AnimationAnimationType]
(Int -> ReadS AnimationAnimationType)
-> ReadS [AnimationAnimationType]
-> ReadPrec AnimationAnimationType
-> ReadPrec [AnimationAnimationType]
-> Read AnimationAnimationType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AnimationAnimationType]
$creadListPrec :: ReadPrec [AnimationAnimationType]
readPrec :: ReadPrec AnimationAnimationType
$creadPrec :: ReadPrec AnimationAnimationType
readList :: ReadS [AnimationAnimationType]
$creadList :: ReadS [AnimationAnimationType]
readsPrec :: Int -> ReadS AnimationAnimationType
$creadsPrec :: Int -> ReadS AnimationAnimationType
Read)
instance FromJSON AnimationAnimationType where
  parseJSON :: Value -> Parser AnimationAnimationType
parseJSON = String
-> (Text -> Parser AnimationAnimationType)
-> Value
-> Parser AnimationAnimationType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"AnimationAnimationType" ((Text -> Parser AnimationAnimationType)
 -> Value -> Parser AnimationAnimationType)
-> (Text -> Parser AnimationAnimationType)
-> Value
-> Parser AnimationAnimationType
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"CSSTransition" -> AnimationAnimationType -> Parser AnimationAnimationType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnimationAnimationType
AnimationAnimationTypeCSSTransition
    Text
"CSSAnimation" -> AnimationAnimationType -> Parser AnimationAnimationType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnimationAnimationType
AnimationAnimationTypeCSSAnimation
    Text
"WebAnimation" -> AnimationAnimationType -> Parser AnimationAnimationType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnimationAnimationType
AnimationAnimationTypeWebAnimation
    Text
"_" -> String -> Parser AnimationAnimationType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse AnimationAnimationType"
instance ToJSON AnimationAnimationType where
  toJSON :: AnimationAnimationType -> Value
toJSON AnimationAnimationType
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case AnimationAnimationType
v of
    AnimationAnimationType
AnimationAnimationTypeCSSTransition -> Text
"CSSTransition"
    AnimationAnimationType
AnimationAnimationTypeCSSAnimation -> Text
"CSSAnimation"
    AnimationAnimationType
AnimationAnimationTypeWebAnimation -> Text
"WebAnimation"
data AnimationAnimation = AnimationAnimation
  {
    -- | `Animation`'s id.
    AnimationAnimation -> Text
animationAnimationId :: T.Text,
    -- | `Animation`'s name.
    AnimationAnimation -> Text
animationAnimationName :: T.Text,
    -- | `Animation`'s internal paused state.
    AnimationAnimation -> Bool
animationAnimationPausedState :: Bool,
    -- | `Animation`'s play state.
    AnimationAnimation -> Text
animationAnimationPlayState :: T.Text,
    -- | `Animation`'s playback rate.
    AnimationAnimation -> Double
animationAnimationPlaybackRate :: Double,
    -- | `Animation`'s start time.
    AnimationAnimation -> Double
animationAnimationStartTime :: Double,
    -- | `Animation`'s current time.
    AnimationAnimation -> Double
animationAnimationCurrentTime :: Double,
    -- | Animation type of `Animation`.
    AnimationAnimation -> AnimationAnimationType
animationAnimationType :: AnimationAnimationType,
    -- | `Animation`'s source animation node.
    AnimationAnimation -> Maybe AnimationAnimationEffect
animationAnimationSource :: Maybe AnimationAnimationEffect,
    -- | A unique ID for `Animation` representing the sources that triggered this CSS
    --   animation/transition.
    AnimationAnimation -> Maybe Text
animationAnimationCssId :: Maybe T.Text
  }
  deriving (AnimationAnimation -> AnimationAnimation -> Bool
(AnimationAnimation -> AnimationAnimation -> Bool)
-> (AnimationAnimation -> AnimationAnimation -> Bool)
-> Eq AnimationAnimation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnimationAnimation -> AnimationAnimation -> Bool
$c/= :: AnimationAnimation -> AnimationAnimation -> Bool
== :: AnimationAnimation -> AnimationAnimation -> Bool
$c== :: AnimationAnimation -> AnimationAnimation -> Bool
Eq, Int -> AnimationAnimation -> ShowS
[AnimationAnimation] -> ShowS
AnimationAnimation -> String
(Int -> AnimationAnimation -> ShowS)
-> (AnimationAnimation -> String)
-> ([AnimationAnimation] -> ShowS)
-> Show AnimationAnimation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnimationAnimation] -> ShowS
$cshowList :: [AnimationAnimation] -> ShowS
show :: AnimationAnimation -> String
$cshow :: AnimationAnimation -> String
showsPrec :: Int -> AnimationAnimation -> ShowS
$cshowsPrec :: Int -> AnimationAnimation -> ShowS
Show)
instance FromJSON AnimationAnimation where
  parseJSON :: Value -> Parser AnimationAnimation
parseJSON = String
-> (Object -> Parser AnimationAnimation)
-> Value
-> Parser AnimationAnimation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"AnimationAnimation" ((Object -> Parser AnimationAnimation)
 -> Value -> Parser AnimationAnimation)
-> (Object -> Parser AnimationAnimation)
-> Value
-> Parser AnimationAnimation
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> Bool
-> Text
-> Double
-> Double
-> Double
-> AnimationAnimationType
-> Maybe AnimationAnimationEffect
-> Maybe Text
-> AnimationAnimation
AnimationAnimation
    (Text
 -> Text
 -> Bool
 -> Text
 -> Double
 -> Double
 -> Double
 -> AnimationAnimationType
 -> Maybe AnimationAnimationEffect
 -> Maybe Text
 -> AnimationAnimation)
-> Parser Text
-> Parser
     (Text
      -> Bool
      -> Text
      -> Double
      -> Double
      -> Double
      -> AnimationAnimationType
      -> Maybe AnimationAnimationEffect
      -> Maybe Text
      -> AnimationAnimation)
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
"id"
    Parser
  (Text
   -> Bool
   -> Text
   -> Double
   -> Double
   -> Double
   -> AnimationAnimationType
   -> Maybe AnimationAnimationEffect
   -> Maybe Text
   -> AnimationAnimation)
-> Parser Text
-> Parser
     (Bool
      -> Text
      -> Double
      -> Double
      -> Double
      -> AnimationAnimationType
      -> Maybe AnimationAnimationEffect
      -> Maybe Text
      -> AnimationAnimation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    Parser
  (Bool
   -> Text
   -> Double
   -> Double
   -> Double
   -> AnimationAnimationType
   -> Maybe AnimationAnimationEffect
   -> Maybe Text
   -> AnimationAnimation)
-> Parser Bool
-> Parser
     (Text
      -> Double
      -> Double
      -> Double
      -> AnimationAnimationType
      -> Maybe AnimationAnimationEffect
      -> Maybe Text
      -> AnimationAnimation)
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
"pausedState"
    Parser
  (Text
   -> Double
   -> Double
   -> Double
   -> AnimationAnimationType
   -> Maybe AnimationAnimationEffect
   -> Maybe Text
   -> AnimationAnimation)
-> Parser Text
-> Parser
     (Double
      -> Double
      -> Double
      -> AnimationAnimationType
      -> Maybe AnimationAnimationEffect
      -> Maybe Text
      -> AnimationAnimation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"playState"
    Parser
  (Double
   -> Double
   -> Double
   -> AnimationAnimationType
   -> Maybe AnimationAnimationEffect
   -> Maybe Text
   -> AnimationAnimation)
-> Parser Double
-> Parser
     (Double
      -> Double
      -> AnimationAnimationType
      -> Maybe AnimationAnimationEffect
      -> Maybe Text
      -> AnimationAnimation)
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
"playbackRate"
    Parser
  (Double
   -> Double
   -> AnimationAnimationType
   -> Maybe AnimationAnimationEffect
   -> Maybe Text
   -> AnimationAnimation)
-> Parser Double
-> Parser
     (Double
      -> AnimationAnimationType
      -> Maybe AnimationAnimationEffect
      -> Maybe Text
      -> AnimationAnimation)
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
"startTime"
    Parser
  (Double
   -> AnimationAnimationType
   -> Maybe AnimationAnimationEffect
   -> Maybe Text
   -> AnimationAnimation)
-> Parser Double
-> Parser
     (AnimationAnimationType
      -> Maybe AnimationAnimationEffect
      -> Maybe Text
      -> AnimationAnimation)
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
"currentTime"
    Parser
  (AnimationAnimationType
   -> Maybe AnimationAnimationEffect
   -> Maybe Text
   -> AnimationAnimation)
-> Parser AnimationAnimationType
-> Parser
     (Maybe AnimationAnimationEffect
      -> Maybe Text -> AnimationAnimation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser AnimationAnimationType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"type"
    Parser
  (Maybe AnimationAnimationEffect
   -> Maybe Text -> AnimationAnimation)
-> Parser (Maybe AnimationAnimationEffect)
-> Parser (Maybe Text -> AnimationAnimation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe AnimationAnimationEffect)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"source"
    Parser (Maybe Text -> AnimationAnimation)
-> Parser (Maybe Text) -> Parser AnimationAnimation
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
"cssId"
instance ToJSON AnimationAnimation where
  toJSON :: AnimationAnimation -> Value
toJSON AnimationAnimation
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
"id" 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 (AnimationAnimation -> Text
animationAnimationId AnimationAnimation
p),
    (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 (AnimationAnimation -> Text
animationAnimationName AnimationAnimation
p),
    (Text
"pausedState" 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 (AnimationAnimation -> Bool
animationAnimationPausedState AnimationAnimation
p),
    (Text
"playState" 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 (AnimationAnimation -> Text
animationAnimationPlayState AnimationAnimation
p),
    (Text
"playbackRate" 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 (AnimationAnimation -> Double
animationAnimationPlaybackRate AnimationAnimation
p),
    (Text
"startTime" 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 (AnimationAnimation -> Double
animationAnimationStartTime AnimationAnimation
p),
    (Text
"currentTime" 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 (AnimationAnimation -> Double
animationAnimationCurrentTime AnimationAnimation
p),
    (Text
"type" Text -> AnimationAnimationType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (AnimationAnimationType -> Pair)
-> Maybe AnimationAnimationType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnimationAnimationType -> Maybe AnimationAnimationType
forall a. a -> Maybe a
Just (AnimationAnimation -> AnimationAnimationType
animationAnimationType AnimationAnimation
p),
    (Text
"source" Text -> AnimationAnimationEffect -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (AnimationAnimationEffect -> Pair)
-> Maybe AnimationAnimationEffect -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AnimationAnimation -> Maybe AnimationAnimationEffect
animationAnimationSource AnimationAnimation
p),
    (Text
"cssId" 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
<$> (AnimationAnimation -> Maybe Text
animationAnimationCssId AnimationAnimation
p)
    ]

-- | Type 'Animation.AnimationEffect'.
--   AnimationEffect instance
data AnimationAnimationEffect = AnimationAnimationEffect
  {
    -- | `AnimationEffect`'s delay.
    AnimationAnimationEffect -> Double
animationAnimationEffectDelay :: Double,
    -- | `AnimationEffect`'s end delay.
    AnimationAnimationEffect -> Double
animationAnimationEffectEndDelay :: Double,
    -- | `AnimationEffect`'s iteration start.
    AnimationAnimationEffect -> Double
animationAnimationEffectIterationStart :: Double,
    -- | `AnimationEffect`'s iterations.
    AnimationAnimationEffect -> Double
animationAnimationEffectIterations :: Double,
    -- | `AnimationEffect`'s iteration duration.
    AnimationAnimationEffect -> Double
animationAnimationEffectDuration :: Double,
    -- | `AnimationEffect`'s playback direction.
    AnimationAnimationEffect -> Text
animationAnimationEffectDirection :: T.Text,
    -- | `AnimationEffect`'s fill mode.
    AnimationAnimationEffect -> Text
animationAnimationEffectFill :: T.Text,
    -- | `AnimationEffect`'s target node.
    AnimationAnimationEffect -> Maybe Int
animationAnimationEffectBackendNodeId :: Maybe DOMPageNetworkEmulationSecurity.DOMBackendNodeId,
    -- | `AnimationEffect`'s keyframes.
    AnimationAnimationEffect -> Maybe AnimationKeyframesRule
animationAnimationEffectKeyframesRule :: Maybe AnimationKeyframesRule,
    -- | `AnimationEffect`'s timing function.
    AnimationAnimationEffect -> Text
animationAnimationEffectEasing :: T.Text
  }
  deriving (AnimationAnimationEffect -> AnimationAnimationEffect -> Bool
(AnimationAnimationEffect -> AnimationAnimationEffect -> Bool)
-> (AnimationAnimationEffect -> AnimationAnimationEffect -> Bool)
-> Eq AnimationAnimationEffect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnimationAnimationEffect -> AnimationAnimationEffect -> Bool
$c/= :: AnimationAnimationEffect -> AnimationAnimationEffect -> Bool
== :: AnimationAnimationEffect -> AnimationAnimationEffect -> Bool
$c== :: AnimationAnimationEffect -> AnimationAnimationEffect -> Bool
Eq, Int -> AnimationAnimationEffect -> ShowS
[AnimationAnimationEffect] -> ShowS
AnimationAnimationEffect -> String
(Int -> AnimationAnimationEffect -> ShowS)
-> (AnimationAnimationEffect -> String)
-> ([AnimationAnimationEffect] -> ShowS)
-> Show AnimationAnimationEffect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnimationAnimationEffect] -> ShowS
$cshowList :: [AnimationAnimationEffect] -> ShowS
show :: AnimationAnimationEffect -> String
$cshow :: AnimationAnimationEffect -> String
showsPrec :: Int -> AnimationAnimationEffect -> ShowS
$cshowsPrec :: Int -> AnimationAnimationEffect -> ShowS
Show)
instance FromJSON AnimationAnimationEffect where
  parseJSON :: Value -> Parser AnimationAnimationEffect
parseJSON = String
-> (Object -> Parser AnimationAnimationEffect)
-> Value
-> Parser AnimationAnimationEffect
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"AnimationAnimationEffect" ((Object -> Parser AnimationAnimationEffect)
 -> Value -> Parser AnimationAnimationEffect)
-> (Object -> Parser AnimationAnimationEffect)
-> Value
-> Parser AnimationAnimationEffect
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double
-> Double
-> Double
-> Double
-> Double
-> Text
-> Text
-> Maybe Int
-> Maybe AnimationKeyframesRule
-> Text
-> AnimationAnimationEffect
AnimationAnimationEffect
    (Double
 -> Double
 -> Double
 -> Double
 -> Double
 -> Text
 -> Text
 -> Maybe Int
 -> Maybe AnimationKeyframesRule
 -> Text
 -> AnimationAnimationEffect)
-> Parser Double
-> Parser
     (Double
      -> Double
      -> Double
      -> Double
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe AnimationKeyframesRule
      -> Text
      -> AnimationAnimationEffect)
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
"delay"
    Parser
  (Double
   -> Double
   -> Double
   -> Double
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe AnimationKeyframesRule
   -> Text
   -> AnimationAnimationEffect)
-> Parser Double
-> Parser
     (Double
      -> Double
      -> Double
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe AnimationKeyframesRule
      -> Text
      -> AnimationAnimationEffect)
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
"endDelay"
    Parser
  (Double
   -> Double
   -> Double
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe AnimationKeyframesRule
   -> Text
   -> AnimationAnimationEffect)
-> Parser Double
-> Parser
     (Double
      -> Double
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe AnimationKeyframesRule
      -> Text
      -> AnimationAnimationEffect)
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
"iterationStart"
    Parser
  (Double
   -> Double
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe AnimationKeyframesRule
   -> Text
   -> AnimationAnimationEffect)
-> Parser Double
-> Parser
     (Double
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe AnimationKeyframesRule
      -> Text
      -> AnimationAnimationEffect)
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
"iterations"
    Parser
  (Double
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe AnimationKeyframesRule
   -> Text
   -> AnimationAnimationEffect)
-> Parser Double
-> Parser
     (Text
      -> Text
      -> Maybe Int
      -> Maybe AnimationKeyframesRule
      -> Text
      -> AnimationAnimationEffect)
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
"duration"
    Parser
  (Text
   -> Text
   -> Maybe Int
   -> Maybe AnimationKeyframesRule
   -> Text
   -> AnimationAnimationEffect)
-> Parser Text
-> Parser
     (Text
      -> Maybe Int
      -> Maybe AnimationKeyframesRule
      -> Text
      -> AnimationAnimationEffect)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"direction"
    Parser
  (Text
   -> Maybe Int
   -> Maybe AnimationKeyframesRule
   -> Text
   -> AnimationAnimationEffect)
-> Parser Text
-> Parser
     (Maybe Int
      -> Maybe AnimationKeyframesRule
      -> Text
      -> AnimationAnimationEffect)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"fill"
    Parser
  (Maybe Int
   -> Maybe AnimationKeyframesRule
   -> Text
   -> AnimationAnimationEffect)
-> Parser (Maybe Int)
-> Parser
     (Maybe AnimationKeyframesRule -> Text -> AnimationAnimationEffect)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"backendNodeId"
    Parser
  (Maybe AnimationKeyframesRule -> Text -> AnimationAnimationEffect)
-> Parser (Maybe AnimationKeyframesRule)
-> Parser (Text -> AnimationAnimationEffect)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe AnimationKeyframesRule)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"keyframesRule"
    Parser (Text -> AnimationAnimationEffect)
-> Parser Text -> Parser AnimationAnimationEffect
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"easing"
instance ToJSON AnimationAnimationEffect where
  toJSON :: AnimationAnimationEffect -> Value
toJSON AnimationAnimationEffect
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
"delay" 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 (AnimationAnimationEffect -> Double
animationAnimationEffectDelay AnimationAnimationEffect
p),
    (Text
"endDelay" 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 (AnimationAnimationEffect -> Double
animationAnimationEffectEndDelay AnimationAnimationEffect
p),
    (Text
"iterationStart" 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 (AnimationAnimationEffect -> Double
animationAnimationEffectIterationStart AnimationAnimationEffect
p),
    (Text
"iterations" 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 (AnimationAnimationEffect -> Double
animationAnimationEffectIterations AnimationAnimationEffect
p),
    (Text
"duration" 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 (AnimationAnimationEffect -> Double
animationAnimationEffectDuration AnimationAnimationEffect
p),
    (Text
"direction" 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 (AnimationAnimationEffect -> Text
animationAnimationEffectDirection AnimationAnimationEffect
p),
    (Text
"fill" 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 (AnimationAnimationEffect -> Text
animationAnimationEffectFill AnimationAnimationEffect
p),
    (Text
"backendNodeId" 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
<$> (AnimationAnimationEffect -> Maybe Int
animationAnimationEffectBackendNodeId AnimationAnimationEffect
p),
    (Text
"keyframesRule" Text -> AnimationKeyframesRule -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (AnimationKeyframesRule -> Pair)
-> Maybe AnimationKeyframesRule -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AnimationAnimationEffect -> Maybe AnimationKeyframesRule
animationAnimationEffectKeyframesRule AnimationAnimationEffect
p),
    (Text
"easing" 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 (AnimationAnimationEffect -> Text
animationAnimationEffectEasing AnimationAnimationEffect
p)
    ]

-- | Type 'Animation.KeyframesRule'.
--   Keyframes Rule
data AnimationKeyframesRule = AnimationKeyframesRule
  {
    -- | CSS keyframed animation's name.
    AnimationKeyframesRule -> Maybe Text
animationKeyframesRuleName :: Maybe T.Text,
    -- | List of animation keyframes.
    AnimationKeyframesRule -> [AnimationKeyframeStyle]
animationKeyframesRuleKeyframes :: [AnimationKeyframeStyle]
  }
  deriving (AnimationKeyframesRule -> AnimationKeyframesRule -> Bool
(AnimationKeyframesRule -> AnimationKeyframesRule -> Bool)
-> (AnimationKeyframesRule -> AnimationKeyframesRule -> Bool)
-> Eq AnimationKeyframesRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnimationKeyframesRule -> AnimationKeyframesRule -> Bool
$c/= :: AnimationKeyframesRule -> AnimationKeyframesRule -> Bool
== :: AnimationKeyframesRule -> AnimationKeyframesRule -> Bool
$c== :: AnimationKeyframesRule -> AnimationKeyframesRule -> Bool
Eq, Int -> AnimationKeyframesRule -> ShowS
[AnimationKeyframesRule] -> ShowS
AnimationKeyframesRule -> String
(Int -> AnimationKeyframesRule -> ShowS)
-> (AnimationKeyframesRule -> String)
-> ([AnimationKeyframesRule] -> ShowS)
-> Show AnimationKeyframesRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnimationKeyframesRule] -> ShowS
$cshowList :: [AnimationKeyframesRule] -> ShowS
show :: AnimationKeyframesRule -> String
$cshow :: AnimationKeyframesRule -> String
showsPrec :: Int -> AnimationKeyframesRule -> ShowS
$cshowsPrec :: Int -> AnimationKeyframesRule -> ShowS
Show)
instance FromJSON AnimationKeyframesRule where
  parseJSON :: Value -> Parser AnimationKeyframesRule
parseJSON = String
-> (Object -> Parser AnimationKeyframesRule)
-> Value
-> Parser AnimationKeyframesRule
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"AnimationKeyframesRule" ((Object -> Parser AnimationKeyframesRule)
 -> Value -> Parser AnimationKeyframesRule)
-> (Object -> Parser AnimationKeyframesRule)
-> Value
-> Parser AnimationKeyframesRule
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text -> [AnimationKeyframeStyle] -> AnimationKeyframesRule
AnimationKeyframesRule
    (Maybe Text -> [AnimationKeyframeStyle] -> AnimationKeyframesRule)
-> Parser (Maybe Text)
-> Parser ([AnimationKeyframeStyle] -> AnimationKeyframesRule)
forall (f :: * -> *) a b. Functor 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
"name"
    Parser ([AnimationKeyframeStyle] -> AnimationKeyframesRule)
-> Parser [AnimationKeyframeStyle] -> Parser AnimationKeyframesRule
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [AnimationKeyframeStyle]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"keyframes"
instance ToJSON AnimationKeyframesRule where
  toJSON :: AnimationKeyframesRule -> Value
toJSON AnimationKeyframesRule
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
<$> (AnimationKeyframesRule -> Maybe Text
animationKeyframesRuleName AnimationKeyframesRule
p),
    (Text
"keyframes" Text -> [AnimationKeyframeStyle] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([AnimationKeyframeStyle] -> Pair)
-> Maybe [AnimationKeyframeStyle] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AnimationKeyframeStyle] -> Maybe [AnimationKeyframeStyle]
forall a. a -> Maybe a
Just (AnimationKeyframesRule -> [AnimationKeyframeStyle]
animationKeyframesRuleKeyframes AnimationKeyframesRule
p)
    ]

-- | Type 'Animation.KeyframeStyle'.
--   Keyframe Style
data AnimationKeyframeStyle = AnimationKeyframeStyle
  {
    -- | Keyframe's time offset.
    AnimationKeyframeStyle -> Text
animationKeyframeStyleOffset :: T.Text,
    -- | `AnimationEffect`'s timing function.
    AnimationKeyframeStyle -> Text
animationKeyframeStyleEasing :: T.Text
  }
  deriving (AnimationKeyframeStyle -> AnimationKeyframeStyle -> Bool
(AnimationKeyframeStyle -> AnimationKeyframeStyle -> Bool)
-> (AnimationKeyframeStyle -> AnimationKeyframeStyle -> Bool)
-> Eq AnimationKeyframeStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnimationKeyframeStyle -> AnimationKeyframeStyle -> Bool
$c/= :: AnimationKeyframeStyle -> AnimationKeyframeStyle -> Bool
== :: AnimationKeyframeStyle -> AnimationKeyframeStyle -> Bool
$c== :: AnimationKeyframeStyle -> AnimationKeyframeStyle -> Bool
Eq, Int -> AnimationKeyframeStyle -> ShowS
[AnimationKeyframeStyle] -> ShowS
AnimationKeyframeStyle -> String
(Int -> AnimationKeyframeStyle -> ShowS)
-> (AnimationKeyframeStyle -> String)
-> ([AnimationKeyframeStyle] -> ShowS)
-> Show AnimationKeyframeStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnimationKeyframeStyle] -> ShowS
$cshowList :: [AnimationKeyframeStyle] -> ShowS
show :: AnimationKeyframeStyle -> String
$cshow :: AnimationKeyframeStyle -> String
showsPrec :: Int -> AnimationKeyframeStyle -> ShowS
$cshowsPrec :: Int -> AnimationKeyframeStyle -> ShowS
Show)
instance FromJSON AnimationKeyframeStyle where
  parseJSON :: Value -> Parser AnimationKeyframeStyle
parseJSON = String
-> (Object -> Parser AnimationKeyframeStyle)
-> Value
-> Parser AnimationKeyframeStyle
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"AnimationKeyframeStyle" ((Object -> Parser AnimationKeyframeStyle)
 -> Value -> Parser AnimationKeyframeStyle)
-> (Object -> Parser AnimationKeyframeStyle)
-> Value
-> Parser AnimationKeyframeStyle
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> AnimationKeyframeStyle
AnimationKeyframeStyle
    (Text -> Text -> AnimationKeyframeStyle)
-> Parser Text -> Parser (Text -> AnimationKeyframeStyle)
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
"offset"
    Parser (Text -> AnimationKeyframeStyle)
-> Parser Text -> Parser AnimationKeyframeStyle
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"easing"
instance ToJSON AnimationKeyframeStyle where
  toJSON :: AnimationKeyframeStyle -> Value
toJSON AnimationKeyframeStyle
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
"offset" 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 (AnimationKeyframeStyle -> Text
animationKeyframeStyleOffset AnimationKeyframeStyle
p),
    (Text
"easing" 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 (AnimationKeyframeStyle -> Text
animationKeyframeStyleEasing AnimationKeyframeStyle
p)
    ]

-- | Type of the 'Animation.animationCanceled' event.
data AnimationAnimationCanceled = AnimationAnimationCanceled
  {
    -- | Id of the animation that was cancelled.
    AnimationAnimationCanceled -> Text
animationAnimationCanceledId :: T.Text
  }
  deriving (AnimationAnimationCanceled -> AnimationAnimationCanceled -> Bool
(AnimationAnimationCanceled -> AnimationAnimationCanceled -> Bool)
-> (AnimationAnimationCanceled
    -> AnimationAnimationCanceled -> Bool)
-> Eq AnimationAnimationCanceled
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnimationAnimationCanceled -> AnimationAnimationCanceled -> Bool
$c/= :: AnimationAnimationCanceled -> AnimationAnimationCanceled -> Bool
== :: AnimationAnimationCanceled -> AnimationAnimationCanceled -> Bool
$c== :: AnimationAnimationCanceled -> AnimationAnimationCanceled -> Bool
Eq, Int -> AnimationAnimationCanceled -> ShowS
[AnimationAnimationCanceled] -> ShowS
AnimationAnimationCanceled -> String
(Int -> AnimationAnimationCanceled -> ShowS)
-> (AnimationAnimationCanceled -> String)
-> ([AnimationAnimationCanceled] -> ShowS)
-> Show AnimationAnimationCanceled
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnimationAnimationCanceled] -> ShowS
$cshowList :: [AnimationAnimationCanceled] -> ShowS
show :: AnimationAnimationCanceled -> String
$cshow :: AnimationAnimationCanceled -> String
showsPrec :: Int -> AnimationAnimationCanceled -> ShowS
$cshowsPrec :: Int -> AnimationAnimationCanceled -> ShowS
Show)
instance FromJSON AnimationAnimationCanceled where
  parseJSON :: Value -> Parser AnimationAnimationCanceled
parseJSON = String
-> (Object -> Parser AnimationAnimationCanceled)
-> Value
-> Parser AnimationAnimationCanceled
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"AnimationAnimationCanceled" ((Object -> Parser AnimationAnimationCanceled)
 -> Value -> Parser AnimationAnimationCanceled)
-> (Object -> Parser AnimationAnimationCanceled)
-> Value
-> Parser AnimationAnimationCanceled
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> AnimationAnimationCanceled
AnimationAnimationCanceled
    (Text -> AnimationAnimationCanceled)
-> Parser Text -> Parser AnimationAnimationCanceled
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
"id"
instance Event AnimationAnimationCanceled where
  eventName :: Proxy AnimationAnimationCanceled -> String
eventName Proxy AnimationAnimationCanceled
_ = String
"Animation.animationCanceled"

-- | Type of the 'Animation.animationCreated' event.
data AnimationAnimationCreated = AnimationAnimationCreated
  {
    -- | Id of the animation that was created.
    AnimationAnimationCreated -> Text
animationAnimationCreatedId :: T.Text
  }
  deriving (AnimationAnimationCreated -> AnimationAnimationCreated -> Bool
(AnimationAnimationCreated -> AnimationAnimationCreated -> Bool)
-> (AnimationAnimationCreated -> AnimationAnimationCreated -> Bool)
-> Eq AnimationAnimationCreated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnimationAnimationCreated -> AnimationAnimationCreated -> Bool
$c/= :: AnimationAnimationCreated -> AnimationAnimationCreated -> Bool
== :: AnimationAnimationCreated -> AnimationAnimationCreated -> Bool
$c== :: AnimationAnimationCreated -> AnimationAnimationCreated -> Bool
Eq, Int -> AnimationAnimationCreated -> ShowS
[AnimationAnimationCreated] -> ShowS
AnimationAnimationCreated -> String
(Int -> AnimationAnimationCreated -> ShowS)
-> (AnimationAnimationCreated -> String)
-> ([AnimationAnimationCreated] -> ShowS)
-> Show AnimationAnimationCreated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnimationAnimationCreated] -> ShowS
$cshowList :: [AnimationAnimationCreated] -> ShowS
show :: AnimationAnimationCreated -> String
$cshow :: AnimationAnimationCreated -> String
showsPrec :: Int -> AnimationAnimationCreated -> ShowS
$cshowsPrec :: Int -> AnimationAnimationCreated -> ShowS
Show)
instance FromJSON AnimationAnimationCreated where
  parseJSON :: Value -> Parser AnimationAnimationCreated
parseJSON = String
-> (Object -> Parser AnimationAnimationCreated)
-> Value
-> Parser AnimationAnimationCreated
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"AnimationAnimationCreated" ((Object -> Parser AnimationAnimationCreated)
 -> Value -> Parser AnimationAnimationCreated)
-> (Object -> Parser AnimationAnimationCreated)
-> Value
-> Parser AnimationAnimationCreated
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> AnimationAnimationCreated
AnimationAnimationCreated
    (Text -> AnimationAnimationCreated)
-> Parser Text -> Parser AnimationAnimationCreated
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
"id"
instance Event AnimationAnimationCreated where
  eventName :: Proxy AnimationAnimationCreated -> String
eventName Proxy AnimationAnimationCreated
_ = String
"Animation.animationCreated"

-- | Type of the 'Animation.animationStarted' event.
data AnimationAnimationStarted = AnimationAnimationStarted
  {
    -- | Animation that was started.
    AnimationAnimationStarted -> AnimationAnimation
animationAnimationStartedAnimation :: AnimationAnimation
  }
  deriving (AnimationAnimationStarted -> AnimationAnimationStarted -> Bool
(AnimationAnimationStarted -> AnimationAnimationStarted -> Bool)
-> (AnimationAnimationStarted -> AnimationAnimationStarted -> Bool)
-> Eq AnimationAnimationStarted
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnimationAnimationStarted -> AnimationAnimationStarted -> Bool
$c/= :: AnimationAnimationStarted -> AnimationAnimationStarted -> Bool
== :: AnimationAnimationStarted -> AnimationAnimationStarted -> Bool
$c== :: AnimationAnimationStarted -> AnimationAnimationStarted -> Bool
Eq, Int -> AnimationAnimationStarted -> ShowS
[AnimationAnimationStarted] -> ShowS
AnimationAnimationStarted -> String
(Int -> AnimationAnimationStarted -> ShowS)
-> (AnimationAnimationStarted -> String)
-> ([AnimationAnimationStarted] -> ShowS)
-> Show AnimationAnimationStarted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnimationAnimationStarted] -> ShowS
$cshowList :: [AnimationAnimationStarted] -> ShowS
show :: AnimationAnimationStarted -> String
$cshow :: AnimationAnimationStarted -> String
showsPrec :: Int -> AnimationAnimationStarted -> ShowS
$cshowsPrec :: Int -> AnimationAnimationStarted -> ShowS
Show)
instance FromJSON AnimationAnimationStarted where
  parseJSON :: Value -> Parser AnimationAnimationStarted
parseJSON = String
-> (Object -> Parser AnimationAnimationStarted)
-> Value
-> Parser AnimationAnimationStarted
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"AnimationAnimationStarted" ((Object -> Parser AnimationAnimationStarted)
 -> Value -> Parser AnimationAnimationStarted)
-> (Object -> Parser AnimationAnimationStarted)
-> Value
-> Parser AnimationAnimationStarted
forall a b. (a -> b) -> a -> b
$ \Object
o -> AnimationAnimation -> AnimationAnimationStarted
AnimationAnimationStarted
    (AnimationAnimation -> AnimationAnimationStarted)
-> Parser AnimationAnimation -> Parser AnimationAnimationStarted
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser AnimationAnimation
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"animation"
instance Event AnimationAnimationStarted where
  eventName :: Proxy AnimationAnimationStarted -> String
eventName Proxy AnimationAnimationStarted
_ = String
"Animation.animationStarted"

-- | Disables animation domain notifications.

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

-- | Enables animation domain notifications.

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

-- | Returns the current time of the an animation.

-- | Parameters of the 'Animation.getCurrentTime' command.
data PAnimationGetCurrentTime = PAnimationGetCurrentTime
  {
    -- | Id of animation.
    PAnimationGetCurrentTime -> Text
pAnimationGetCurrentTimeId :: T.Text
  }
  deriving (PAnimationGetCurrentTime -> PAnimationGetCurrentTime -> Bool
(PAnimationGetCurrentTime -> PAnimationGetCurrentTime -> Bool)
-> (PAnimationGetCurrentTime -> PAnimationGetCurrentTime -> Bool)
-> Eq PAnimationGetCurrentTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PAnimationGetCurrentTime -> PAnimationGetCurrentTime -> Bool
$c/= :: PAnimationGetCurrentTime -> PAnimationGetCurrentTime -> Bool
== :: PAnimationGetCurrentTime -> PAnimationGetCurrentTime -> Bool
$c== :: PAnimationGetCurrentTime -> PAnimationGetCurrentTime -> Bool
Eq, Int -> PAnimationGetCurrentTime -> ShowS
[PAnimationGetCurrentTime] -> ShowS
PAnimationGetCurrentTime -> String
(Int -> PAnimationGetCurrentTime -> ShowS)
-> (PAnimationGetCurrentTime -> String)
-> ([PAnimationGetCurrentTime] -> ShowS)
-> Show PAnimationGetCurrentTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PAnimationGetCurrentTime] -> ShowS
$cshowList :: [PAnimationGetCurrentTime] -> ShowS
show :: PAnimationGetCurrentTime -> String
$cshow :: PAnimationGetCurrentTime -> String
showsPrec :: Int -> PAnimationGetCurrentTime -> ShowS
$cshowsPrec :: Int -> PAnimationGetCurrentTime -> ShowS
Show)
pAnimationGetCurrentTime
  {-
  -- | Id of animation.
  -}
  :: T.Text
  -> PAnimationGetCurrentTime
pAnimationGetCurrentTime :: Text -> PAnimationGetCurrentTime
pAnimationGetCurrentTime
  Text
arg_pAnimationGetCurrentTimeId
  = Text -> PAnimationGetCurrentTime
PAnimationGetCurrentTime
    Text
arg_pAnimationGetCurrentTimeId
instance ToJSON PAnimationGetCurrentTime where
  toJSON :: PAnimationGetCurrentTime -> Value
toJSON PAnimationGetCurrentTime
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
"id" 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 (PAnimationGetCurrentTime -> Text
pAnimationGetCurrentTimeId PAnimationGetCurrentTime
p)
    ]
data AnimationGetCurrentTime = AnimationGetCurrentTime
  {
    -- | Current time of the page.
    AnimationGetCurrentTime -> Double
animationGetCurrentTimeCurrentTime :: Double
  }
  deriving (AnimationGetCurrentTime -> AnimationGetCurrentTime -> Bool
(AnimationGetCurrentTime -> AnimationGetCurrentTime -> Bool)
-> (AnimationGetCurrentTime -> AnimationGetCurrentTime -> Bool)
-> Eq AnimationGetCurrentTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnimationGetCurrentTime -> AnimationGetCurrentTime -> Bool
$c/= :: AnimationGetCurrentTime -> AnimationGetCurrentTime -> Bool
== :: AnimationGetCurrentTime -> AnimationGetCurrentTime -> Bool
$c== :: AnimationGetCurrentTime -> AnimationGetCurrentTime -> Bool
Eq, Int -> AnimationGetCurrentTime -> ShowS
[AnimationGetCurrentTime] -> ShowS
AnimationGetCurrentTime -> String
(Int -> AnimationGetCurrentTime -> ShowS)
-> (AnimationGetCurrentTime -> String)
-> ([AnimationGetCurrentTime] -> ShowS)
-> Show AnimationGetCurrentTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnimationGetCurrentTime] -> ShowS
$cshowList :: [AnimationGetCurrentTime] -> ShowS
show :: AnimationGetCurrentTime -> String
$cshow :: AnimationGetCurrentTime -> String
showsPrec :: Int -> AnimationGetCurrentTime -> ShowS
$cshowsPrec :: Int -> AnimationGetCurrentTime -> ShowS
Show)
instance FromJSON AnimationGetCurrentTime where
  parseJSON :: Value -> Parser AnimationGetCurrentTime
parseJSON = String
-> (Object -> Parser AnimationGetCurrentTime)
-> Value
-> Parser AnimationGetCurrentTime
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"AnimationGetCurrentTime" ((Object -> Parser AnimationGetCurrentTime)
 -> Value -> Parser AnimationGetCurrentTime)
-> (Object -> Parser AnimationGetCurrentTime)
-> Value
-> Parser AnimationGetCurrentTime
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double -> AnimationGetCurrentTime
AnimationGetCurrentTime
    (Double -> AnimationGetCurrentTime)
-> Parser Double -> Parser AnimationGetCurrentTime
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
"currentTime"
instance Command PAnimationGetCurrentTime where
  type CommandResponse PAnimationGetCurrentTime = AnimationGetCurrentTime
  commandName :: Proxy PAnimationGetCurrentTime -> String
commandName Proxy PAnimationGetCurrentTime
_ = String
"Animation.getCurrentTime"

-- | Gets the playback rate of the document timeline.

-- | Parameters of the 'Animation.getPlaybackRate' command.
data PAnimationGetPlaybackRate = PAnimationGetPlaybackRate
  deriving (PAnimationGetPlaybackRate -> PAnimationGetPlaybackRate -> Bool
(PAnimationGetPlaybackRate -> PAnimationGetPlaybackRate -> Bool)
-> (PAnimationGetPlaybackRate -> PAnimationGetPlaybackRate -> Bool)
-> Eq PAnimationGetPlaybackRate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PAnimationGetPlaybackRate -> PAnimationGetPlaybackRate -> Bool
$c/= :: PAnimationGetPlaybackRate -> PAnimationGetPlaybackRate -> Bool
== :: PAnimationGetPlaybackRate -> PAnimationGetPlaybackRate -> Bool
$c== :: PAnimationGetPlaybackRate -> PAnimationGetPlaybackRate -> Bool
Eq, Int -> PAnimationGetPlaybackRate -> ShowS
[PAnimationGetPlaybackRate] -> ShowS
PAnimationGetPlaybackRate -> String
(Int -> PAnimationGetPlaybackRate -> ShowS)
-> (PAnimationGetPlaybackRate -> String)
-> ([PAnimationGetPlaybackRate] -> ShowS)
-> Show PAnimationGetPlaybackRate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PAnimationGetPlaybackRate] -> ShowS
$cshowList :: [PAnimationGetPlaybackRate] -> ShowS
show :: PAnimationGetPlaybackRate -> String
$cshow :: PAnimationGetPlaybackRate -> String
showsPrec :: Int -> PAnimationGetPlaybackRate -> ShowS
$cshowsPrec :: Int -> PAnimationGetPlaybackRate -> ShowS
Show)
pAnimationGetPlaybackRate
  :: PAnimationGetPlaybackRate
pAnimationGetPlaybackRate :: PAnimationGetPlaybackRate
pAnimationGetPlaybackRate
  = PAnimationGetPlaybackRate
PAnimationGetPlaybackRate
instance ToJSON PAnimationGetPlaybackRate where
  toJSON :: PAnimationGetPlaybackRate -> Value
toJSON PAnimationGetPlaybackRate
_ = Value
A.Null
data AnimationGetPlaybackRate = AnimationGetPlaybackRate
  {
    -- | Playback rate for animations on page.
    AnimationGetPlaybackRate -> Double
animationGetPlaybackRatePlaybackRate :: Double
  }
  deriving (AnimationGetPlaybackRate -> AnimationGetPlaybackRate -> Bool
(AnimationGetPlaybackRate -> AnimationGetPlaybackRate -> Bool)
-> (AnimationGetPlaybackRate -> AnimationGetPlaybackRate -> Bool)
-> Eq AnimationGetPlaybackRate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnimationGetPlaybackRate -> AnimationGetPlaybackRate -> Bool
$c/= :: AnimationGetPlaybackRate -> AnimationGetPlaybackRate -> Bool
== :: AnimationGetPlaybackRate -> AnimationGetPlaybackRate -> Bool
$c== :: AnimationGetPlaybackRate -> AnimationGetPlaybackRate -> Bool
Eq, Int -> AnimationGetPlaybackRate -> ShowS
[AnimationGetPlaybackRate] -> ShowS
AnimationGetPlaybackRate -> String
(Int -> AnimationGetPlaybackRate -> ShowS)
-> (AnimationGetPlaybackRate -> String)
-> ([AnimationGetPlaybackRate] -> ShowS)
-> Show AnimationGetPlaybackRate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnimationGetPlaybackRate] -> ShowS
$cshowList :: [AnimationGetPlaybackRate] -> ShowS
show :: AnimationGetPlaybackRate -> String
$cshow :: AnimationGetPlaybackRate -> String
showsPrec :: Int -> AnimationGetPlaybackRate -> ShowS
$cshowsPrec :: Int -> AnimationGetPlaybackRate -> ShowS
Show)
instance FromJSON AnimationGetPlaybackRate where
  parseJSON :: Value -> Parser AnimationGetPlaybackRate
parseJSON = String
-> (Object -> Parser AnimationGetPlaybackRate)
-> Value
-> Parser AnimationGetPlaybackRate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"AnimationGetPlaybackRate" ((Object -> Parser AnimationGetPlaybackRate)
 -> Value -> Parser AnimationGetPlaybackRate)
-> (Object -> Parser AnimationGetPlaybackRate)
-> Value
-> Parser AnimationGetPlaybackRate
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double -> AnimationGetPlaybackRate
AnimationGetPlaybackRate
    (Double -> AnimationGetPlaybackRate)
-> Parser Double -> Parser AnimationGetPlaybackRate
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
"playbackRate"
instance Command PAnimationGetPlaybackRate where
  type CommandResponse PAnimationGetPlaybackRate = AnimationGetPlaybackRate
  commandName :: Proxy PAnimationGetPlaybackRate -> String
commandName Proxy PAnimationGetPlaybackRate
_ = String
"Animation.getPlaybackRate"

-- | Releases a set of animations to no longer be manipulated.

-- | Parameters of the 'Animation.releaseAnimations' command.
data PAnimationReleaseAnimations = PAnimationReleaseAnimations
  {
    -- | List of animation ids to seek.
    PAnimationReleaseAnimations -> [Text]
pAnimationReleaseAnimationsAnimations :: [T.Text]
  }
  deriving (PAnimationReleaseAnimations -> PAnimationReleaseAnimations -> Bool
(PAnimationReleaseAnimations
 -> PAnimationReleaseAnimations -> Bool)
-> (PAnimationReleaseAnimations
    -> PAnimationReleaseAnimations -> Bool)
-> Eq PAnimationReleaseAnimations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PAnimationReleaseAnimations -> PAnimationReleaseAnimations -> Bool
$c/= :: PAnimationReleaseAnimations -> PAnimationReleaseAnimations -> Bool
== :: PAnimationReleaseAnimations -> PAnimationReleaseAnimations -> Bool
$c== :: PAnimationReleaseAnimations -> PAnimationReleaseAnimations -> Bool
Eq, Int -> PAnimationReleaseAnimations -> ShowS
[PAnimationReleaseAnimations] -> ShowS
PAnimationReleaseAnimations -> String
(Int -> PAnimationReleaseAnimations -> ShowS)
-> (PAnimationReleaseAnimations -> String)
-> ([PAnimationReleaseAnimations] -> ShowS)
-> Show PAnimationReleaseAnimations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PAnimationReleaseAnimations] -> ShowS
$cshowList :: [PAnimationReleaseAnimations] -> ShowS
show :: PAnimationReleaseAnimations -> String
$cshow :: PAnimationReleaseAnimations -> String
showsPrec :: Int -> PAnimationReleaseAnimations -> ShowS
$cshowsPrec :: Int -> PAnimationReleaseAnimations -> ShowS
Show)
pAnimationReleaseAnimations
  {-
  -- | List of animation ids to seek.
  -}
  :: [T.Text]
  -> PAnimationReleaseAnimations
pAnimationReleaseAnimations :: [Text] -> PAnimationReleaseAnimations
pAnimationReleaseAnimations
  [Text]
arg_pAnimationReleaseAnimationsAnimations
  = [Text] -> PAnimationReleaseAnimations
PAnimationReleaseAnimations
    [Text]
arg_pAnimationReleaseAnimationsAnimations
instance ToJSON PAnimationReleaseAnimations where
  toJSON :: PAnimationReleaseAnimations -> Value
toJSON PAnimationReleaseAnimations
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
"animations" 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 (PAnimationReleaseAnimations -> [Text]
pAnimationReleaseAnimationsAnimations PAnimationReleaseAnimations
p)
    ]
instance Command PAnimationReleaseAnimations where
  type CommandResponse PAnimationReleaseAnimations = ()
  commandName :: Proxy PAnimationReleaseAnimations -> String
commandName Proxy PAnimationReleaseAnimations
_ = String
"Animation.releaseAnimations"
  fromJSON :: Proxy PAnimationReleaseAnimations
-> Value -> Result (CommandResponse PAnimationReleaseAnimations)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PAnimationReleaseAnimations -> Result ())
-> Proxy PAnimationReleaseAnimations
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PAnimationReleaseAnimations -> ())
-> Proxy PAnimationReleaseAnimations
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PAnimationReleaseAnimations -> ()
forall a b. a -> b -> a
const ()

-- | Gets the remote object of the Animation.

-- | Parameters of the 'Animation.resolveAnimation' command.
data PAnimationResolveAnimation = PAnimationResolveAnimation
  {
    -- | Animation id.
    PAnimationResolveAnimation -> Text
pAnimationResolveAnimationAnimationId :: T.Text
  }
  deriving (PAnimationResolveAnimation -> PAnimationResolveAnimation -> Bool
(PAnimationResolveAnimation -> PAnimationResolveAnimation -> Bool)
-> (PAnimationResolveAnimation
    -> PAnimationResolveAnimation -> Bool)
-> Eq PAnimationResolveAnimation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PAnimationResolveAnimation -> PAnimationResolveAnimation -> Bool
$c/= :: PAnimationResolveAnimation -> PAnimationResolveAnimation -> Bool
== :: PAnimationResolveAnimation -> PAnimationResolveAnimation -> Bool
$c== :: PAnimationResolveAnimation -> PAnimationResolveAnimation -> Bool
Eq, Int -> PAnimationResolveAnimation -> ShowS
[PAnimationResolveAnimation] -> ShowS
PAnimationResolveAnimation -> String
(Int -> PAnimationResolveAnimation -> ShowS)
-> (PAnimationResolveAnimation -> String)
-> ([PAnimationResolveAnimation] -> ShowS)
-> Show PAnimationResolveAnimation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PAnimationResolveAnimation] -> ShowS
$cshowList :: [PAnimationResolveAnimation] -> ShowS
show :: PAnimationResolveAnimation -> String
$cshow :: PAnimationResolveAnimation -> String
showsPrec :: Int -> PAnimationResolveAnimation -> ShowS
$cshowsPrec :: Int -> PAnimationResolveAnimation -> ShowS
Show)
pAnimationResolveAnimation
  {-
  -- | Animation id.
  -}
  :: T.Text
  -> PAnimationResolveAnimation
pAnimationResolveAnimation :: Text -> PAnimationResolveAnimation
pAnimationResolveAnimation
  Text
arg_pAnimationResolveAnimationAnimationId
  = Text -> PAnimationResolveAnimation
PAnimationResolveAnimation
    Text
arg_pAnimationResolveAnimationAnimationId
instance ToJSON PAnimationResolveAnimation where
  toJSON :: PAnimationResolveAnimation -> Value
toJSON PAnimationResolveAnimation
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
"animationId" 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 (PAnimationResolveAnimation -> Text
pAnimationResolveAnimationAnimationId PAnimationResolveAnimation
p)
    ]
data AnimationResolveAnimation = AnimationResolveAnimation
  {
    -- | Corresponding remote object.
    AnimationResolveAnimation -> RuntimeRemoteObject
animationResolveAnimationRemoteObject :: Runtime.RuntimeRemoteObject
  }
  deriving (AnimationResolveAnimation -> AnimationResolveAnimation -> Bool
(AnimationResolveAnimation -> AnimationResolveAnimation -> Bool)
-> (AnimationResolveAnimation -> AnimationResolveAnimation -> Bool)
-> Eq AnimationResolveAnimation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnimationResolveAnimation -> AnimationResolveAnimation -> Bool
$c/= :: AnimationResolveAnimation -> AnimationResolveAnimation -> Bool
== :: AnimationResolveAnimation -> AnimationResolveAnimation -> Bool
$c== :: AnimationResolveAnimation -> AnimationResolveAnimation -> Bool
Eq, Int -> AnimationResolveAnimation -> ShowS
[AnimationResolveAnimation] -> ShowS
AnimationResolveAnimation -> String
(Int -> AnimationResolveAnimation -> ShowS)
-> (AnimationResolveAnimation -> String)
-> ([AnimationResolveAnimation] -> ShowS)
-> Show AnimationResolveAnimation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnimationResolveAnimation] -> ShowS
$cshowList :: [AnimationResolveAnimation] -> ShowS
show :: AnimationResolveAnimation -> String
$cshow :: AnimationResolveAnimation -> String
showsPrec :: Int -> AnimationResolveAnimation -> ShowS
$cshowsPrec :: Int -> AnimationResolveAnimation -> ShowS
Show)
instance FromJSON AnimationResolveAnimation where
  parseJSON :: Value -> Parser AnimationResolveAnimation
parseJSON = String
-> (Object -> Parser AnimationResolveAnimation)
-> Value
-> Parser AnimationResolveAnimation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"AnimationResolveAnimation" ((Object -> Parser AnimationResolveAnimation)
 -> Value -> Parser AnimationResolveAnimation)
-> (Object -> Parser AnimationResolveAnimation)
-> Value
-> Parser AnimationResolveAnimation
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeRemoteObject -> AnimationResolveAnimation
AnimationResolveAnimation
    (RuntimeRemoteObject -> AnimationResolveAnimation)
-> Parser RuntimeRemoteObject -> Parser AnimationResolveAnimation
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
"remoteObject"
instance Command PAnimationResolveAnimation where
  type CommandResponse PAnimationResolveAnimation = AnimationResolveAnimation
  commandName :: Proxy PAnimationResolveAnimation -> String
commandName Proxy PAnimationResolveAnimation
_ = String
"Animation.resolveAnimation"

-- | Seek a set of animations to a particular time within each animation.

-- | Parameters of the 'Animation.seekAnimations' command.
data PAnimationSeekAnimations = PAnimationSeekAnimations
  {
    -- | List of animation ids to seek.
    PAnimationSeekAnimations -> [Text]
pAnimationSeekAnimationsAnimations :: [T.Text],
    -- | Set the current time of each animation.
    PAnimationSeekAnimations -> Double
pAnimationSeekAnimationsCurrentTime :: Double
  }
  deriving (PAnimationSeekAnimations -> PAnimationSeekAnimations -> Bool
(PAnimationSeekAnimations -> PAnimationSeekAnimations -> Bool)
-> (PAnimationSeekAnimations -> PAnimationSeekAnimations -> Bool)
-> Eq PAnimationSeekAnimations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PAnimationSeekAnimations -> PAnimationSeekAnimations -> Bool
$c/= :: PAnimationSeekAnimations -> PAnimationSeekAnimations -> Bool
== :: PAnimationSeekAnimations -> PAnimationSeekAnimations -> Bool
$c== :: PAnimationSeekAnimations -> PAnimationSeekAnimations -> Bool
Eq, Int -> PAnimationSeekAnimations -> ShowS
[PAnimationSeekAnimations] -> ShowS
PAnimationSeekAnimations -> String
(Int -> PAnimationSeekAnimations -> ShowS)
-> (PAnimationSeekAnimations -> String)
-> ([PAnimationSeekAnimations] -> ShowS)
-> Show PAnimationSeekAnimations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PAnimationSeekAnimations] -> ShowS
$cshowList :: [PAnimationSeekAnimations] -> ShowS
show :: PAnimationSeekAnimations -> String
$cshow :: PAnimationSeekAnimations -> String
showsPrec :: Int -> PAnimationSeekAnimations -> ShowS
$cshowsPrec :: Int -> PAnimationSeekAnimations -> ShowS
Show)
pAnimationSeekAnimations
  {-
  -- | List of animation ids to seek.
  -}
  :: [T.Text]
  {-
  -- | Set the current time of each animation.
  -}
  -> Double
  -> PAnimationSeekAnimations
pAnimationSeekAnimations :: [Text] -> Double -> PAnimationSeekAnimations
pAnimationSeekAnimations
  [Text]
arg_pAnimationSeekAnimationsAnimations
  Double
arg_pAnimationSeekAnimationsCurrentTime
  = [Text] -> Double -> PAnimationSeekAnimations
PAnimationSeekAnimations
    [Text]
arg_pAnimationSeekAnimationsAnimations
    Double
arg_pAnimationSeekAnimationsCurrentTime
instance ToJSON PAnimationSeekAnimations where
  toJSON :: PAnimationSeekAnimations -> Value
toJSON PAnimationSeekAnimations
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
"animations" 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 (PAnimationSeekAnimations -> [Text]
pAnimationSeekAnimationsAnimations PAnimationSeekAnimations
p),
    (Text
"currentTime" 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 (PAnimationSeekAnimations -> Double
pAnimationSeekAnimationsCurrentTime PAnimationSeekAnimations
p)
    ]
instance Command PAnimationSeekAnimations where
  type CommandResponse PAnimationSeekAnimations = ()
  commandName :: Proxy PAnimationSeekAnimations -> String
commandName Proxy PAnimationSeekAnimations
_ = String
"Animation.seekAnimations"
  fromJSON :: Proxy PAnimationSeekAnimations
-> Value -> Result (CommandResponse PAnimationSeekAnimations)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PAnimationSeekAnimations -> Result ())
-> Proxy PAnimationSeekAnimations
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PAnimationSeekAnimations -> ())
-> Proxy PAnimationSeekAnimations
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PAnimationSeekAnimations -> ()
forall a b. a -> b -> a
const ()

-- | Sets the paused state of a set of animations.

-- | Parameters of the 'Animation.setPaused' command.
data PAnimationSetPaused = PAnimationSetPaused
  {
    -- | Animations to set the pause state of.
    PAnimationSetPaused -> [Text]
pAnimationSetPausedAnimations :: [T.Text],
    -- | Paused state to set to.
    PAnimationSetPaused -> Bool
pAnimationSetPausedPaused :: Bool
  }
  deriving (PAnimationSetPaused -> PAnimationSetPaused -> Bool
(PAnimationSetPaused -> PAnimationSetPaused -> Bool)
-> (PAnimationSetPaused -> PAnimationSetPaused -> Bool)
-> Eq PAnimationSetPaused
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PAnimationSetPaused -> PAnimationSetPaused -> Bool
$c/= :: PAnimationSetPaused -> PAnimationSetPaused -> Bool
== :: PAnimationSetPaused -> PAnimationSetPaused -> Bool
$c== :: PAnimationSetPaused -> PAnimationSetPaused -> Bool
Eq, Int -> PAnimationSetPaused -> ShowS
[PAnimationSetPaused] -> ShowS
PAnimationSetPaused -> String
(Int -> PAnimationSetPaused -> ShowS)
-> (PAnimationSetPaused -> String)
-> ([PAnimationSetPaused] -> ShowS)
-> Show PAnimationSetPaused
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PAnimationSetPaused] -> ShowS
$cshowList :: [PAnimationSetPaused] -> ShowS
show :: PAnimationSetPaused -> String
$cshow :: PAnimationSetPaused -> String
showsPrec :: Int -> PAnimationSetPaused -> ShowS
$cshowsPrec :: Int -> PAnimationSetPaused -> ShowS
Show)
pAnimationSetPaused
  {-
  -- | Animations to set the pause state of.
  -}
  :: [T.Text]
  {-
  -- | Paused state to set to.
  -}
  -> Bool
  -> PAnimationSetPaused
pAnimationSetPaused :: [Text] -> Bool -> PAnimationSetPaused
pAnimationSetPaused
  [Text]
arg_pAnimationSetPausedAnimations
  Bool
arg_pAnimationSetPausedPaused
  = [Text] -> Bool -> PAnimationSetPaused
PAnimationSetPaused
    [Text]
arg_pAnimationSetPausedAnimations
    Bool
arg_pAnimationSetPausedPaused
instance ToJSON PAnimationSetPaused where
  toJSON :: PAnimationSetPaused -> Value
toJSON PAnimationSetPaused
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
"animations" 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 (PAnimationSetPaused -> [Text]
pAnimationSetPausedAnimations PAnimationSetPaused
p),
    (Text
"paused" 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 (PAnimationSetPaused -> Bool
pAnimationSetPausedPaused PAnimationSetPaused
p)
    ]
instance Command PAnimationSetPaused where
  type CommandResponse PAnimationSetPaused = ()
  commandName :: Proxy PAnimationSetPaused -> String
commandName Proxy PAnimationSetPaused
_ = String
"Animation.setPaused"
  fromJSON :: Proxy PAnimationSetPaused
-> Value -> Result (CommandResponse PAnimationSetPaused)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PAnimationSetPaused -> Result ())
-> Proxy PAnimationSetPaused
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PAnimationSetPaused -> ())
-> Proxy PAnimationSetPaused
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PAnimationSetPaused -> ()
forall a b. a -> b -> a
const ()

-- | Sets the playback rate of the document timeline.

-- | Parameters of the 'Animation.setPlaybackRate' command.
data PAnimationSetPlaybackRate = PAnimationSetPlaybackRate
  {
    -- | Playback rate for animations on page
    PAnimationSetPlaybackRate -> Double
pAnimationSetPlaybackRatePlaybackRate :: Double
  }
  deriving (PAnimationSetPlaybackRate -> PAnimationSetPlaybackRate -> Bool
(PAnimationSetPlaybackRate -> PAnimationSetPlaybackRate -> Bool)
-> (PAnimationSetPlaybackRate -> PAnimationSetPlaybackRate -> Bool)
-> Eq PAnimationSetPlaybackRate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PAnimationSetPlaybackRate -> PAnimationSetPlaybackRate -> Bool
$c/= :: PAnimationSetPlaybackRate -> PAnimationSetPlaybackRate -> Bool
== :: PAnimationSetPlaybackRate -> PAnimationSetPlaybackRate -> Bool
$c== :: PAnimationSetPlaybackRate -> PAnimationSetPlaybackRate -> Bool
Eq, Int -> PAnimationSetPlaybackRate -> ShowS
[PAnimationSetPlaybackRate] -> ShowS
PAnimationSetPlaybackRate -> String
(Int -> PAnimationSetPlaybackRate -> ShowS)
-> (PAnimationSetPlaybackRate -> String)
-> ([PAnimationSetPlaybackRate] -> ShowS)
-> Show PAnimationSetPlaybackRate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PAnimationSetPlaybackRate] -> ShowS
$cshowList :: [PAnimationSetPlaybackRate] -> ShowS
show :: PAnimationSetPlaybackRate -> String
$cshow :: PAnimationSetPlaybackRate -> String
showsPrec :: Int -> PAnimationSetPlaybackRate -> ShowS
$cshowsPrec :: Int -> PAnimationSetPlaybackRate -> ShowS
Show)
pAnimationSetPlaybackRate
  {-
  -- | Playback rate for animations on page
  -}
  :: Double
  -> PAnimationSetPlaybackRate
pAnimationSetPlaybackRate :: Double -> PAnimationSetPlaybackRate
pAnimationSetPlaybackRate
  Double
arg_pAnimationSetPlaybackRatePlaybackRate
  = Double -> PAnimationSetPlaybackRate
PAnimationSetPlaybackRate
    Double
arg_pAnimationSetPlaybackRatePlaybackRate
instance ToJSON PAnimationSetPlaybackRate where
  toJSON :: PAnimationSetPlaybackRate -> Value
toJSON PAnimationSetPlaybackRate
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
"playbackRate" 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 (PAnimationSetPlaybackRate -> Double
pAnimationSetPlaybackRatePlaybackRate PAnimationSetPlaybackRate
p)
    ]
instance Command PAnimationSetPlaybackRate where
  type CommandResponse PAnimationSetPlaybackRate = ()
  commandName :: Proxy PAnimationSetPlaybackRate -> String
commandName Proxy PAnimationSetPlaybackRate
_ = String
"Animation.setPlaybackRate"
  fromJSON :: Proxy PAnimationSetPlaybackRate
-> Value -> Result (CommandResponse PAnimationSetPlaybackRate)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PAnimationSetPlaybackRate -> Result ())
-> Proxy PAnimationSetPlaybackRate
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PAnimationSetPlaybackRate -> ())
-> Proxy PAnimationSetPlaybackRate
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PAnimationSetPlaybackRate -> ()
forall a b. a -> b -> a
const ()

-- | Sets the timing of an animation node.

-- | Parameters of the 'Animation.setTiming' command.
data PAnimationSetTiming = PAnimationSetTiming
  {
    -- | Animation id.
    PAnimationSetTiming -> Text
pAnimationSetTimingAnimationId :: T.Text,
    -- | Duration of the animation.
    PAnimationSetTiming -> Double
pAnimationSetTimingDuration :: Double,
    -- | Delay of the animation.
    PAnimationSetTiming -> Double
pAnimationSetTimingDelay :: Double
  }
  deriving (PAnimationSetTiming -> PAnimationSetTiming -> Bool
(PAnimationSetTiming -> PAnimationSetTiming -> Bool)
-> (PAnimationSetTiming -> PAnimationSetTiming -> Bool)
-> Eq PAnimationSetTiming
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PAnimationSetTiming -> PAnimationSetTiming -> Bool
$c/= :: PAnimationSetTiming -> PAnimationSetTiming -> Bool
== :: PAnimationSetTiming -> PAnimationSetTiming -> Bool
$c== :: PAnimationSetTiming -> PAnimationSetTiming -> Bool
Eq, Int -> PAnimationSetTiming -> ShowS
[PAnimationSetTiming] -> ShowS
PAnimationSetTiming -> String
(Int -> PAnimationSetTiming -> ShowS)
-> (PAnimationSetTiming -> String)
-> ([PAnimationSetTiming] -> ShowS)
-> Show PAnimationSetTiming
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PAnimationSetTiming] -> ShowS
$cshowList :: [PAnimationSetTiming] -> ShowS
show :: PAnimationSetTiming -> String
$cshow :: PAnimationSetTiming -> String
showsPrec :: Int -> PAnimationSetTiming -> ShowS
$cshowsPrec :: Int -> PAnimationSetTiming -> ShowS
Show)
pAnimationSetTiming
  {-
  -- | Animation id.
  -}
  :: T.Text
  {-
  -- | Duration of the animation.
  -}
  -> Double
  {-
  -- | Delay of the animation.
  -}
  -> Double
  -> PAnimationSetTiming
pAnimationSetTiming :: Text -> Double -> Double -> PAnimationSetTiming
pAnimationSetTiming
  Text
arg_pAnimationSetTimingAnimationId
  Double
arg_pAnimationSetTimingDuration
  Double
arg_pAnimationSetTimingDelay
  = Text -> Double -> Double -> PAnimationSetTiming
PAnimationSetTiming
    Text
arg_pAnimationSetTimingAnimationId
    Double
arg_pAnimationSetTimingDuration
    Double
arg_pAnimationSetTimingDelay
instance ToJSON PAnimationSetTiming where
  toJSON :: PAnimationSetTiming -> Value
toJSON PAnimationSetTiming
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
"animationId" 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 (PAnimationSetTiming -> Text
pAnimationSetTimingAnimationId PAnimationSetTiming
p),
    (Text
"duration" 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 (PAnimationSetTiming -> Double
pAnimationSetTimingDuration PAnimationSetTiming
p),
    (Text
"delay" 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 (PAnimationSetTiming -> Double
pAnimationSetTimingDelay PAnimationSetTiming
p)
    ]
instance Command PAnimationSetTiming where
  type CommandResponse PAnimationSetTiming = ()
  commandName :: Proxy PAnimationSetTiming -> String
commandName Proxy PAnimationSetTiming
_ = String
"Animation.setTiming"
  fromJSON :: Proxy PAnimationSetTiming
-> Value -> Result (CommandResponse PAnimationSetTiming)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PAnimationSetTiming -> Result ())
-> Proxy PAnimationSetTiming
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PAnimationSetTiming -> ())
-> Proxy PAnimationSetTiming
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PAnimationSetTiming -> ()
forall a b. a -> b -> a
const ()