{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.WebKitMediaKeys
       (newWebKitMediaKeys, createSession, createSession_,
        isTypeSupported, isTypeSupported_, getKeySystem,
        WebKitMediaKeys(..), gTypeWebKitMediaKeys)
       where
import Prelude ((.), (==), (>>=), return, IO, Int, Float, Double, Bool(..), Maybe, maybe, fromIntegral, round, realToFrac, fmap, Show, Read, Eq, Ord, Maybe(..))
import qualified Prelude (error)
import Data.Typeable (Typeable)
import Data.Traversable (mapM)
import Language.Javascript.JSaddle (JSM(..), JSVal(..), JSString, strictEqual, toJSVal, valToStr, valToNumber, valToBool, js, jss, jsf, jsg, function, asyncFunction, new, array, jsUndefined, (!), (!!))
import Data.Int (Int64)
import Data.Word (Word, Word64)
import JSDOM.Types
import Control.Applicative ((<$>))
import Control.Monad (void)
import Control.Lens.Operators ((^.))
import JSDOM.EventTargetClosures (EventName, unsafeEventName, unsafeEventNameAsync)
import JSDOM.Enums

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebKitMediaKeys Mozilla WebKitMediaKeys documentation> 
newWebKitMediaKeys ::
                   (MonadDOM m, ToJSString keySystem) =>
                     keySystem -> m WebKitMediaKeys
newWebKitMediaKeys :: keySystem -> m WebKitMediaKeys
newWebKitMediaKeys keySystem
keySystem
  = DOM WebKitMediaKeys -> m WebKitMediaKeys
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSVal -> WebKitMediaKeys
WebKitMediaKeys (JSVal -> WebKitMediaKeys) -> JSM JSVal -> DOM WebKitMediaKeys
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         JSM JSVal -> [JSM JSVal] -> JSM JSVal
forall constructor args.
(MakeObject constructor, MakeArgs args) =>
constructor -> args -> JSM JSVal
new ([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"WebKitMediaKeys") [keySystem -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal keySystem
keySystem])

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebKitMediaKeys.createSession Mozilla WebKitMediaKeys.createSession documentation> 
createSession ::
              (MonadDOM m, ToJSString type', IsUint8Array initData) =>
                WebKitMediaKeys -> type' -> initData -> m WebKitMediaKeySession
createSession :: WebKitMediaKeys -> type' -> initData -> m WebKitMediaKeySession
createSession WebKitMediaKeys
self type'
type' initData
initData
  = DOM WebKitMediaKeySession -> m WebKitMediaKeySession
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebKitMediaKeys
self WebKitMediaKeys
-> Getting (JSM JSVal) WebKitMediaKeys (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"createSession" [type' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal type'
type', initData -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal initData
initData])
         JSM JSVal
-> (JSVal -> DOM WebKitMediaKeySession)
-> DOM WebKitMediaKeySession
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM WebKitMediaKeySession
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebKitMediaKeys.createSession Mozilla WebKitMediaKeys.createSession documentation> 
createSession_ ::
               (MonadDOM m, ToJSString type', IsUint8Array initData) =>
                 WebKitMediaKeys -> type' -> initData -> m ()
createSession_ :: WebKitMediaKeys -> type' -> initData -> m ()
createSession_ WebKitMediaKeys
self type'
type' initData
initData
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (WebKitMediaKeys
self WebKitMediaKeys
-> Getting (JSM JSVal) WebKitMediaKeys (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"createSession" [type' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal type'
type', initData -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal initData
initData]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebKitMediaKeys.isTypeSupported Mozilla WebKitMediaKeys.isTypeSupported documentation> 
isTypeSupported ::
                (MonadDOM m, ToJSString keySystem, ToJSString type') =>
                  keySystem -> Maybe type' -> m Bool
isTypeSupported :: keySystem -> Maybe type' -> m Bool
isTypeSupported keySystem
keySystem Maybe type'
type'
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"WebKitMediaKeys") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"isTypeSupported"
          [keySystem -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal keySystem
keySystem, Maybe type' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe type'
type'])
         JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebKitMediaKeys.isTypeSupported Mozilla WebKitMediaKeys.isTypeSupported documentation> 
isTypeSupported_ ::
                 (MonadDOM m, ToJSString keySystem, ToJSString type') =>
                   keySystem -> Maybe type' -> m ()
isTypeSupported_ :: keySystem -> Maybe type' -> m ()
isTypeSupported_ keySystem
keySystem Maybe type'
type'
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"WebKitMediaKeys") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"isTypeSupported"
            [keySystem -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal keySystem
keySystem, Maybe type' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe type'
type']))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebKitMediaKeys.keySystem Mozilla WebKitMediaKeys.keySystem documentation> 
getKeySystem ::
             (MonadDOM m, FromJSString result) => WebKitMediaKeys -> m result
getKeySystem :: WebKitMediaKeys -> m result
getKeySystem WebKitMediaKeys
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((WebKitMediaKeys
self WebKitMediaKeys
-> Getting (JSM JSVal) WebKitMediaKeys (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter WebKitMediaKeys (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"keySystem") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)