{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.SVGAnimationElement
       (getStartTime, getStartTime_, getCurrentTime, getCurrentTime_,
        getSimpleDuration, getSimpleDuration_, beginElement,
        beginElementAt, endElement, endElementAt, getTargetElement,
        SVGAnimationElement(..), gTypeSVGAnimationElement,
        IsSVGAnimationElement, toSVGAnimationElement)
       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/SVGAnimationElement.getStartTime Mozilla SVGAnimationElement.getStartTime documentation> 
getStartTime ::
             (MonadDOM m, IsSVGAnimationElement self) => self -> m Float
getStartTime :: self -> m Float
getStartTime self
self
  = DOM Float -> m Float
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Float) -> JSM Double -> DOM Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         (((self -> SVGAnimationElement
forall o. IsSVGAnimationElement o => o -> SVGAnimationElement
toSVGAnimationElement self
self) SVGAnimationElement
-> Getting (JSM JSVal) SVGAnimationElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getStartTime" ()) JSM JSVal -> (JSVal -> JSM Double) -> JSM Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            JSVal -> JSM Double
forall value. ToJSVal value => value -> JSM Double
valToNumber))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/SVGAnimationElement.getStartTime Mozilla SVGAnimationElement.getStartTime documentation> 
getStartTime_ ::
              (MonadDOM m, IsSVGAnimationElement self) => self -> m ()
getStartTime_ :: self -> m ()
getStartTime_ self
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> SVGAnimationElement
forall o. IsSVGAnimationElement o => o -> SVGAnimationElement
toSVGAnimationElement self
self) SVGAnimationElement
-> Getting (JSM JSVal) SVGAnimationElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getStartTime" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/SVGAnimationElement.getCurrentTime Mozilla SVGAnimationElement.getCurrentTime documentation> 
getCurrentTime ::
               (MonadDOM m, IsSVGAnimationElement self) => self -> m Float
getCurrentTime :: self -> m Float
getCurrentTime self
self
  = DOM Float -> m Float
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Float) -> JSM Double -> DOM Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         (((self -> SVGAnimationElement
forall o. IsSVGAnimationElement o => o -> SVGAnimationElement
toSVGAnimationElement self
self) SVGAnimationElement
-> Getting (JSM JSVal) SVGAnimationElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getCurrentTime" ()) JSM JSVal -> (JSVal -> JSM Double) -> JSM Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            JSVal -> JSM Double
forall value. ToJSVal value => value -> JSM Double
valToNumber))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/SVGAnimationElement.getCurrentTime Mozilla SVGAnimationElement.getCurrentTime documentation> 
getCurrentTime_ ::
                (MonadDOM m, IsSVGAnimationElement self) => self -> m ()
getCurrentTime_ :: self -> m ()
getCurrentTime_ self
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> SVGAnimationElement
forall o. IsSVGAnimationElement o => o -> SVGAnimationElement
toSVGAnimationElement self
self) SVGAnimationElement
-> Getting (JSM JSVal) SVGAnimationElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getCurrentTime" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/SVGAnimationElement.getSimpleDuration Mozilla SVGAnimationElement.getSimpleDuration documentation> 
getSimpleDuration ::
                  (MonadDOM m, IsSVGAnimationElement self) => self -> m Float
getSimpleDuration :: self -> m Float
getSimpleDuration self
self
  = DOM Float -> m Float
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Float) -> JSM Double -> DOM Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         (((self -> SVGAnimationElement
forall o. IsSVGAnimationElement o => o -> SVGAnimationElement
toSVGAnimationElement self
self) SVGAnimationElement
-> Getting (JSM JSVal) SVGAnimationElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getSimpleDuration" ()) JSM JSVal -> (JSVal -> JSM Double) -> JSM Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            JSVal -> JSM Double
forall value. ToJSVal value => value -> JSM Double
valToNumber))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/SVGAnimationElement.getSimpleDuration Mozilla SVGAnimationElement.getSimpleDuration documentation> 
getSimpleDuration_ ::
                   (MonadDOM m, IsSVGAnimationElement self) => self -> m ()
getSimpleDuration_ :: self -> m ()
getSimpleDuration_ self
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> SVGAnimationElement
forall o. IsSVGAnimationElement o => o -> SVGAnimationElement
toSVGAnimationElement self
self) SVGAnimationElement
-> Getting (JSM JSVal) SVGAnimationElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getSimpleDuration" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/SVGAnimationElement.beginElement Mozilla SVGAnimationElement.beginElement documentation> 
beginElement ::
             (MonadDOM m, IsSVGAnimationElement self) => self -> m ()
beginElement :: self -> m ()
beginElement self
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> SVGAnimationElement
forall o. IsSVGAnimationElement o => o -> SVGAnimationElement
toSVGAnimationElement self
self) SVGAnimationElement
-> Getting (JSM JSVal) SVGAnimationElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"beginElement" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/SVGAnimationElement.beginElementAt Mozilla SVGAnimationElement.beginElementAt documentation> 
beginElementAt ::
               (MonadDOM m, IsSVGAnimationElement self) =>
                 self -> Maybe Float -> m ()
beginElementAt :: self -> Maybe Float -> m ()
beginElementAt self
self Maybe Float
offset
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> SVGAnimationElement
forall o. IsSVGAnimationElement o => o -> SVGAnimationElement
toSVGAnimationElement self
self) SVGAnimationElement
-> Getting (JSM JSVal) SVGAnimationElement (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]
"beginElementAt"
            [Maybe Float -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Float
offset]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/SVGAnimationElement.endElement Mozilla SVGAnimationElement.endElement documentation> 
endElement ::
           (MonadDOM m, IsSVGAnimationElement self) => self -> m ()
endElement :: self -> m ()
endElement self
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> SVGAnimationElement
forall o. IsSVGAnimationElement o => o -> SVGAnimationElement
toSVGAnimationElement self
self) SVGAnimationElement
-> Getting (JSM JSVal) SVGAnimationElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"endElement" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/SVGAnimationElement.endElementAt Mozilla SVGAnimationElement.endElementAt documentation> 
endElementAt ::
             (MonadDOM m, IsSVGAnimationElement self) =>
               self -> Maybe Float -> m ()
endElementAt :: self -> Maybe Float -> m ()
endElementAt self
self Maybe Float
offset
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> SVGAnimationElement
forall o. IsSVGAnimationElement o => o -> SVGAnimationElement
toSVGAnimationElement self
self) SVGAnimationElement
-> Getting (JSM JSVal) SVGAnimationElement (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]
"endElementAt"
            [Maybe Float -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Float
offset]))

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