{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.GamepadButton
       (getPressed, getValue, GamepadButton(..), gTypeGamepadButton) 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/GamepadButton.pressed Mozilla GamepadButton.pressed documentation> 
getPressed :: (MonadDOM m) => GamepadButton -> m Bool
getPressed :: forall (m :: * -> *). MonadDOM m => GamepadButton -> m Bool
getPressed GamepadButton
self = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((GamepadButton
self GamepadButton
-> Getting (JSM JSVal) GamepadButton (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter GamepadButton (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"pressed") JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
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 Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/GamepadButton.value Mozilla GamepadButton.value documentation> 
getValue :: (MonadDOM m) => GamepadButton -> m Double
getValue :: forall (m :: * -> *). MonadDOM m => GamepadButton -> m Double
getValue GamepadButton
self = DOM Double -> m Double
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((GamepadButton
self GamepadButton
-> Getting (JSM JSVal) GamepadButton (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter GamepadButton (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"value") JSM JSVal -> (JSVal -> DOM Double) -> DOM Double
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 Double
forall value. ToJSVal value => value -> DOM Double
valToNumber)