{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.PromiseRejectionEvent
       (newPromiseRejectionEvent, getPromise, getReason,
        PromiseRejectionEvent(..), gTypePromiseRejectionEvent)
       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/PromiseRejectionEvent Mozilla PromiseRejectionEvent documentation> 
newPromiseRejectionEvent ::
                         (MonadDOM m, ToJSString type') =>
                           type' -> PromiseRejectionEventInit -> m PromiseRejectionEvent
newPromiseRejectionEvent :: type' -> PromiseRejectionEventInit -> m PromiseRejectionEvent
newPromiseRejectionEvent type'
type' PromiseRejectionEventInit
eventInitDict
  = DOM PromiseRejectionEvent -> m PromiseRejectionEvent
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSVal -> PromiseRejectionEvent
PromiseRejectionEvent (JSVal -> PromiseRejectionEvent)
-> JSM JSVal -> DOM PromiseRejectionEvent
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]
"PromiseRejectionEvent")
           [type' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal type'
type', PromiseRejectionEventInit -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal PromiseRejectionEventInit
eventInitDict])

-- | <https://developer.mozilla.org/en-US/docs/Web/API/PromiseRejectionEvent.promise Mozilla PromiseRejectionEvent.promise documentation> 
getPromise :: (MonadDOM m) => PromiseRejectionEvent -> m JSVal
getPromise :: PromiseRejectionEvent -> m JSVal
getPromise PromiseRejectionEvent
self
  = JSM JSVal -> m JSVal
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((PromiseRejectionEvent
self PromiseRejectionEvent
-> Getting (JSM JSVal) PromiseRejectionEvent (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter PromiseRejectionEvent (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"promise") JSM JSVal -> (JSVal -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM JSVal
readPromise) JSM JSVal -> (JSVal -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal)

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