{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.SVGFEMorphologyElement
       (setRadius, pattern SVG_MORPHOLOGY_OPERATOR_UNKNOWN,
        pattern SVG_MORPHOLOGY_OPERATOR_ERODE,
        pattern SVG_MORPHOLOGY_OPERATOR_DILATE, getIn1, getOperator,
        getRadiusX, getRadiusY, SVGFEMorphologyElement(..),
        gTypeSVGFEMorphologyElement)
       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/SVGFEMorphologyElement.setRadius Mozilla SVGFEMorphologyElement.setRadius documentation> 
setRadius ::
          (MonadDOM m) =>
            SVGFEMorphologyElement -> Maybe Float -> Maybe Float -> m ()
setRadius :: forall (m :: * -> *).
MonadDOM m =>
SVGFEMorphologyElement -> Maybe Float -> Maybe Float -> m ()
setRadius SVGFEMorphologyElement
self Maybe Float
radiusX Maybe Float
radiusY
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SVGFEMorphologyElement
self SVGFEMorphologyElement
-> Getting (JSM JSVal) SVGFEMorphologyElement (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
"setRadius" [Maybe Float -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Float
radiusX, Maybe Float -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Float
radiusY]))
pattern $mSVG_MORPHOLOGY_OPERATOR_UNKNOWN :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bSVG_MORPHOLOGY_OPERATOR_UNKNOWN :: forall {a}. (Eq a, Num a) => a
SVG_MORPHOLOGY_OPERATOR_UNKNOWN = 0
pattern $mSVG_MORPHOLOGY_OPERATOR_ERODE :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bSVG_MORPHOLOGY_OPERATOR_ERODE :: forall {a}. (Eq a, Num a) => a
SVG_MORPHOLOGY_OPERATOR_ERODE = 1
pattern $mSVG_MORPHOLOGY_OPERATOR_DILATE :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bSVG_MORPHOLOGY_OPERATOR_DILATE :: forall {a}. (Eq a, Num a) => a
SVG_MORPHOLOGY_OPERATOR_DILATE = 2

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

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

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

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