{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.DOMPointReadOnly
       (newDOMPointReadOnly, newDOMPointReadOnly', fromPoint, fromPoint_,
        getX, getY, getZ, getW, DOMPointReadOnly(..),
        gTypeDOMPointReadOnly, IsDOMPointReadOnly, toDOMPointReadOnly)
       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/DOMPointReadOnly Mozilla DOMPointReadOnly documentation> 
newDOMPointReadOnly ::
                    (MonadDOM m) => DOMPointInit -> m DOMPointReadOnly
newDOMPointReadOnly :: DOMPointInit -> m DOMPointReadOnly
newDOMPointReadOnly DOMPointInit
point
  = DOM DOMPointReadOnly -> m DOMPointReadOnly
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSVal -> DOMPointReadOnly
DOMPointReadOnly (JSVal -> DOMPointReadOnly) -> JSM JSVal -> DOM DOMPointReadOnly
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM JSVal -> [JSM JSVal] -> JSM JSVal
forall constructor args.
(MakeObject constructor, MakeArgs args) =>
constructor -> args -> JSM JSVal
new ([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"DOMPointReadOnly") [DOMPointInit -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal DOMPointInit
point])

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DOMPointReadOnly Mozilla DOMPointReadOnly documentation> 
newDOMPointReadOnly' ::
                     (MonadDOM m) =>
                       Maybe Double ->
                         Maybe Double -> Maybe Double -> Maybe Double -> m DOMPointReadOnly
newDOMPointReadOnly' :: Maybe Double
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> m DOMPointReadOnly
newDOMPointReadOnly' Maybe Double
x Maybe Double
y Maybe Double
z Maybe Double
w
  = DOM DOMPointReadOnly -> m DOMPointReadOnly
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSVal -> DOMPointReadOnly
DOMPointReadOnly (JSVal -> DOMPointReadOnly) -> JSM JSVal -> DOM DOMPointReadOnly
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         JSM JSVal -> [JSM JSVal] -> JSM JSVal
forall constructor args.
(MakeObject constructor, MakeArgs args) =>
constructor -> args -> JSM JSVal
new ([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"DOMPointReadOnly")
           [Maybe Double -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Double
x, Maybe Double -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Double
y, Maybe Double -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Double
z, Maybe Double -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Double
w])

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DOMPointReadOnly.fromPoint Mozilla DOMPointReadOnly.fromPoint documentation> 
fromPoint ::
          (MonadDOM m) => Maybe DOMPointInit -> m DOMPointReadOnly
fromPoint :: Maybe DOMPointInit -> m DOMPointReadOnly
fromPoint Maybe DOMPointInit
other
  = DOM DOMPointReadOnly -> m DOMPointReadOnly
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"DOMPointReadOnly") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (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]
"fromPoint" [Maybe DOMPointInit -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe DOMPointInit
other]) JSM JSVal
-> (JSVal -> DOM DOMPointReadOnly) -> DOM DOMPointReadOnly
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM DOMPointReadOnly
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DOMPointReadOnly.fromPoint Mozilla DOMPointReadOnly.fromPoint documentation> 
fromPoint_ :: (MonadDOM m) => Maybe DOMPointInit -> m ()
fromPoint_ :: Maybe DOMPointInit -> m ()
fromPoint_ Maybe DOMPointInit
other
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"DOMPointReadOnly") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (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]
"fromPoint" [Maybe DOMPointInit -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe DOMPointInit
other]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DOMPointReadOnly.x Mozilla DOMPointReadOnly.x documentation> 
getX :: (MonadDOM m, IsDOMPointReadOnly self) => self -> m Double
getX :: self -> m Double
getX self
self
  = DOM Double -> m Double
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> DOMPointReadOnly
forall o. IsDOMPointReadOnly o => o -> DOMPointReadOnly
toDOMPointReadOnly self
self) DOMPointReadOnly
-> Getting (JSM JSVal) DOMPointReadOnly (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter DOMPointReadOnly (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"x") JSM JSVal -> (JSVal -> DOM Double) -> DOM Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Double
forall value. ToJSVal value => value -> DOM Double
valToNumber)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DOMPointReadOnly.y Mozilla DOMPointReadOnly.y documentation> 
getY :: (MonadDOM m, IsDOMPointReadOnly self) => self -> m Double
getY :: self -> m Double
getY self
self
  = DOM Double -> m Double
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> DOMPointReadOnly
forall o. IsDOMPointReadOnly o => o -> DOMPointReadOnly
toDOMPointReadOnly self
self) DOMPointReadOnly
-> Getting (JSM JSVal) DOMPointReadOnly (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter DOMPointReadOnly (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"y") JSM JSVal -> (JSVal -> DOM Double) -> DOM Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Double
forall value. ToJSVal value => value -> DOM Double
valToNumber)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DOMPointReadOnly.z Mozilla DOMPointReadOnly.z documentation> 
getZ :: (MonadDOM m, IsDOMPointReadOnly self) => self -> m Double
getZ :: self -> m Double
getZ self
self
  = DOM Double -> m Double
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> DOMPointReadOnly
forall o. IsDOMPointReadOnly o => o -> DOMPointReadOnly
toDOMPointReadOnly self
self) DOMPointReadOnly
-> Getting (JSM JSVal) DOMPointReadOnly (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter DOMPointReadOnly (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"z") JSM JSVal -> (JSVal -> DOM Double) -> DOM Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Double
forall value. ToJSVal value => value -> DOM Double
valToNumber)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DOMPointReadOnly.w Mozilla DOMPointReadOnly.w documentation> 
getW :: (MonadDOM m, IsDOMPointReadOnly self) => self -> m Double
getW :: self -> m Double
getW self
self
  = DOM Double -> m Double
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> DOMPointReadOnly
forall o. IsDOMPointReadOnly o => o -> DOMPointReadOnly
toDOMPointReadOnly self
self) DOMPointReadOnly
-> Getting (JSM JSVal) DOMPointReadOnly (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter DOMPointReadOnly (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"w") JSM JSVal -> (JSVal -> DOM Double) -> DOM Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Double
forall value. ToJSVal value => value -> DOM Double
valToNumber)