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


{- |
= WebAudio

This domain allows inspection of Web Audio API.
https://webaudio.github.io/web-audio-api/
-}


module CDP.Domains.WebAudio (module CDP.Domains.WebAudio) where

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

import CDP.Internal.Utils




-- | Type 'WebAudio.GraphObjectId'.
--   An unique ID for a graph object (AudioContext, AudioNode, AudioParam) in Web Audio API
type WebAudioGraphObjectId = T.Text

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

-- | Type 'WebAudio.ContextState'.
--   Enum of AudioContextState from the spec
data WebAudioContextState = WebAudioContextStateSuspended | WebAudioContextStateRunning | WebAudioContextStateClosed
  deriving (Eq WebAudioContextState
Eq WebAudioContextState
-> (WebAudioContextState -> WebAudioContextState -> Ordering)
-> (WebAudioContextState -> WebAudioContextState -> Bool)
-> (WebAudioContextState -> WebAudioContextState -> Bool)
-> (WebAudioContextState -> WebAudioContextState -> Bool)
-> (WebAudioContextState -> WebAudioContextState -> Bool)
-> (WebAudioContextState
    -> WebAudioContextState -> WebAudioContextState)
-> (WebAudioContextState
    -> WebAudioContextState -> WebAudioContextState)
-> Ord WebAudioContextState
WebAudioContextState -> WebAudioContextState -> Bool
WebAudioContextState -> WebAudioContextState -> Ordering
WebAudioContextState
-> WebAudioContextState -> WebAudioContextState
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 :: WebAudioContextState
-> WebAudioContextState -> WebAudioContextState
$cmin :: WebAudioContextState
-> WebAudioContextState -> WebAudioContextState
max :: WebAudioContextState
-> WebAudioContextState -> WebAudioContextState
$cmax :: WebAudioContextState
-> WebAudioContextState -> WebAudioContextState
>= :: WebAudioContextState -> WebAudioContextState -> Bool
$c>= :: WebAudioContextState -> WebAudioContextState -> Bool
> :: WebAudioContextState -> WebAudioContextState -> Bool
$c> :: WebAudioContextState -> WebAudioContextState -> Bool
<= :: WebAudioContextState -> WebAudioContextState -> Bool
$c<= :: WebAudioContextState -> WebAudioContextState -> Bool
< :: WebAudioContextState -> WebAudioContextState -> Bool
$c< :: WebAudioContextState -> WebAudioContextState -> Bool
compare :: WebAudioContextState -> WebAudioContextState -> Ordering
$ccompare :: WebAudioContextState -> WebAudioContextState -> Ordering
$cp1Ord :: Eq WebAudioContextState
Ord, WebAudioContextState -> WebAudioContextState -> Bool
(WebAudioContextState -> WebAudioContextState -> Bool)
-> (WebAudioContextState -> WebAudioContextState -> Bool)
-> Eq WebAudioContextState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAudioContextState -> WebAudioContextState -> Bool
$c/= :: WebAudioContextState -> WebAudioContextState -> Bool
== :: WebAudioContextState -> WebAudioContextState -> Bool
$c== :: WebAudioContextState -> WebAudioContextState -> Bool
Eq, Int -> WebAudioContextState -> ShowS
[WebAudioContextState] -> ShowS
WebAudioContextState -> String
(Int -> WebAudioContextState -> ShowS)
-> (WebAudioContextState -> String)
-> ([WebAudioContextState] -> ShowS)
-> Show WebAudioContextState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAudioContextState] -> ShowS
$cshowList :: [WebAudioContextState] -> ShowS
show :: WebAudioContextState -> String
$cshow :: WebAudioContextState -> String
showsPrec :: Int -> WebAudioContextState -> ShowS
$cshowsPrec :: Int -> WebAudioContextState -> ShowS
Show, ReadPrec [WebAudioContextState]
ReadPrec WebAudioContextState
Int -> ReadS WebAudioContextState
ReadS [WebAudioContextState]
(Int -> ReadS WebAudioContextState)
-> ReadS [WebAudioContextState]
-> ReadPrec WebAudioContextState
-> ReadPrec [WebAudioContextState]
-> Read WebAudioContextState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WebAudioContextState]
$creadListPrec :: ReadPrec [WebAudioContextState]
readPrec :: ReadPrec WebAudioContextState
$creadPrec :: ReadPrec WebAudioContextState
readList :: ReadS [WebAudioContextState]
$creadList :: ReadS [WebAudioContextState]
readsPrec :: Int -> ReadS WebAudioContextState
$creadsPrec :: Int -> ReadS WebAudioContextState
Read)
instance FromJSON WebAudioContextState where
  parseJSON :: Value -> Parser WebAudioContextState
parseJSON = String
-> (Text -> Parser WebAudioContextState)
-> Value
-> Parser WebAudioContextState
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"WebAudioContextState" ((Text -> Parser WebAudioContextState)
 -> Value -> Parser WebAudioContextState)
-> (Text -> Parser WebAudioContextState)
-> Value
-> Parser WebAudioContextState
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"suspended" -> WebAudioContextState -> Parser WebAudioContextState
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAudioContextState
WebAudioContextStateSuspended
    Text
"running" -> WebAudioContextState -> Parser WebAudioContextState
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAudioContextState
WebAudioContextStateRunning
    Text
"closed" -> WebAudioContextState -> Parser WebAudioContextState
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAudioContextState
WebAudioContextStateClosed
    Text
"_" -> String -> Parser WebAudioContextState
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse WebAudioContextState"
instance ToJSON WebAudioContextState where
  toJSON :: WebAudioContextState -> Value
toJSON WebAudioContextState
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case WebAudioContextState
v of
    WebAudioContextState
WebAudioContextStateSuspended -> Text
"suspended"
    WebAudioContextState
WebAudioContextStateRunning -> Text
"running"
    WebAudioContextState
WebAudioContextStateClosed -> Text
"closed"

-- | Type 'WebAudio.NodeType'.
--   Enum of AudioNode types
type WebAudioNodeType = T.Text

-- | Type 'WebAudio.ChannelCountMode'.
--   Enum of AudioNode::ChannelCountMode from the spec
data WebAudioChannelCountMode = WebAudioChannelCountModeClampedMax | WebAudioChannelCountModeExplicit | WebAudioChannelCountModeMax
  deriving (Eq WebAudioChannelCountMode
Eq WebAudioChannelCountMode
-> (WebAudioChannelCountMode
    -> WebAudioChannelCountMode -> Ordering)
-> (WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool)
-> (WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool)
-> (WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool)
-> (WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool)
-> (WebAudioChannelCountMode
    -> WebAudioChannelCountMode -> WebAudioChannelCountMode)
-> (WebAudioChannelCountMode
    -> WebAudioChannelCountMode -> WebAudioChannelCountMode)
-> Ord WebAudioChannelCountMode
WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool
WebAudioChannelCountMode -> WebAudioChannelCountMode -> Ordering
WebAudioChannelCountMode
-> WebAudioChannelCountMode -> WebAudioChannelCountMode
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 :: WebAudioChannelCountMode
-> WebAudioChannelCountMode -> WebAudioChannelCountMode
$cmin :: WebAudioChannelCountMode
-> WebAudioChannelCountMode -> WebAudioChannelCountMode
max :: WebAudioChannelCountMode
-> WebAudioChannelCountMode -> WebAudioChannelCountMode
$cmax :: WebAudioChannelCountMode
-> WebAudioChannelCountMode -> WebAudioChannelCountMode
>= :: WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool
$c>= :: WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool
> :: WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool
$c> :: WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool
<= :: WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool
$c<= :: WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool
< :: WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool
$c< :: WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool
compare :: WebAudioChannelCountMode -> WebAudioChannelCountMode -> Ordering
$ccompare :: WebAudioChannelCountMode -> WebAudioChannelCountMode -> Ordering
$cp1Ord :: Eq WebAudioChannelCountMode
Ord, WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool
(WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool)
-> (WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool)
-> Eq WebAudioChannelCountMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool
$c/= :: WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool
== :: WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool
$c== :: WebAudioChannelCountMode -> WebAudioChannelCountMode -> Bool
Eq, Int -> WebAudioChannelCountMode -> ShowS
[WebAudioChannelCountMode] -> ShowS
WebAudioChannelCountMode -> String
(Int -> WebAudioChannelCountMode -> ShowS)
-> (WebAudioChannelCountMode -> String)
-> ([WebAudioChannelCountMode] -> ShowS)
-> Show WebAudioChannelCountMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAudioChannelCountMode] -> ShowS
$cshowList :: [WebAudioChannelCountMode] -> ShowS
show :: WebAudioChannelCountMode -> String
$cshow :: WebAudioChannelCountMode -> String
showsPrec :: Int -> WebAudioChannelCountMode -> ShowS
$cshowsPrec :: Int -> WebAudioChannelCountMode -> ShowS
Show, ReadPrec [WebAudioChannelCountMode]
ReadPrec WebAudioChannelCountMode
Int -> ReadS WebAudioChannelCountMode
ReadS [WebAudioChannelCountMode]
(Int -> ReadS WebAudioChannelCountMode)
-> ReadS [WebAudioChannelCountMode]
-> ReadPrec WebAudioChannelCountMode
-> ReadPrec [WebAudioChannelCountMode]
-> Read WebAudioChannelCountMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WebAudioChannelCountMode]
$creadListPrec :: ReadPrec [WebAudioChannelCountMode]
readPrec :: ReadPrec WebAudioChannelCountMode
$creadPrec :: ReadPrec WebAudioChannelCountMode
readList :: ReadS [WebAudioChannelCountMode]
$creadList :: ReadS [WebAudioChannelCountMode]
readsPrec :: Int -> ReadS WebAudioChannelCountMode
$creadsPrec :: Int -> ReadS WebAudioChannelCountMode
Read)
instance FromJSON WebAudioChannelCountMode where
  parseJSON :: Value -> Parser WebAudioChannelCountMode
parseJSON = String
-> (Text -> Parser WebAudioChannelCountMode)
-> Value
-> Parser WebAudioChannelCountMode
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"WebAudioChannelCountMode" ((Text -> Parser WebAudioChannelCountMode)
 -> Value -> Parser WebAudioChannelCountMode)
-> (Text -> Parser WebAudioChannelCountMode)
-> Value
-> Parser WebAudioChannelCountMode
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"clamped-max" -> WebAudioChannelCountMode -> Parser WebAudioChannelCountMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAudioChannelCountMode
WebAudioChannelCountModeClampedMax
    Text
"explicit" -> WebAudioChannelCountMode -> Parser WebAudioChannelCountMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAudioChannelCountMode
WebAudioChannelCountModeExplicit
    Text
"max" -> WebAudioChannelCountMode -> Parser WebAudioChannelCountMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAudioChannelCountMode
WebAudioChannelCountModeMax
    Text
"_" -> String -> Parser WebAudioChannelCountMode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse WebAudioChannelCountMode"
instance ToJSON WebAudioChannelCountMode where
  toJSON :: WebAudioChannelCountMode -> Value
toJSON WebAudioChannelCountMode
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case WebAudioChannelCountMode
v of
    WebAudioChannelCountMode
WebAudioChannelCountModeClampedMax -> Text
"clamped-max"
    WebAudioChannelCountMode
WebAudioChannelCountModeExplicit -> Text
"explicit"
    WebAudioChannelCountMode
WebAudioChannelCountModeMax -> Text
"max"

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

-- | Type 'WebAudio.ParamType'.
--   Enum of AudioParam types
type WebAudioParamType = T.Text

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

-- | Type 'WebAudio.ContextRealtimeData'.
--   Fields in AudioContext that change in real-time.
data WebAudioContextRealtimeData = WebAudioContextRealtimeData
  {
    -- | The current context time in second in BaseAudioContext.
    WebAudioContextRealtimeData -> Double
webAudioContextRealtimeDataCurrentTime :: Double,
    -- | The time spent on rendering graph divided by render quantum duration,
    --   and multiplied by 100. 100 means the audio renderer reached the full
    --   capacity and glitch may occur.
    WebAudioContextRealtimeData -> Double
webAudioContextRealtimeDataRenderCapacity :: Double,
    -- | A running mean of callback interval.
    WebAudioContextRealtimeData -> Double
webAudioContextRealtimeDataCallbackIntervalMean :: Double,
    -- | A running variance of callback interval.
    WebAudioContextRealtimeData -> Double
webAudioContextRealtimeDataCallbackIntervalVariance :: Double
  }
  deriving (WebAudioContextRealtimeData -> WebAudioContextRealtimeData -> Bool
(WebAudioContextRealtimeData
 -> WebAudioContextRealtimeData -> Bool)
-> (WebAudioContextRealtimeData
    -> WebAudioContextRealtimeData -> Bool)
-> Eq WebAudioContextRealtimeData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAudioContextRealtimeData -> WebAudioContextRealtimeData -> Bool
$c/= :: WebAudioContextRealtimeData -> WebAudioContextRealtimeData -> Bool
== :: WebAudioContextRealtimeData -> WebAudioContextRealtimeData -> Bool
$c== :: WebAudioContextRealtimeData -> WebAudioContextRealtimeData -> Bool
Eq, Int -> WebAudioContextRealtimeData -> ShowS
[WebAudioContextRealtimeData] -> ShowS
WebAudioContextRealtimeData -> String
(Int -> WebAudioContextRealtimeData -> ShowS)
-> (WebAudioContextRealtimeData -> String)
-> ([WebAudioContextRealtimeData] -> ShowS)
-> Show WebAudioContextRealtimeData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAudioContextRealtimeData] -> ShowS
$cshowList :: [WebAudioContextRealtimeData] -> ShowS
show :: WebAudioContextRealtimeData -> String
$cshow :: WebAudioContextRealtimeData -> String
showsPrec :: Int -> WebAudioContextRealtimeData -> ShowS
$cshowsPrec :: Int -> WebAudioContextRealtimeData -> ShowS
Show)
instance FromJSON WebAudioContextRealtimeData where
  parseJSON :: Value -> Parser WebAudioContextRealtimeData
parseJSON = String
-> (Object -> Parser WebAudioContextRealtimeData)
-> Value
-> Parser WebAudioContextRealtimeData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAudioContextRealtimeData" ((Object -> Parser WebAudioContextRealtimeData)
 -> Value -> Parser WebAudioContextRealtimeData)
-> (Object -> Parser WebAudioContextRealtimeData)
-> Value
-> Parser WebAudioContextRealtimeData
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double -> Double -> Double -> Double -> WebAudioContextRealtimeData
WebAudioContextRealtimeData
    (Double
 -> Double -> Double -> Double -> WebAudioContextRealtimeData)
-> Parser Double
-> Parser
     (Double -> Double -> Double -> WebAudioContextRealtimeData)
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"
    Parser (Double -> Double -> Double -> WebAudioContextRealtimeData)
-> Parser Double
-> Parser (Double -> Double -> WebAudioContextRealtimeData)
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
"renderCapacity"
    Parser (Double -> Double -> WebAudioContextRealtimeData)
-> Parser Double -> Parser (Double -> WebAudioContextRealtimeData)
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
"callbackIntervalMean"
    Parser (Double -> WebAudioContextRealtimeData)
-> Parser Double -> Parser WebAudioContextRealtimeData
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
"callbackIntervalVariance"
instance ToJSON WebAudioContextRealtimeData where
  toJSON :: WebAudioContextRealtimeData -> Value
toJSON WebAudioContextRealtimeData
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
"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 (WebAudioContextRealtimeData -> Double
webAudioContextRealtimeDataCurrentTime WebAudioContextRealtimeData
p),
    (Text
"renderCapacity" 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 (WebAudioContextRealtimeData -> Double
webAudioContextRealtimeDataRenderCapacity WebAudioContextRealtimeData
p),
    (Text
"callbackIntervalMean" 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 (WebAudioContextRealtimeData -> Double
webAudioContextRealtimeDataCallbackIntervalMean WebAudioContextRealtimeData
p),
    (Text
"callbackIntervalVariance" 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 (WebAudioContextRealtimeData -> Double
webAudioContextRealtimeDataCallbackIntervalVariance WebAudioContextRealtimeData
p)
    ]

-- | Type 'WebAudio.BaseAudioContext'.
--   Protocol object for BaseAudioContext
data WebAudioBaseAudioContext = WebAudioBaseAudioContext
  {
    WebAudioBaseAudioContext -> Text
webAudioBaseAudioContextContextId :: WebAudioGraphObjectId,
    WebAudioBaseAudioContext -> WebAudioContextType
webAudioBaseAudioContextContextType :: WebAudioContextType,
    WebAudioBaseAudioContext -> WebAudioContextState
webAudioBaseAudioContextContextState :: WebAudioContextState,
    WebAudioBaseAudioContext -> Maybe WebAudioContextRealtimeData
webAudioBaseAudioContextRealtimeData :: Maybe WebAudioContextRealtimeData,
    -- | Platform-dependent callback buffer size.
    WebAudioBaseAudioContext -> Double
webAudioBaseAudioContextCallbackBufferSize :: Double,
    -- | Number of output channels supported by audio hardware in use.
    WebAudioBaseAudioContext -> Double
webAudioBaseAudioContextMaxOutputChannelCount :: Double,
    -- | Context sample rate.
    WebAudioBaseAudioContext -> Double
webAudioBaseAudioContextSampleRate :: Double
  }
  deriving (WebAudioBaseAudioContext -> WebAudioBaseAudioContext -> Bool
(WebAudioBaseAudioContext -> WebAudioBaseAudioContext -> Bool)
-> (WebAudioBaseAudioContext -> WebAudioBaseAudioContext -> Bool)
-> Eq WebAudioBaseAudioContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAudioBaseAudioContext -> WebAudioBaseAudioContext -> Bool
$c/= :: WebAudioBaseAudioContext -> WebAudioBaseAudioContext -> Bool
== :: WebAudioBaseAudioContext -> WebAudioBaseAudioContext -> Bool
$c== :: WebAudioBaseAudioContext -> WebAudioBaseAudioContext -> Bool
Eq, Int -> WebAudioBaseAudioContext -> ShowS
[WebAudioBaseAudioContext] -> ShowS
WebAudioBaseAudioContext -> String
(Int -> WebAudioBaseAudioContext -> ShowS)
-> (WebAudioBaseAudioContext -> String)
-> ([WebAudioBaseAudioContext] -> ShowS)
-> Show WebAudioBaseAudioContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAudioBaseAudioContext] -> ShowS
$cshowList :: [WebAudioBaseAudioContext] -> ShowS
show :: WebAudioBaseAudioContext -> String
$cshow :: WebAudioBaseAudioContext -> String
showsPrec :: Int -> WebAudioBaseAudioContext -> ShowS
$cshowsPrec :: Int -> WebAudioBaseAudioContext -> ShowS
Show)
instance FromJSON WebAudioBaseAudioContext where
  parseJSON :: Value -> Parser WebAudioBaseAudioContext
parseJSON = String
-> (Object -> Parser WebAudioBaseAudioContext)
-> Value
-> Parser WebAudioBaseAudioContext
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAudioBaseAudioContext" ((Object -> Parser WebAudioBaseAudioContext)
 -> Value -> Parser WebAudioBaseAudioContext)
-> (Object -> Parser WebAudioBaseAudioContext)
-> Value
-> Parser WebAudioBaseAudioContext
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> WebAudioContextType
-> WebAudioContextState
-> Maybe WebAudioContextRealtimeData
-> Double
-> Double
-> Double
-> WebAudioBaseAudioContext
WebAudioBaseAudioContext
    (Text
 -> WebAudioContextType
 -> WebAudioContextState
 -> Maybe WebAudioContextRealtimeData
 -> Double
 -> Double
 -> Double
 -> WebAudioBaseAudioContext)
-> Parser Text
-> Parser
     (WebAudioContextType
      -> WebAudioContextState
      -> Maybe WebAudioContextRealtimeData
      -> Double
      -> Double
      -> Double
      -> WebAudioBaseAudioContext)
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
"contextId"
    Parser
  (WebAudioContextType
   -> WebAudioContextState
   -> Maybe WebAudioContextRealtimeData
   -> Double
   -> Double
   -> Double
   -> WebAudioBaseAudioContext)
-> Parser WebAudioContextType
-> Parser
     (WebAudioContextState
      -> Maybe WebAudioContextRealtimeData
      -> Double
      -> Double
      -> Double
      -> WebAudioBaseAudioContext)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser WebAudioContextType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"contextType"
    Parser
  (WebAudioContextState
   -> Maybe WebAudioContextRealtimeData
   -> Double
   -> Double
   -> Double
   -> WebAudioBaseAudioContext)
-> Parser WebAudioContextState
-> Parser
     (Maybe WebAudioContextRealtimeData
      -> Double -> Double -> Double -> WebAudioBaseAudioContext)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser WebAudioContextState
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"contextState"
    Parser
  (Maybe WebAudioContextRealtimeData
   -> Double -> Double -> Double -> WebAudioBaseAudioContext)
-> Parser (Maybe WebAudioContextRealtimeData)
-> Parser (Double -> Double -> Double -> WebAudioBaseAudioContext)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe WebAudioContextRealtimeData)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"realtimeData"
    Parser (Double -> Double -> Double -> WebAudioBaseAudioContext)
-> Parser Double
-> Parser (Double -> Double -> WebAudioBaseAudioContext)
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
"callbackBufferSize"
    Parser (Double -> Double -> WebAudioBaseAudioContext)
-> Parser Double -> Parser (Double -> WebAudioBaseAudioContext)
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
"maxOutputChannelCount"
    Parser (Double -> WebAudioBaseAudioContext)
-> Parser Double -> Parser WebAudioBaseAudioContext
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
"sampleRate"
instance ToJSON WebAudioBaseAudioContext where
  toJSON :: WebAudioBaseAudioContext -> Value
toJSON WebAudioBaseAudioContext
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
"contextId" 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 (WebAudioBaseAudioContext -> Text
webAudioBaseAudioContextContextId WebAudioBaseAudioContext
p),
    (Text
"contextType" Text -> WebAudioContextType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (WebAudioContextType -> Pair)
-> Maybe WebAudioContextType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebAudioContextType -> Maybe WebAudioContextType
forall a. a -> Maybe a
Just (WebAudioBaseAudioContext -> WebAudioContextType
webAudioBaseAudioContextContextType WebAudioBaseAudioContext
p),
    (Text
"contextState" Text -> WebAudioContextState -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (WebAudioContextState -> Pair)
-> Maybe WebAudioContextState -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebAudioContextState -> Maybe WebAudioContextState
forall a. a -> Maybe a
Just (WebAudioBaseAudioContext -> WebAudioContextState
webAudioBaseAudioContextContextState WebAudioBaseAudioContext
p),
    (Text
"realtimeData" Text -> WebAudioContextRealtimeData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (WebAudioContextRealtimeData -> Pair)
-> Maybe WebAudioContextRealtimeData -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WebAudioBaseAudioContext -> Maybe WebAudioContextRealtimeData
webAudioBaseAudioContextRealtimeData WebAudioBaseAudioContext
p),
    (Text
"callbackBufferSize" 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 (WebAudioBaseAudioContext -> Double
webAudioBaseAudioContextCallbackBufferSize WebAudioBaseAudioContext
p),
    (Text
"maxOutputChannelCount" 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 (WebAudioBaseAudioContext -> Double
webAudioBaseAudioContextMaxOutputChannelCount WebAudioBaseAudioContext
p),
    (Text
"sampleRate" 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 (WebAudioBaseAudioContext -> Double
webAudioBaseAudioContextSampleRate WebAudioBaseAudioContext
p)
    ]

-- | Type 'WebAudio.AudioListener'.
--   Protocol object for AudioListener
data WebAudioAudioListener = WebAudioAudioListener
  {
    WebAudioAudioListener -> Text
webAudioAudioListenerListenerId :: WebAudioGraphObjectId,
    WebAudioAudioListener -> Text
webAudioAudioListenerContextId :: WebAudioGraphObjectId
  }
  deriving (WebAudioAudioListener -> WebAudioAudioListener -> Bool
(WebAudioAudioListener -> WebAudioAudioListener -> Bool)
-> (WebAudioAudioListener -> WebAudioAudioListener -> Bool)
-> Eq WebAudioAudioListener
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAudioAudioListener -> WebAudioAudioListener -> Bool
$c/= :: WebAudioAudioListener -> WebAudioAudioListener -> Bool
== :: WebAudioAudioListener -> WebAudioAudioListener -> Bool
$c== :: WebAudioAudioListener -> WebAudioAudioListener -> Bool
Eq, Int -> WebAudioAudioListener -> ShowS
[WebAudioAudioListener] -> ShowS
WebAudioAudioListener -> String
(Int -> WebAudioAudioListener -> ShowS)
-> (WebAudioAudioListener -> String)
-> ([WebAudioAudioListener] -> ShowS)
-> Show WebAudioAudioListener
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAudioAudioListener] -> ShowS
$cshowList :: [WebAudioAudioListener] -> ShowS
show :: WebAudioAudioListener -> String
$cshow :: WebAudioAudioListener -> String
showsPrec :: Int -> WebAudioAudioListener -> ShowS
$cshowsPrec :: Int -> WebAudioAudioListener -> ShowS
Show)
instance FromJSON WebAudioAudioListener where
  parseJSON :: Value -> Parser WebAudioAudioListener
parseJSON = String
-> (Object -> Parser WebAudioAudioListener)
-> Value
-> Parser WebAudioAudioListener
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAudioAudioListener" ((Object -> Parser WebAudioAudioListener)
 -> Value -> Parser WebAudioAudioListener)
-> (Object -> Parser WebAudioAudioListener)
-> Value
-> Parser WebAudioAudioListener
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> WebAudioAudioListener
WebAudioAudioListener
    (Text -> Text -> WebAudioAudioListener)
-> Parser Text -> Parser (Text -> WebAudioAudioListener)
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
"listenerId"
    Parser (Text -> WebAudioAudioListener)
-> Parser Text -> Parser WebAudioAudioListener
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
"contextId"
instance ToJSON WebAudioAudioListener where
  toJSON :: WebAudioAudioListener -> Value
toJSON WebAudioAudioListener
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
"listenerId" 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 (WebAudioAudioListener -> Text
webAudioAudioListenerListenerId WebAudioAudioListener
p),
    (Text
"contextId" 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 (WebAudioAudioListener -> Text
webAudioAudioListenerContextId WebAudioAudioListener
p)
    ]

-- | Type 'WebAudio.AudioNode'.
--   Protocol object for AudioNode
data WebAudioAudioNode = WebAudioAudioNode
  {
    WebAudioAudioNode -> Text
webAudioAudioNodeNodeId :: WebAudioGraphObjectId,
    WebAudioAudioNode -> Text
webAudioAudioNodeContextId :: WebAudioGraphObjectId,
    WebAudioAudioNode -> Text
webAudioAudioNodeNodeType :: WebAudioNodeType,
    WebAudioAudioNode -> Double
webAudioAudioNodeNumberOfInputs :: Double,
    WebAudioAudioNode -> Double
webAudioAudioNodeNumberOfOutputs :: Double,
    WebAudioAudioNode -> Double
webAudioAudioNodeChannelCount :: Double,
    WebAudioAudioNode -> WebAudioChannelCountMode
webAudioAudioNodeChannelCountMode :: WebAudioChannelCountMode,
    WebAudioAudioNode -> WebAudioChannelInterpretation
webAudioAudioNodeChannelInterpretation :: WebAudioChannelInterpretation
  }
  deriving (WebAudioAudioNode -> WebAudioAudioNode -> Bool
(WebAudioAudioNode -> WebAudioAudioNode -> Bool)
-> (WebAudioAudioNode -> WebAudioAudioNode -> Bool)
-> Eq WebAudioAudioNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAudioAudioNode -> WebAudioAudioNode -> Bool
$c/= :: WebAudioAudioNode -> WebAudioAudioNode -> Bool
== :: WebAudioAudioNode -> WebAudioAudioNode -> Bool
$c== :: WebAudioAudioNode -> WebAudioAudioNode -> Bool
Eq, Int -> WebAudioAudioNode -> ShowS
[WebAudioAudioNode] -> ShowS
WebAudioAudioNode -> String
(Int -> WebAudioAudioNode -> ShowS)
-> (WebAudioAudioNode -> String)
-> ([WebAudioAudioNode] -> ShowS)
-> Show WebAudioAudioNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAudioAudioNode] -> ShowS
$cshowList :: [WebAudioAudioNode] -> ShowS
show :: WebAudioAudioNode -> String
$cshow :: WebAudioAudioNode -> String
showsPrec :: Int -> WebAudioAudioNode -> ShowS
$cshowsPrec :: Int -> WebAudioAudioNode -> ShowS
Show)
instance FromJSON WebAudioAudioNode where
  parseJSON :: Value -> Parser WebAudioAudioNode
parseJSON = String
-> (Object -> Parser WebAudioAudioNode)
-> Value
-> Parser WebAudioAudioNode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAudioAudioNode" ((Object -> Parser WebAudioAudioNode)
 -> Value -> Parser WebAudioAudioNode)
-> (Object -> Parser WebAudioAudioNode)
-> Value
-> Parser WebAudioAudioNode
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> Text
-> Double
-> Double
-> Double
-> WebAudioChannelCountMode
-> WebAudioChannelInterpretation
-> WebAudioAudioNode
WebAudioAudioNode
    (Text
 -> Text
 -> Text
 -> Double
 -> Double
 -> Double
 -> WebAudioChannelCountMode
 -> WebAudioChannelInterpretation
 -> WebAudioAudioNode)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Double
      -> Double
      -> Double
      -> WebAudioChannelCountMode
      -> WebAudioChannelInterpretation
      -> WebAudioAudioNode)
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
"nodeId"
    Parser
  (Text
   -> Text
   -> Double
   -> Double
   -> Double
   -> WebAudioChannelCountMode
   -> WebAudioChannelInterpretation
   -> WebAudioAudioNode)
-> Parser Text
-> Parser
     (Text
      -> Double
      -> Double
      -> Double
      -> WebAudioChannelCountMode
      -> WebAudioChannelInterpretation
      -> WebAudioAudioNode)
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
"contextId"
    Parser
  (Text
   -> Double
   -> Double
   -> Double
   -> WebAudioChannelCountMode
   -> WebAudioChannelInterpretation
   -> WebAudioAudioNode)
-> Parser Text
-> Parser
     (Double
      -> Double
      -> Double
      -> WebAudioChannelCountMode
      -> WebAudioChannelInterpretation
      -> WebAudioAudioNode)
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
"nodeType"
    Parser
  (Double
   -> Double
   -> Double
   -> WebAudioChannelCountMode
   -> WebAudioChannelInterpretation
   -> WebAudioAudioNode)
-> Parser Double
-> Parser
     (Double
      -> Double
      -> WebAudioChannelCountMode
      -> WebAudioChannelInterpretation
      -> WebAudioAudioNode)
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
"numberOfInputs"
    Parser
  (Double
   -> Double
   -> WebAudioChannelCountMode
   -> WebAudioChannelInterpretation
   -> WebAudioAudioNode)
-> Parser Double
-> Parser
     (Double
      -> WebAudioChannelCountMode
      -> WebAudioChannelInterpretation
      -> WebAudioAudioNode)
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
"numberOfOutputs"
    Parser
  (Double
   -> WebAudioChannelCountMode
   -> WebAudioChannelInterpretation
   -> WebAudioAudioNode)
-> Parser Double
-> Parser
     (WebAudioChannelCountMode
      -> WebAudioChannelInterpretation -> WebAudioAudioNode)
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
"channelCount"
    Parser
  (WebAudioChannelCountMode
   -> WebAudioChannelInterpretation -> WebAudioAudioNode)
-> Parser WebAudioChannelCountMode
-> Parser (WebAudioChannelInterpretation -> WebAudioAudioNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser WebAudioChannelCountMode
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"channelCountMode"
    Parser (WebAudioChannelInterpretation -> WebAudioAudioNode)
-> Parser WebAudioChannelInterpretation -> Parser WebAudioAudioNode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser WebAudioChannelInterpretation
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"channelInterpretation"
instance ToJSON WebAudioAudioNode where
  toJSON :: WebAudioAudioNode -> Value
toJSON WebAudioAudioNode
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
"nodeId" 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 (WebAudioAudioNode -> Text
webAudioAudioNodeNodeId WebAudioAudioNode
p),
    (Text
"contextId" 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 (WebAudioAudioNode -> Text
webAudioAudioNodeContextId WebAudioAudioNode
p),
    (Text
"nodeType" 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 (WebAudioAudioNode -> Text
webAudioAudioNodeNodeType WebAudioAudioNode
p),
    (Text
"numberOfInputs" 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 (WebAudioAudioNode -> Double
webAudioAudioNodeNumberOfInputs WebAudioAudioNode
p),
    (Text
"numberOfOutputs" 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 (WebAudioAudioNode -> Double
webAudioAudioNodeNumberOfOutputs WebAudioAudioNode
p),
    (Text
"channelCount" 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 (WebAudioAudioNode -> Double
webAudioAudioNodeChannelCount WebAudioAudioNode
p),
    (Text
"channelCountMode" Text -> WebAudioChannelCountMode -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (WebAudioChannelCountMode -> Pair)
-> Maybe WebAudioChannelCountMode -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebAudioChannelCountMode -> Maybe WebAudioChannelCountMode
forall a. a -> Maybe a
Just (WebAudioAudioNode -> WebAudioChannelCountMode
webAudioAudioNodeChannelCountMode WebAudioAudioNode
p),
    (Text
"channelInterpretation" Text -> WebAudioChannelInterpretation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (WebAudioChannelInterpretation -> Pair)
-> Maybe WebAudioChannelInterpretation -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebAudioChannelInterpretation
-> Maybe WebAudioChannelInterpretation
forall a. a -> Maybe a
Just (WebAudioAudioNode -> WebAudioChannelInterpretation
webAudioAudioNodeChannelInterpretation WebAudioAudioNode
p)
    ]

-- | Type 'WebAudio.AudioParam'.
--   Protocol object for AudioParam
data WebAudioAudioParam = WebAudioAudioParam
  {
    WebAudioAudioParam -> Text
webAudioAudioParamParamId :: WebAudioGraphObjectId,
    WebAudioAudioParam -> Text
webAudioAudioParamNodeId :: WebAudioGraphObjectId,
    WebAudioAudioParam -> Text
webAudioAudioParamContextId :: WebAudioGraphObjectId,
    WebAudioAudioParam -> Text
webAudioAudioParamParamType :: WebAudioParamType,
    WebAudioAudioParam -> WebAudioAutomationRate
webAudioAudioParamRate :: WebAudioAutomationRate,
    WebAudioAudioParam -> Double
webAudioAudioParamDefaultValue :: Double,
    WebAudioAudioParam -> Double
webAudioAudioParamMinValue :: Double,
    WebAudioAudioParam -> Double
webAudioAudioParamMaxValue :: Double
  }
  deriving (WebAudioAudioParam -> WebAudioAudioParam -> Bool
(WebAudioAudioParam -> WebAudioAudioParam -> Bool)
-> (WebAudioAudioParam -> WebAudioAudioParam -> Bool)
-> Eq WebAudioAudioParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAudioAudioParam -> WebAudioAudioParam -> Bool
$c/= :: WebAudioAudioParam -> WebAudioAudioParam -> Bool
== :: WebAudioAudioParam -> WebAudioAudioParam -> Bool
$c== :: WebAudioAudioParam -> WebAudioAudioParam -> Bool
Eq, Int -> WebAudioAudioParam -> ShowS
[WebAudioAudioParam] -> ShowS
WebAudioAudioParam -> String
(Int -> WebAudioAudioParam -> ShowS)
-> (WebAudioAudioParam -> String)
-> ([WebAudioAudioParam] -> ShowS)
-> Show WebAudioAudioParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAudioAudioParam] -> ShowS
$cshowList :: [WebAudioAudioParam] -> ShowS
show :: WebAudioAudioParam -> String
$cshow :: WebAudioAudioParam -> String
showsPrec :: Int -> WebAudioAudioParam -> ShowS
$cshowsPrec :: Int -> WebAudioAudioParam -> ShowS
Show)
instance FromJSON WebAudioAudioParam where
  parseJSON :: Value -> Parser WebAudioAudioParam
parseJSON = String
-> (Object -> Parser WebAudioAudioParam)
-> Value
-> Parser WebAudioAudioParam
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAudioAudioParam" ((Object -> Parser WebAudioAudioParam)
 -> Value -> Parser WebAudioAudioParam)
-> (Object -> Parser WebAudioAudioParam)
-> Value
-> Parser WebAudioAudioParam
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> Text
-> Text
-> WebAudioAutomationRate
-> Double
-> Double
-> Double
-> WebAudioAudioParam
WebAudioAudioParam
    (Text
 -> Text
 -> Text
 -> Text
 -> WebAudioAutomationRate
 -> Double
 -> Double
 -> Double
 -> WebAudioAudioParam)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> WebAudioAutomationRate
      -> Double
      -> Double
      -> Double
      -> WebAudioAudioParam)
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
"paramId"
    Parser
  (Text
   -> Text
   -> Text
   -> WebAudioAutomationRate
   -> Double
   -> Double
   -> Double
   -> WebAudioAudioParam)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> WebAudioAutomationRate
      -> Double
      -> Double
      -> Double
      -> WebAudioAudioParam)
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
"nodeId"
    Parser
  (Text
   -> Text
   -> WebAudioAutomationRate
   -> Double
   -> Double
   -> Double
   -> WebAudioAudioParam)
-> Parser Text
-> Parser
     (Text
      -> WebAudioAutomationRate
      -> Double
      -> Double
      -> Double
      -> WebAudioAudioParam)
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
"contextId"
    Parser
  (Text
   -> WebAudioAutomationRate
   -> Double
   -> Double
   -> Double
   -> WebAudioAudioParam)
-> Parser Text
-> Parser
     (WebAudioAutomationRate
      -> Double -> Double -> Double -> WebAudioAudioParam)
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
"paramType"
    Parser
  (WebAudioAutomationRate
   -> Double -> Double -> Double -> WebAudioAudioParam)
-> Parser WebAudioAutomationRate
-> Parser (Double -> Double -> Double -> WebAudioAudioParam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser WebAudioAutomationRate
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"rate"
    Parser (Double -> Double -> Double -> WebAudioAudioParam)
-> Parser Double -> Parser (Double -> Double -> WebAudioAudioParam)
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
"defaultValue"
    Parser (Double -> Double -> WebAudioAudioParam)
-> Parser Double -> Parser (Double -> WebAudioAudioParam)
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
"minValue"
    Parser (Double -> WebAudioAudioParam)
-> Parser Double -> Parser WebAudioAudioParam
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
"maxValue"
instance ToJSON WebAudioAudioParam where
  toJSON :: WebAudioAudioParam -> Value
toJSON WebAudioAudioParam
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
"paramId" 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 (WebAudioAudioParam -> Text
webAudioAudioParamParamId WebAudioAudioParam
p),
    (Text
"nodeId" 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 (WebAudioAudioParam -> Text
webAudioAudioParamNodeId WebAudioAudioParam
p),
    (Text
"contextId" 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 (WebAudioAudioParam -> Text
webAudioAudioParamContextId WebAudioAudioParam
p),
    (Text
"paramType" 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 (WebAudioAudioParam -> Text
webAudioAudioParamParamType WebAudioAudioParam
p),
    (Text
"rate" Text -> WebAudioAutomationRate -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (WebAudioAutomationRate -> Pair)
-> Maybe WebAudioAutomationRate -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebAudioAutomationRate -> Maybe WebAudioAutomationRate
forall a. a -> Maybe a
Just (WebAudioAudioParam -> WebAudioAutomationRate
webAudioAudioParamRate WebAudioAudioParam
p),
    (Text
"defaultValue" 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 (WebAudioAudioParam -> Double
webAudioAudioParamDefaultValue WebAudioAudioParam
p),
    (Text
"minValue" 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 (WebAudioAudioParam -> Double
webAudioAudioParamMinValue WebAudioAudioParam
p),
    (Text
"maxValue" 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 (WebAudioAudioParam -> Double
webAudioAudioParamMaxValue WebAudioAudioParam
p)
    ]

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

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

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

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

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

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

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

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

-- | Type of the 'WebAudio.audioParamWillBeDestroyed' event.
data WebAudioAudioParamWillBeDestroyed = WebAudioAudioParamWillBeDestroyed
  {
    WebAudioAudioParamWillBeDestroyed -> Text
webAudioAudioParamWillBeDestroyedContextId :: WebAudioGraphObjectId,
    WebAudioAudioParamWillBeDestroyed -> Text
webAudioAudioParamWillBeDestroyedNodeId :: WebAudioGraphObjectId,
    WebAudioAudioParamWillBeDestroyed -> Text
webAudioAudioParamWillBeDestroyedParamId :: WebAudioGraphObjectId
  }
  deriving (WebAudioAudioParamWillBeDestroyed
-> WebAudioAudioParamWillBeDestroyed -> Bool
(WebAudioAudioParamWillBeDestroyed
 -> WebAudioAudioParamWillBeDestroyed -> Bool)
-> (WebAudioAudioParamWillBeDestroyed
    -> WebAudioAudioParamWillBeDestroyed -> Bool)
-> Eq WebAudioAudioParamWillBeDestroyed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAudioAudioParamWillBeDestroyed
-> WebAudioAudioParamWillBeDestroyed -> Bool
$c/= :: WebAudioAudioParamWillBeDestroyed
-> WebAudioAudioParamWillBeDestroyed -> Bool
== :: WebAudioAudioParamWillBeDestroyed
-> WebAudioAudioParamWillBeDestroyed -> Bool
$c== :: WebAudioAudioParamWillBeDestroyed
-> WebAudioAudioParamWillBeDestroyed -> Bool
Eq, Int -> WebAudioAudioParamWillBeDestroyed -> ShowS
[WebAudioAudioParamWillBeDestroyed] -> ShowS
WebAudioAudioParamWillBeDestroyed -> String
(Int -> WebAudioAudioParamWillBeDestroyed -> ShowS)
-> (WebAudioAudioParamWillBeDestroyed -> String)
-> ([WebAudioAudioParamWillBeDestroyed] -> ShowS)
-> Show WebAudioAudioParamWillBeDestroyed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAudioAudioParamWillBeDestroyed] -> ShowS
$cshowList :: [WebAudioAudioParamWillBeDestroyed] -> ShowS
show :: WebAudioAudioParamWillBeDestroyed -> String
$cshow :: WebAudioAudioParamWillBeDestroyed -> String
showsPrec :: Int -> WebAudioAudioParamWillBeDestroyed -> ShowS
$cshowsPrec :: Int -> WebAudioAudioParamWillBeDestroyed -> ShowS
Show)
instance FromJSON WebAudioAudioParamWillBeDestroyed where
  parseJSON :: Value -> Parser WebAudioAudioParamWillBeDestroyed
parseJSON = String
-> (Object -> Parser WebAudioAudioParamWillBeDestroyed)
-> Value
-> Parser WebAudioAudioParamWillBeDestroyed
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAudioAudioParamWillBeDestroyed" ((Object -> Parser WebAudioAudioParamWillBeDestroyed)
 -> Value -> Parser WebAudioAudioParamWillBeDestroyed)
-> (Object -> Parser WebAudioAudioParamWillBeDestroyed)
-> Value
-> Parser WebAudioAudioParamWillBeDestroyed
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Text -> WebAudioAudioParamWillBeDestroyed
WebAudioAudioParamWillBeDestroyed
    (Text -> Text -> Text -> WebAudioAudioParamWillBeDestroyed)
-> Parser Text
-> Parser (Text -> Text -> WebAudioAudioParamWillBeDestroyed)
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
"contextId"
    Parser (Text -> Text -> WebAudioAudioParamWillBeDestroyed)
-> Parser Text
-> Parser (Text -> WebAudioAudioParamWillBeDestroyed)
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
"nodeId"
    Parser (Text -> WebAudioAudioParamWillBeDestroyed)
-> Parser Text -> Parser WebAudioAudioParamWillBeDestroyed
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
"paramId"
instance Event WebAudioAudioParamWillBeDestroyed where
  eventName :: Proxy WebAudioAudioParamWillBeDestroyed -> String
eventName Proxy WebAudioAudioParamWillBeDestroyed
_ = String
"WebAudio.audioParamWillBeDestroyed"

-- | Type of the 'WebAudio.nodesConnected' event.
data WebAudioNodesConnected = WebAudioNodesConnected
  {
    WebAudioNodesConnected -> Text
webAudioNodesConnectedContextId :: WebAudioGraphObjectId,
    WebAudioNodesConnected -> Text
webAudioNodesConnectedSourceId :: WebAudioGraphObjectId,
    WebAudioNodesConnected -> Text
webAudioNodesConnectedDestinationId :: WebAudioGraphObjectId,
    WebAudioNodesConnected -> Maybe Double
webAudioNodesConnectedSourceOutputIndex :: Maybe Double,
    WebAudioNodesConnected -> Maybe Double
webAudioNodesConnectedDestinationInputIndex :: Maybe Double
  }
  deriving (WebAudioNodesConnected -> WebAudioNodesConnected -> Bool
(WebAudioNodesConnected -> WebAudioNodesConnected -> Bool)
-> (WebAudioNodesConnected -> WebAudioNodesConnected -> Bool)
-> Eq WebAudioNodesConnected
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAudioNodesConnected -> WebAudioNodesConnected -> Bool
$c/= :: WebAudioNodesConnected -> WebAudioNodesConnected -> Bool
== :: WebAudioNodesConnected -> WebAudioNodesConnected -> Bool
$c== :: WebAudioNodesConnected -> WebAudioNodesConnected -> Bool
Eq, Int -> WebAudioNodesConnected -> ShowS
[WebAudioNodesConnected] -> ShowS
WebAudioNodesConnected -> String
(Int -> WebAudioNodesConnected -> ShowS)
-> (WebAudioNodesConnected -> String)
-> ([WebAudioNodesConnected] -> ShowS)
-> Show WebAudioNodesConnected
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAudioNodesConnected] -> ShowS
$cshowList :: [WebAudioNodesConnected] -> ShowS
show :: WebAudioNodesConnected -> String
$cshow :: WebAudioNodesConnected -> String
showsPrec :: Int -> WebAudioNodesConnected -> ShowS
$cshowsPrec :: Int -> WebAudioNodesConnected -> ShowS
Show)
instance FromJSON WebAudioNodesConnected where
  parseJSON :: Value -> Parser WebAudioNodesConnected
parseJSON = String
-> (Object -> Parser WebAudioNodesConnected)
-> Value
-> Parser WebAudioNodesConnected
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAudioNodesConnected" ((Object -> Parser WebAudioNodesConnected)
 -> Value -> Parser WebAudioNodesConnected)
-> (Object -> Parser WebAudioNodesConnected)
-> Value
-> Parser WebAudioNodesConnected
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> Text
-> Maybe Double
-> Maybe Double
-> WebAudioNodesConnected
WebAudioNodesConnected
    (Text
 -> Text
 -> Text
 -> Maybe Double
 -> Maybe Double
 -> WebAudioNodesConnected)
-> Parser Text
-> Parser
     (Text
      -> Text -> Maybe Double -> Maybe Double -> WebAudioNodesConnected)
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
"contextId"
    Parser
  (Text
   -> Text -> Maybe Double -> Maybe Double -> WebAudioNodesConnected)
-> Parser Text
-> Parser
     (Text -> Maybe Double -> Maybe Double -> WebAudioNodesConnected)
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
"sourceId"
    Parser
  (Text -> Maybe Double -> Maybe Double -> WebAudioNodesConnected)
-> Parser Text
-> Parser (Maybe Double -> Maybe Double -> WebAudioNodesConnected)
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
"destinationId"
    Parser (Maybe Double -> Maybe Double -> WebAudioNodesConnected)
-> Parser (Maybe Double)
-> Parser (Maybe Double -> WebAudioNodesConnected)
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
"sourceOutputIndex"
    Parser (Maybe Double -> WebAudioNodesConnected)
-> Parser (Maybe Double) -> Parser WebAudioNodesConnected
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
"destinationInputIndex"
instance Event WebAudioNodesConnected where
  eventName :: Proxy WebAudioNodesConnected -> String
eventName Proxy WebAudioNodesConnected
_ = String
"WebAudio.nodesConnected"

-- | Type of the 'WebAudio.nodesDisconnected' event.
data WebAudioNodesDisconnected = WebAudioNodesDisconnected
  {
    WebAudioNodesDisconnected -> Text
webAudioNodesDisconnectedContextId :: WebAudioGraphObjectId,
    WebAudioNodesDisconnected -> Text
webAudioNodesDisconnectedSourceId :: WebAudioGraphObjectId,
    WebAudioNodesDisconnected -> Text
webAudioNodesDisconnectedDestinationId :: WebAudioGraphObjectId,
    WebAudioNodesDisconnected -> Maybe Double
webAudioNodesDisconnectedSourceOutputIndex :: Maybe Double,
    WebAudioNodesDisconnected -> Maybe Double
webAudioNodesDisconnectedDestinationInputIndex :: Maybe Double
  }
  deriving (WebAudioNodesDisconnected -> WebAudioNodesDisconnected -> Bool
(WebAudioNodesDisconnected -> WebAudioNodesDisconnected -> Bool)
-> (WebAudioNodesDisconnected -> WebAudioNodesDisconnected -> Bool)
-> Eq WebAudioNodesDisconnected
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAudioNodesDisconnected -> WebAudioNodesDisconnected -> Bool
$c/= :: WebAudioNodesDisconnected -> WebAudioNodesDisconnected -> Bool
== :: WebAudioNodesDisconnected -> WebAudioNodesDisconnected -> Bool
$c== :: WebAudioNodesDisconnected -> WebAudioNodesDisconnected -> Bool
Eq, Int -> WebAudioNodesDisconnected -> ShowS
[WebAudioNodesDisconnected] -> ShowS
WebAudioNodesDisconnected -> String
(Int -> WebAudioNodesDisconnected -> ShowS)
-> (WebAudioNodesDisconnected -> String)
-> ([WebAudioNodesDisconnected] -> ShowS)
-> Show WebAudioNodesDisconnected
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAudioNodesDisconnected] -> ShowS
$cshowList :: [WebAudioNodesDisconnected] -> ShowS
show :: WebAudioNodesDisconnected -> String
$cshow :: WebAudioNodesDisconnected -> String
showsPrec :: Int -> WebAudioNodesDisconnected -> ShowS
$cshowsPrec :: Int -> WebAudioNodesDisconnected -> ShowS
Show)
instance FromJSON WebAudioNodesDisconnected where
  parseJSON :: Value -> Parser WebAudioNodesDisconnected
parseJSON = String
-> (Object -> Parser WebAudioNodesDisconnected)
-> Value
-> Parser WebAudioNodesDisconnected
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAudioNodesDisconnected" ((Object -> Parser WebAudioNodesDisconnected)
 -> Value -> Parser WebAudioNodesDisconnected)
-> (Object -> Parser WebAudioNodesDisconnected)
-> Value
-> Parser WebAudioNodesDisconnected
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> Text
-> Maybe Double
-> Maybe Double
-> WebAudioNodesDisconnected
WebAudioNodesDisconnected
    (Text
 -> Text
 -> Text
 -> Maybe Double
 -> Maybe Double
 -> WebAudioNodesDisconnected)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Maybe Double
      -> Maybe Double
      -> WebAudioNodesDisconnected)
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
"contextId"
    Parser
  (Text
   -> Text
   -> Maybe Double
   -> Maybe Double
   -> WebAudioNodesDisconnected)
-> Parser Text
-> Parser
     (Text -> Maybe Double -> Maybe Double -> WebAudioNodesDisconnected)
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
"sourceId"
    Parser
  (Text -> Maybe Double -> Maybe Double -> WebAudioNodesDisconnected)
-> Parser Text
-> Parser
     (Maybe Double -> Maybe Double -> WebAudioNodesDisconnected)
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
"destinationId"
    Parser (Maybe Double -> Maybe Double -> WebAudioNodesDisconnected)
-> Parser (Maybe Double)
-> Parser (Maybe Double -> WebAudioNodesDisconnected)
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
"sourceOutputIndex"
    Parser (Maybe Double -> WebAudioNodesDisconnected)
-> Parser (Maybe Double) -> Parser WebAudioNodesDisconnected
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
"destinationInputIndex"
instance Event WebAudioNodesDisconnected where
  eventName :: Proxy WebAudioNodesDisconnected -> String
eventName Proxy WebAudioNodesDisconnected
_ = String
"WebAudio.nodesDisconnected"

-- | Type of the 'WebAudio.nodeParamConnected' event.
data WebAudioNodeParamConnected = WebAudioNodeParamConnected
  {
    WebAudioNodeParamConnected -> Text
webAudioNodeParamConnectedContextId :: WebAudioGraphObjectId,
    WebAudioNodeParamConnected -> Text
webAudioNodeParamConnectedSourceId :: WebAudioGraphObjectId,
    WebAudioNodeParamConnected -> Text
webAudioNodeParamConnectedDestinationId :: WebAudioGraphObjectId,
    WebAudioNodeParamConnected -> Maybe Double
webAudioNodeParamConnectedSourceOutputIndex :: Maybe Double
  }
  deriving (WebAudioNodeParamConnected -> WebAudioNodeParamConnected -> Bool
(WebAudioNodeParamConnected -> WebAudioNodeParamConnected -> Bool)
-> (WebAudioNodeParamConnected
    -> WebAudioNodeParamConnected -> Bool)
-> Eq WebAudioNodeParamConnected
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAudioNodeParamConnected -> WebAudioNodeParamConnected -> Bool
$c/= :: WebAudioNodeParamConnected -> WebAudioNodeParamConnected -> Bool
== :: WebAudioNodeParamConnected -> WebAudioNodeParamConnected -> Bool
$c== :: WebAudioNodeParamConnected -> WebAudioNodeParamConnected -> Bool
Eq, Int -> WebAudioNodeParamConnected -> ShowS
[WebAudioNodeParamConnected] -> ShowS
WebAudioNodeParamConnected -> String
(Int -> WebAudioNodeParamConnected -> ShowS)
-> (WebAudioNodeParamConnected -> String)
-> ([WebAudioNodeParamConnected] -> ShowS)
-> Show WebAudioNodeParamConnected
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAudioNodeParamConnected] -> ShowS
$cshowList :: [WebAudioNodeParamConnected] -> ShowS
show :: WebAudioNodeParamConnected -> String
$cshow :: WebAudioNodeParamConnected -> String
showsPrec :: Int -> WebAudioNodeParamConnected -> ShowS
$cshowsPrec :: Int -> WebAudioNodeParamConnected -> ShowS
Show)
instance FromJSON WebAudioNodeParamConnected where
  parseJSON :: Value -> Parser WebAudioNodeParamConnected
parseJSON = String
-> (Object -> Parser WebAudioNodeParamConnected)
-> Value
-> Parser WebAudioNodeParamConnected
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAudioNodeParamConnected" ((Object -> Parser WebAudioNodeParamConnected)
 -> Value -> Parser WebAudioNodeParamConnected)
-> (Object -> Parser WebAudioNodeParamConnected)
-> Value
-> Parser WebAudioNodeParamConnected
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Text -> Maybe Double -> WebAudioNodeParamConnected
WebAudioNodeParamConnected
    (Text
 -> Text -> Text -> Maybe Double -> WebAudioNodeParamConnected)
-> Parser Text
-> Parser
     (Text -> Text -> Maybe Double -> WebAudioNodeParamConnected)
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
"contextId"
    Parser (Text -> Text -> Maybe Double -> WebAudioNodeParamConnected)
-> Parser Text
-> Parser (Text -> Maybe Double -> WebAudioNodeParamConnected)
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
"sourceId"
    Parser (Text -> Maybe Double -> WebAudioNodeParamConnected)
-> Parser Text
-> Parser (Maybe Double -> WebAudioNodeParamConnected)
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
"destinationId"
    Parser (Maybe Double -> WebAudioNodeParamConnected)
-> Parser (Maybe Double) -> Parser WebAudioNodeParamConnected
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
"sourceOutputIndex"
instance Event WebAudioNodeParamConnected where
  eventName :: Proxy WebAudioNodeParamConnected -> String
eventName Proxy WebAudioNodeParamConnected
_ = String
"WebAudio.nodeParamConnected"

-- | Type of the 'WebAudio.nodeParamDisconnected' event.
data WebAudioNodeParamDisconnected = WebAudioNodeParamDisconnected
  {
    WebAudioNodeParamDisconnected -> Text
webAudioNodeParamDisconnectedContextId :: WebAudioGraphObjectId,
    WebAudioNodeParamDisconnected -> Text
webAudioNodeParamDisconnectedSourceId :: WebAudioGraphObjectId,
    WebAudioNodeParamDisconnected -> Text
webAudioNodeParamDisconnectedDestinationId :: WebAudioGraphObjectId,
    WebAudioNodeParamDisconnected -> Maybe Double
webAudioNodeParamDisconnectedSourceOutputIndex :: Maybe Double
  }
  deriving (WebAudioNodeParamDisconnected
-> WebAudioNodeParamDisconnected -> Bool
(WebAudioNodeParamDisconnected
 -> WebAudioNodeParamDisconnected -> Bool)
-> (WebAudioNodeParamDisconnected
    -> WebAudioNodeParamDisconnected -> Bool)
-> Eq WebAudioNodeParamDisconnected
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAudioNodeParamDisconnected
-> WebAudioNodeParamDisconnected -> Bool
$c/= :: WebAudioNodeParamDisconnected
-> WebAudioNodeParamDisconnected -> Bool
== :: WebAudioNodeParamDisconnected
-> WebAudioNodeParamDisconnected -> Bool
$c== :: WebAudioNodeParamDisconnected
-> WebAudioNodeParamDisconnected -> Bool
Eq, Int -> WebAudioNodeParamDisconnected -> ShowS
[WebAudioNodeParamDisconnected] -> ShowS
WebAudioNodeParamDisconnected -> String
(Int -> WebAudioNodeParamDisconnected -> ShowS)
-> (WebAudioNodeParamDisconnected -> String)
-> ([WebAudioNodeParamDisconnected] -> ShowS)
-> Show WebAudioNodeParamDisconnected
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAudioNodeParamDisconnected] -> ShowS
$cshowList :: [WebAudioNodeParamDisconnected] -> ShowS
show :: WebAudioNodeParamDisconnected -> String
$cshow :: WebAudioNodeParamDisconnected -> String
showsPrec :: Int -> WebAudioNodeParamDisconnected -> ShowS
$cshowsPrec :: Int -> WebAudioNodeParamDisconnected -> ShowS
Show)
instance FromJSON WebAudioNodeParamDisconnected where
  parseJSON :: Value -> Parser WebAudioNodeParamDisconnected
parseJSON = String
-> (Object -> Parser WebAudioNodeParamDisconnected)
-> Value
-> Parser WebAudioNodeParamDisconnected
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAudioNodeParamDisconnected" ((Object -> Parser WebAudioNodeParamDisconnected)
 -> Value -> Parser WebAudioNodeParamDisconnected)
-> (Object -> Parser WebAudioNodeParamDisconnected)
-> Value
-> Parser WebAudioNodeParamDisconnected
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text -> Text -> Maybe Double -> WebAudioNodeParamDisconnected
WebAudioNodeParamDisconnected
    (Text
 -> Text -> Text -> Maybe Double -> WebAudioNodeParamDisconnected)
-> Parser Text
-> Parser
     (Text -> Text -> Maybe Double -> WebAudioNodeParamDisconnected)
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
"contextId"
    Parser
  (Text -> Text -> Maybe Double -> WebAudioNodeParamDisconnected)
-> Parser Text
-> Parser (Text -> Maybe Double -> WebAudioNodeParamDisconnected)
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
"sourceId"
    Parser (Text -> Maybe Double -> WebAudioNodeParamDisconnected)
-> Parser Text
-> Parser (Maybe Double -> WebAudioNodeParamDisconnected)
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
"destinationId"
    Parser (Maybe Double -> WebAudioNodeParamDisconnected)
-> Parser (Maybe Double) -> Parser WebAudioNodeParamDisconnected
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
"sourceOutputIndex"
instance Event WebAudioNodeParamDisconnected where
  eventName :: Proxy WebAudioNodeParamDisconnected -> String
eventName Proxy WebAudioNodeParamDisconnected
_ = String
"WebAudio.nodeParamDisconnected"

-- | Enables the WebAudio domain and starts sending context lifetime events.

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

-- | Disables the WebAudio domain.

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

-- | Fetch the realtime data from the registered contexts.

-- | Parameters of the 'WebAudio.getRealtimeData' command.
data PWebAudioGetRealtimeData = PWebAudioGetRealtimeData
  {
    PWebAudioGetRealtimeData -> Text
pWebAudioGetRealtimeDataContextId :: WebAudioGraphObjectId
  }
  deriving (PWebAudioGetRealtimeData -> PWebAudioGetRealtimeData -> Bool
(PWebAudioGetRealtimeData -> PWebAudioGetRealtimeData -> Bool)
-> (PWebAudioGetRealtimeData -> PWebAudioGetRealtimeData -> Bool)
-> Eq PWebAudioGetRealtimeData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWebAudioGetRealtimeData -> PWebAudioGetRealtimeData -> Bool
$c/= :: PWebAudioGetRealtimeData -> PWebAudioGetRealtimeData -> Bool
== :: PWebAudioGetRealtimeData -> PWebAudioGetRealtimeData -> Bool
$c== :: PWebAudioGetRealtimeData -> PWebAudioGetRealtimeData -> Bool
Eq, Int -> PWebAudioGetRealtimeData -> ShowS
[PWebAudioGetRealtimeData] -> ShowS
PWebAudioGetRealtimeData -> String
(Int -> PWebAudioGetRealtimeData -> ShowS)
-> (PWebAudioGetRealtimeData -> String)
-> ([PWebAudioGetRealtimeData] -> ShowS)
-> Show PWebAudioGetRealtimeData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWebAudioGetRealtimeData] -> ShowS
$cshowList :: [PWebAudioGetRealtimeData] -> ShowS
show :: PWebAudioGetRealtimeData -> String
$cshow :: PWebAudioGetRealtimeData -> String
showsPrec :: Int -> PWebAudioGetRealtimeData -> ShowS
$cshowsPrec :: Int -> PWebAudioGetRealtimeData -> ShowS
Show)
pWebAudioGetRealtimeData
  :: WebAudioGraphObjectId
  -> PWebAudioGetRealtimeData
pWebAudioGetRealtimeData :: Text -> PWebAudioGetRealtimeData
pWebAudioGetRealtimeData
  Text
arg_pWebAudioGetRealtimeDataContextId
  = Text -> PWebAudioGetRealtimeData
PWebAudioGetRealtimeData
    Text
arg_pWebAudioGetRealtimeDataContextId
instance ToJSON PWebAudioGetRealtimeData where
  toJSON :: PWebAudioGetRealtimeData -> Value
toJSON PWebAudioGetRealtimeData
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
"contextId" 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 (PWebAudioGetRealtimeData -> Text
pWebAudioGetRealtimeDataContextId PWebAudioGetRealtimeData
p)
    ]
data WebAudioGetRealtimeData = WebAudioGetRealtimeData
  {
    WebAudioGetRealtimeData -> WebAudioContextRealtimeData
webAudioGetRealtimeDataRealtimeData :: WebAudioContextRealtimeData
  }
  deriving (WebAudioGetRealtimeData -> WebAudioGetRealtimeData -> Bool
(WebAudioGetRealtimeData -> WebAudioGetRealtimeData -> Bool)
-> (WebAudioGetRealtimeData -> WebAudioGetRealtimeData -> Bool)
-> Eq WebAudioGetRealtimeData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAudioGetRealtimeData -> WebAudioGetRealtimeData -> Bool
$c/= :: WebAudioGetRealtimeData -> WebAudioGetRealtimeData -> Bool
== :: WebAudioGetRealtimeData -> WebAudioGetRealtimeData -> Bool
$c== :: WebAudioGetRealtimeData -> WebAudioGetRealtimeData -> Bool
Eq, Int -> WebAudioGetRealtimeData -> ShowS
[WebAudioGetRealtimeData] -> ShowS
WebAudioGetRealtimeData -> String
(Int -> WebAudioGetRealtimeData -> ShowS)
-> (WebAudioGetRealtimeData -> String)
-> ([WebAudioGetRealtimeData] -> ShowS)
-> Show WebAudioGetRealtimeData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAudioGetRealtimeData] -> ShowS
$cshowList :: [WebAudioGetRealtimeData] -> ShowS
show :: WebAudioGetRealtimeData -> String
$cshow :: WebAudioGetRealtimeData -> String
showsPrec :: Int -> WebAudioGetRealtimeData -> ShowS
$cshowsPrec :: Int -> WebAudioGetRealtimeData -> ShowS
Show)
instance FromJSON WebAudioGetRealtimeData where
  parseJSON :: Value -> Parser WebAudioGetRealtimeData
parseJSON = String
-> (Object -> Parser WebAudioGetRealtimeData)
-> Value
-> Parser WebAudioGetRealtimeData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAudioGetRealtimeData" ((Object -> Parser WebAudioGetRealtimeData)
 -> Value -> Parser WebAudioGetRealtimeData)
-> (Object -> Parser WebAudioGetRealtimeData)
-> Value
-> Parser WebAudioGetRealtimeData
forall a b. (a -> b) -> a -> b
$ \Object
o -> WebAudioContextRealtimeData -> WebAudioGetRealtimeData
WebAudioGetRealtimeData
    (WebAudioContextRealtimeData -> WebAudioGetRealtimeData)
-> Parser WebAudioContextRealtimeData
-> Parser WebAudioGetRealtimeData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser WebAudioContextRealtimeData
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"realtimeData"
instance Command PWebAudioGetRealtimeData where
  type CommandResponse PWebAudioGetRealtimeData = WebAudioGetRealtimeData
  commandName :: Proxy PWebAudioGetRealtimeData -> String
commandName Proxy PWebAudioGetRealtimeData
_ = String
"WebAudio.getRealtimeData"