{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.VTTRegionList
       (item, item_, itemUnsafe, itemUnchecked, getRegionById,
        getRegionById_, getRegionByIdUnsafe, getRegionByIdUnchecked,
        getLength, VTTRegionList(..), gTypeVTTRegionList)
       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/VTTRegionList.item Mozilla VTTRegionList.item documentation> 
item ::
     (MonadDOM m) => VTTRegionList -> Word -> m (Maybe VTTRegion)
item :: forall (m :: * -> *).
MonadDOM m =>
VTTRegionList -> Word -> m (Maybe VTTRegion)
item VTTRegionList
self Word
index
  = DOM (Maybe VTTRegion) -> m (Maybe VTTRegion)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((VTTRegionList
self VTTRegionList
-> Getting (JSM JSVal) VTTRegionList (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"item" [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
index]) JSM JSVal
-> (JSVal -> DOM (Maybe VTTRegion)) -> DOM (Maybe VTTRegion)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe VTTRegion)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/VTTRegionList.item Mozilla VTTRegionList.item documentation> 
item_ :: (MonadDOM m) => VTTRegionList -> Word -> m ()
item_ :: forall (m :: * -> *). MonadDOM m => VTTRegionList -> Word -> m ()
item_ VTTRegionList
self Word
index
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (VTTRegionList
self VTTRegionList
-> Getting (JSM JSVal) VTTRegionList (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"item" [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
index]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/VTTRegionList.item Mozilla VTTRegionList.item documentation> 
itemUnsafe ::
           (MonadDOM m, HasCallStack) => VTTRegionList -> Word -> m VTTRegion
itemUnsafe :: forall (m :: * -> *).
(MonadDOM m, HasCallStack) =>
VTTRegionList -> Word -> m VTTRegion
itemUnsafe VTTRegionList
self Word
index
  = DOM VTTRegion -> m VTTRegion
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((VTTRegionList
self VTTRegionList
-> Getting (JSM JSVal) VTTRegionList (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"item" [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
index]) JSM JSVal
-> (JSVal -> DOM (Maybe VTTRegion)) -> DOM (Maybe VTTRegion)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe VTTRegion)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe VTTRegion)
-> (Maybe VTTRegion -> DOM VTTRegion) -> DOM VTTRegion
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM VTTRegion
-> (VTTRegion -> DOM VTTRegion) -> Maybe VTTRegion -> DOM VTTRegion
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM VTTRegion
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") VTTRegion -> DOM VTTRegion
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/VTTRegionList.item Mozilla VTTRegionList.item documentation> 
itemUnchecked ::
              (MonadDOM m) => VTTRegionList -> Word -> m VTTRegion
itemUnchecked :: forall (m :: * -> *).
MonadDOM m =>
VTTRegionList -> Word -> m VTTRegion
itemUnchecked VTTRegionList
self Word
index
  = DOM VTTRegion -> m VTTRegion
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((VTTRegionList
self VTTRegionList
-> Getting (JSM JSVal) VTTRegionList (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"item" [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
index]) JSM JSVal -> (JSVal -> DOM VTTRegion) -> DOM VTTRegion
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM VTTRegion
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/VTTRegionList.getRegionById Mozilla VTTRegionList.getRegionById documentation> 
getRegionById ::
              (MonadDOM m, ToJSString id) =>
                VTTRegionList -> id -> m (Maybe VTTRegion)
getRegionById :: forall (m :: * -> *) id.
(MonadDOM m, ToJSString id) =>
VTTRegionList -> id -> m (Maybe VTTRegion)
getRegionById VTTRegionList
self id
id
  = DOM (Maybe VTTRegion) -> m (Maybe VTTRegion)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((VTTRegionList
self VTTRegionList
-> Getting (JSM JSVal) VTTRegionList (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getRegionById" [id -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal id
id]) JSM JSVal
-> (JSVal -> DOM (Maybe VTTRegion)) -> DOM (Maybe VTTRegion)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe VTTRegion)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/VTTRegionList.getRegionById Mozilla VTTRegionList.getRegionById documentation> 
getRegionById_ ::
               (MonadDOM m, ToJSString id) => VTTRegionList -> id -> m ()
getRegionById_ :: forall (m :: * -> *) id.
(MonadDOM m, ToJSString id) =>
VTTRegionList -> id -> m ()
getRegionById_ VTTRegionList
self id
id
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (VTTRegionList
self VTTRegionList
-> Getting (JSM JSVal) VTTRegionList (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getRegionById" [id -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal id
id]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/VTTRegionList.getRegionById Mozilla VTTRegionList.getRegionById documentation> 
getRegionByIdUnsafe ::
                    (MonadDOM m, ToJSString id, HasCallStack) =>
                      VTTRegionList -> id -> m VTTRegion
getRegionByIdUnsafe :: forall (m :: * -> *) id.
(MonadDOM m, ToJSString id, HasCallStack) =>
VTTRegionList -> id -> m VTTRegion
getRegionByIdUnsafe VTTRegionList
self id
id
  = DOM VTTRegion -> m VTTRegion
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((VTTRegionList
self VTTRegionList
-> Getting (JSM JSVal) VTTRegionList (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getRegionById" [id -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal id
id]) JSM JSVal
-> (JSVal -> DOM (Maybe VTTRegion)) -> DOM (Maybe VTTRegion)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe VTTRegion)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe VTTRegion)
-> (Maybe VTTRegion -> DOM VTTRegion) -> DOM VTTRegion
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM VTTRegion
-> (VTTRegion -> DOM VTTRegion) -> Maybe VTTRegion -> DOM VTTRegion
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM VTTRegion
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") VTTRegion -> DOM VTTRegion
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/VTTRegionList.getRegionById Mozilla VTTRegionList.getRegionById documentation> 
getRegionByIdUnchecked ::
                       (MonadDOM m, ToJSString id) => VTTRegionList -> id -> m VTTRegion
getRegionByIdUnchecked :: forall (m :: * -> *) id.
(MonadDOM m, ToJSString id) =>
VTTRegionList -> id -> m VTTRegion
getRegionByIdUnchecked VTTRegionList
self id
id
  = DOM VTTRegion -> m VTTRegion
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((VTTRegionList
self VTTRegionList
-> Getting (JSM JSVal) VTTRegionList (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getRegionById" [id -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal id
id]) JSM JSVal -> (JSVal -> DOM VTTRegion) -> DOM VTTRegion
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM VTTRegion
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/VTTRegionList.length Mozilla VTTRegionList.length documentation> 
getLength :: (MonadDOM m) => VTTRegionList -> m Word
getLength :: forall (m :: * -> *). MonadDOM m => VTTRegionList -> m Word
getLength VTTRegionList
self
  = DOM Word -> m Word
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (Double -> Word
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Word) -> JSM Double -> DOM Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((VTTRegionList
self VTTRegionList
-> Getting (JSM JSVal) VTTRegionList (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter VTTRegionList (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"length") JSM JSVal -> (JSVal -> JSM Double) -> JSM Double
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM Double
forall value. ToJSVal value => value -> JSM Double
valToNumber))