{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.SVGTextPositioningElement
       (getX, getY, getDx, getDy, getRotate,
        SVGTextPositioningElement(..), gTypeSVGTextPositioningElement,
        IsSVGTextPositioningElement, toSVGTextPositioningElement)
       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/SVGTextPositioningElement.x Mozilla SVGTextPositioningElement.x documentation> 
getX ::
     (MonadDOM m, IsSVGTextPositioningElement self) =>
       self -> m SVGAnimatedLengthList
getX :: self -> m SVGAnimatedLengthList
getX self
self
  = DOM SVGAnimatedLengthList -> m SVGAnimatedLengthList
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> SVGTextPositioningElement
forall o.
IsSVGTextPositioningElement o =>
o -> SVGTextPositioningElement
toSVGTextPositioningElement self
self) SVGTextPositioningElement
-> Getting (JSM JSVal) SVGTextPositioningElement (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char]
-> IndexPreservingGetter SVGTextPositioningElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"x") JSM JSVal
-> (JSVal -> DOM SVGAnimatedLengthList)
-> DOM SVGAnimatedLengthList
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM SVGAnimatedLengthList
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

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

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

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

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