{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.WebKitAnimationEvent
       (newWebKitAnimationEvent, getAnimationName, getElapsedTime,
        WebKitAnimationEvent(..), gTypeWebKitAnimationEvent)
       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/WebKitAnimationEvent Mozilla WebKitAnimationEvent documentation> 
newWebKitAnimationEvent ::
                        (MonadDOM m, ToJSString type') =>
                          type' -> Maybe WebKitAnimationEventInit -> m WebKitAnimationEvent
newWebKitAnimationEvent :: type' -> Maybe WebKitAnimationEventInit -> m WebKitAnimationEvent
newWebKitAnimationEvent type'
type' Maybe WebKitAnimationEventInit
eventInitDict
  = DOM WebKitAnimationEvent -> m WebKitAnimationEvent
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSVal -> WebKitAnimationEvent
WebKitAnimationEvent (JSVal -> WebKitAnimationEvent)
-> JSM JSVal -> DOM WebKitAnimationEvent
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]
"WebKitAnimationEvent")
           [type' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal type'
type', Maybe WebKitAnimationEventInit -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe WebKitAnimationEventInit
eventInitDict])

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebKitAnimationEvent.animationName Mozilla WebKitAnimationEvent.animationName documentation> 
getAnimationName ::
                 (MonadDOM m, FromJSString result) =>
                   WebKitAnimationEvent -> m result
getAnimationName :: WebKitAnimationEvent -> m result
getAnimationName WebKitAnimationEvent
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((WebKitAnimationEvent
self WebKitAnimationEvent
-> Getting (JSM JSVal) WebKitAnimationEvent (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter WebKitAnimationEvent (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"animationName") 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)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebKitAnimationEvent.elapsedTime Mozilla WebKitAnimationEvent.elapsedTime documentation> 
getElapsedTime :: (MonadDOM m) => WebKitAnimationEvent -> m Double
getElapsedTime :: WebKitAnimationEvent -> m Double
getElapsedTime WebKitAnimationEvent
self
  = DOM Double -> m Double
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((WebKitAnimationEvent
self WebKitAnimationEvent
-> Getting (JSM JSVal) WebKitAnimationEvent (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter WebKitAnimationEvent (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"elapsedTime") JSM JSVal -> (JSVal -> DOM Double) -> DOM Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Double
forall value. ToJSVal value => value -> DOM Double
valToNumber)