{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.SVGFitToViewBox
       (getViewBox, getPreserveAspectRatio, SVGFitToViewBox(..),
        gTypeSVGFitToViewBox, IsSVGFitToViewBox, toSVGFitToViewBox)
       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/SVGFitToViewBox.viewBox Mozilla SVGFitToViewBox.viewBox documentation> 
getViewBox ::
           (MonadDOM m, IsSVGFitToViewBox self) => self -> m SVGAnimatedRect
getViewBox :: forall (m :: * -> *) self.
(MonadDOM m, IsSVGFitToViewBox self) =>
self -> m SVGAnimatedRect
getViewBox self
self
  = DOM SVGAnimatedRect -> m SVGAnimatedRect
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> SVGFitToViewBox
forall o. IsSVGFitToViewBox o => o -> SVGFitToViewBox
toSVGFitToViewBox self
self) SVGFitToViewBox
-> Getting (JSM JSVal) SVGFitToViewBox (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter SVGFitToViewBox (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"viewBox") JSM JSVal -> (JSVal -> DOM SVGAnimatedRect) -> DOM SVGAnimatedRect
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 SVGAnimatedRect
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/SVGFitToViewBox.preserveAspectRatio Mozilla SVGFitToViewBox.preserveAspectRatio documentation> 
getPreserveAspectRatio ::
                       (MonadDOM m, IsSVGFitToViewBox self) =>
                         self -> m SVGAnimatedPreserveAspectRatio
getPreserveAspectRatio :: forall (m :: * -> *) self.
(MonadDOM m, IsSVGFitToViewBox self) =>
self -> m SVGAnimatedPreserveAspectRatio
getPreserveAspectRatio self
self
  = DOM SVGAnimatedPreserveAspectRatio
-> m SVGAnimatedPreserveAspectRatio
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> SVGFitToViewBox
forall o. IsSVGFitToViewBox o => o -> SVGFitToViewBox
toSVGFitToViewBox self
self) SVGFitToViewBox
-> Getting (JSM JSVal) SVGFitToViewBox (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter SVGFitToViewBox (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"preserveAspectRatio") JSM JSVal
-> (JSVal -> DOM SVGAnimatedPreserveAspectRatio)
-> DOM SVGAnimatedPreserveAspectRatio
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 SVGAnimatedPreserveAspectRatio
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)