{-# 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 :: forall (m :: * -> *) self.
(MonadDOM m, IsSVGAnimationElement self) =>
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
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getStartTime" ()) 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))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/SVGAnimationElement.getStartTime Mozilla SVGAnimationElement.getStartTime documentation> 
getStartTime_ ::
              (MonadDOM m, IsSVGAnimationElement self) => self -> m ()
getStartTime_ :: forall (m :: * -> *) self.
(MonadDOM m, IsSVGAnimationElement self) =>
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
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"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 :: forall (m :: * -> *) self.
(MonadDOM m, IsSVGAnimationElement self) =>
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
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getCurrentTime" ()) 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))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/SVGAnimationElement.getCurrentTime Mozilla SVGAnimationElement.getCurrentTime documentation> 
getCurrentTime_ ::
                (MonadDOM m, IsSVGAnimationElement self) => self -> m ()
getCurrentTime_ :: forall (m :: * -> *) self.
(MonadDOM m, IsSVGAnimationElement self) =>
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
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"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 :: forall (m :: * -> *) self.
(MonadDOM m, IsSVGAnimationElement self) =>
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
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getSimpleDuration" ()) 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))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/SVGAnimationElement.getSimpleDuration Mozilla SVGAnimationElement.getSimpleDuration documentation> 
getSimpleDuration_ ::
                   (MonadDOM m, IsSVGAnimationElement self) => self -> m ()
getSimpleDuration_ :: forall (m :: * -> *) self.
(MonadDOM m, IsSVGAnimationElement self) =>
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
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getSimpleDuration" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/SVGAnimationElement.beginElement Mozilla SVGAnimationElement.beginElement documentation> 
beginElement ::
             (MonadDOM m, IsSVGAnimationElement self) => self -> m ()
beginElement :: forall (m :: * -> *) self.
(MonadDOM m, IsSVGAnimationElement self) =>
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
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"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 :: forall (m :: * -> *) self.
(MonadDOM m, IsSVGAnimationElement self) =>
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
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"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 :: forall (m :: * -> *) self.
(MonadDOM m, IsSVGAnimationElement self) =>
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
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"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 :: forall (m :: * -> *) self.
(MonadDOM m, IsSVGAnimationElement self) =>
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
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"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 :: forall (m :: * -> *) self.
(MonadDOM m, IsSVGAnimationElement self) =>
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
^. String -> IndexPreservingGetter SVGAnimationElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"targetElement") JSM JSVal -> (JSVal -> DOM SVGElement) -> DOM SVGElement
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 SVGElement
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)