{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.DeviceMotionEvent
       (initDeviceMotionEvent, getAcceleration, getAccelerationUnsafe,
        getAccelerationUnchecked, getAccelerationIncludingGravity,
        getAccelerationIncludingGravityUnsafe,
        getAccelerationIncludingGravityUnchecked, getRotationRate,
        getRotationRateUnsafe, getRotationRateUnchecked, getInterval,
        getIntervalUnsafe, getIntervalUnchecked, DeviceMotionEvent(..),
        gTypeDeviceMotionEvent)
       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/DeviceMotionEvent.initDeviceMotionEvent Mozilla DeviceMotionEvent.initDeviceMotionEvent documentation> 
initDeviceMotionEvent ::
                      (MonadDOM m, ToJSString type') =>
                        DeviceMotionEvent ->
                          Maybe type' ->
                            Bool ->
                              Bool ->
                                Maybe Acceleration ->
                                  Maybe Acceleration -> Maybe RotationRate -> Maybe Double -> m ()
initDeviceMotionEvent :: DeviceMotionEvent
-> Maybe type'
-> Bool
-> Bool
-> Maybe Acceleration
-> Maybe Acceleration
-> Maybe RotationRate
-> Maybe Double
-> m ()
initDeviceMotionEvent DeviceMotionEvent
self Maybe type'
type' Bool
bubbles Bool
cancelable Maybe Acceleration
acceleration
  Maybe Acceleration
accelerationIncludingGravity Maybe RotationRate
rotationRate Maybe Double
interval
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (DeviceMotionEvent
self DeviceMotionEvent
-> Getting (JSM JSVal) DeviceMotionEvent (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]
"initDeviceMotionEvent"
            [Maybe type' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe type'
type', Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
bubbles, Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
cancelable,
             Maybe Acceleration -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Acceleration
acceleration, Maybe Acceleration -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Acceleration
accelerationIncludingGravity,
             Maybe RotationRate -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe RotationRate
rotationRate, Maybe Double -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Double
interval]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DeviceMotionEvent.acceleration Mozilla DeviceMotionEvent.acceleration documentation> 
getAcceleration ::
                (MonadDOM m) => DeviceMotionEvent -> m (Maybe Acceleration)
getAcceleration :: DeviceMotionEvent -> m (Maybe Acceleration)
getAcceleration DeviceMotionEvent
self
  = DOM (Maybe Acceleration) -> m (Maybe Acceleration)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((DeviceMotionEvent
self DeviceMotionEvent
-> Getting (JSM JSVal) DeviceMotionEvent (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter DeviceMotionEvent (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"acceleration") JSM JSVal
-> (JSVal -> DOM (Maybe Acceleration)) -> DOM (Maybe Acceleration)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Acceleration)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DeviceMotionEvent.acceleration Mozilla DeviceMotionEvent.acceleration documentation> 
getAccelerationUnsafe ::
                      (MonadDOM m, HasCallStack) => DeviceMotionEvent -> m Acceleration
getAccelerationUnsafe :: DeviceMotionEvent -> m Acceleration
getAccelerationUnsafe DeviceMotionEvent
self
  = DOM Acceleration -> m Acceleration
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((DeviceMotionEvent
self DeviceMotionEvent
-> Getting (JSM JSVal) DeviceMotionEvent (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter DeviceMotionEvent (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"acceleration") JSM JSVal
-> (JSVal -> DOM (Maybe Acceleration)) -> DOM (Maybe Acceleration)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Acceleration)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe Acceleration)
-> (Maybe Acceleration -> DOM Acceleration) -> DOM Acceleration
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM Acceleration
-> (Acceleration -> DOM Acceleration)
-> Maybe Acceleration
-> DOM Acceleration
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> DOM Acceleration
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") Acceleration -> DOM Acceleration
forall (m :: * -> *) a. Monad m => a -> m a
return)

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DeviceMotionEvent.accelerationIncludingGravity Mozilla DeviceMotionEvent.accelerationIncludingGravity documentation> 
getAccelerationIncludingGravity ::
                                (MonadDOM m) => DeviceMotionEvent -> m (Maybe Acceleration)
getAccelerationIncludingGravity :: DeviceMotionEvent -> m (Maybe Acceleration)
getAccelerationIncludingGravity DeviceMotionEvent
self
  = DOM (Maybe Acceleration) -> m (Maybe Acceleration)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((DeviceMotionEvent
self DeviceMotionEvent
-> Getting (JSM JSVal) DeviceMotionEvent (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter DeviceMotionEvent (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"accelerationIncludingGravity") JSM JSVal
-> (JSVal -> DOM (Maybe Acceleration)) -> DOM (Maybe Acceleration)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Acceleration)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DeviceMotionEvent.accelerationIncludingGravity Mozilla DeviceMotionEvent.accelerationIncludingGravity documentation> 
getAccelerationIncludingGravityUnsafe ::
                                      (MonadDOM m, HasCallStack) =>
                                        DeviceMotionEvent -> m Acceleration
getAccelerationIncludingGravityUnsafe :: DeviceMotionEvent -> m Acceleration
getAccelerationIncludingGravityUnsafe DeviceMotionEvent
self
  = DOM Acceleration -> m Acceleration
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((DeviceMotionEvent
self DeviceMotionEvent
-> Getting (JSM JSVal) DeviceMotionEvent (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter DeviceMotionEvent (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"accelerationIncludingGravity") JSM JSVal
-> (JSVal -> DOM (Maybe Acceleration)) -> DOM (Maybe Acceleration)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Acceleration)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe Acceleration)
-> (Maybe Acceleration -> DOM Acceleration) -> DOM Acceleration
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM Acceleration
-> (Acceleration -> DOM Acceleration)
-> Maybe Acceleration
-> DOM Acceleration
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> DOM Acceleration
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") Acceleration -> DOM Acceleration
forall (m :: * -> *) a. Monad m => a -> m a
return)

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DeviceMotionEvent.rotationRate Mozilla DeviceMotionEvent.rotationRate documentation> 
getRotationRate ::
                (MonadDOM m) => DeviceMotionEvent -> m (Maybe RotationRate)
getRotationRate :: DeviceMotionEvent -> m (Maybe RotationRate)
getRotationRate DeviceMotionEvent
self
  = DOM (Maybe RotationRate) -> m (Maybe RotationRate)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((DeviceMotionEvent
self DeviceMotionEvent
-> Getting (JSM JSVal) DeviceMotionEvent (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter DeviceMotionEvent (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"rotationRate") JSM JSVal
-> (JSVal -> DOM (Maybe RotationRate)) -> DOM (Maybe RotationRate)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe RotationRate)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DeviceMotionEvent.rotationRate Mozilla DeviceMotionEvent.rotationRate documentation> 
getRotationRateUnsafe ::
                      (MonadDOM m, HasCallStack) => DeviceMotionEvent -> m RotationRate
getRotationRateUnsafe :: DeviceMotionEvent -> m RotationRate
getRotationRateUnsafe DeviceMotionEvent
self
  = DOM RotationRate -> m RotationRate
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((DeviceMotionEvent
self DeviceMotionEvent
-> Getting (JSM JSVal) DeviceMotionEvent (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter DeviceMotionEvent (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"rotationRate") JSM JSVal
-> (JSVal -> DOM (Maybe RotationRate)) -> DOM (Maybe RotationRate)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe RotationRate)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe RotationRate)
-> (Maybe RotationRate -> DOM RotationRate) -> DOM RotationRate
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM RotationRate
-> (RotationRate -> DOM RotationRate)
-> Maybe RotationRate
-> DOM RotationRate
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> DOM RotationRate
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") RotationRate -> DOM RotationRate
forall (m :: * -> *) a. Monad m => a -> m a
return)

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DeviceMotionEvent.interval Mozilla DeviceMotionEvent.interval documentation> 
getInterval ::
            (MonadDOM m) => DeviceMotionEvent -> m (Maybe Double)
getInterval :: DeviceMotionEvent -> m (Maybe Double)
getInterval DeviceMotionEvent
self = DOM (Maybe Double) -> m (Maybe Double)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((DeviceMotionEvent
self DeviceMotionEvent
-> Getting (JSM JSVal) DeviceMotionEvent (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter DeviceMotionEvent (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"interval") JSM JSVal -> (JSVal -> DOM (Maybe Double)) -> DOM (Maybe Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Double)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/DeviceMotionEvent.interval Mozilla DeviceMotionEvent.interval documentation> 
getIntervalUnsafe ::
                  (MonadDOM m, HasCallStack) => DeviceMotionEvent -> m Double
getIntervalUnsafe :: DeviceMotionEvent -> m Double
getIntervalUnsafe DeviceMotionEvent
self
  = DOM Double -> m Double
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((DeviceMotionEvent
self DeviceMotionEvent
-> Getting (JSM JSVal) DeviceMotionEvent (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter DeviceMotionEvent (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"interval") JSM JSVal -> (JSVal -> DOM (Maybe Double)) -> DOM (Maybe Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Double)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe Double) -> (Maybe Double -> DOM Double) -> DOM Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM Double -> (Double -> DOM Double) -> Maybe Double -> DOM Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> DOM Double
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") Double -> DOM Double
forall (m :: * -> *) a. Monad m => a -> m a
return)

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