{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.CSSFontFaceLoadEvent
       (newCSSFontFaceLoadEvent, getFontface, getFontfaceUnsafe,
        getFontfaceUnchecked, getError, getErrorUnsafe, getErrorUnchecked,
        CSSFontFaceLoadEvent(..), gTypeCSSFontFaceLoadEvent)
       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/CSSFontFaceLoadEvent Mozilla CSSFontFaceLoadEvent documentation> 
newCSSFontFaceLoadEvent ::
                        (MonadDOM m, ToJSString type') =>
                          type' -> Maybe CSSFontFaceLoadEventInit -> m CSSFontFaceLoadEvent
newCSSFontFaceLoadEvent :: forall (m :: * -> *) type'.
(MonadDOM m, ToJSString type') =>
type' -> Maybe CSSFontFaceLoadEventInit -> m CSSFontFaceLoadEvent
newCSSFontFaceLoadEvent type'
type' Maybe CSSFontFaceLoadEventInit
eventInit
  = DOM CSSFontFaceLoadEvent -> m CSSFontFaceLoadEvent
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSVal -> CSSFontFaceLoadEvent
CSSFontFaceLoadEvent (JSVal -> CSSFontFaceLoadEvent)
-> JSM JSVal -> DOM CSSFontFaceLoadEvent
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 (String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"CSSFontFaceLoadEvent")
           [type' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal type'
type', Maybe CSSFontFaceLoadEventInit -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe CSSFontFaceLoadEventInit
eventInit])

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/CSSFontFaceLoadEvent.fontface Mozilla CSSFontFaceLoadEvent.fontface documentation> 
getFontfaceUnsafe ::
                  (MonadDOM m, HasCallStack) =>
                    CSSFontFaceLoadEvent -> m CSSFontFaceRule
getFontfaceUnsafe :: forall (m :: * -> *).
(MonadDOM m, HasCallStack) =>
CSSFontFaceLoadEvent -> m CSSFontFaceRule
getFontfaceUnsafe CSSFontFaceLoadEvent
self
  = DOM CSSFontFaceRule -> m CSSFontFaceRule
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((CSSFontFaceLoadEvent
self CSSFontFaceLoadEvent
-> Getting (JSM JSVal) CSSFontFaceLoadEvent (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter CSSFontFaceLoadEvent (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"fontface") JSM JSVal
-> (JSVal -> DOM (Maybe CSSFontFaceRule))
-> DOM (Maybe CSSFontFaceRule)
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 (Maybe CSSFontFaceRule)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe CSSFontFaceRule)
-> (Maybe CSSFontFaceRule -> DOM CSSFontFaceRule)
-> DOM CSSFontFaceRule
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM CSSFontFaceRule
-> (CSSFontFaceRule -> DOM CSSFontFaceRule)
-> Maybe CSSFontFaceRule
-> DOM CSSFontFaceRule
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM CSSFontFaceRule
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") CSSFontFaceRule -> DOM CSSFontFaceRule
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

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

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/CSSFontFaceLoadEvent.error Mozilla CSSFontFaceLoadEvent.error documentation> 
getErrorUnsafe ::
               (MonadDOM m, HasCallStack) => CSSFontFaceLoadEvent -> m DOMError
getErrorUnsafe :: forall (m :: * -> *).
(MonadDOM m, HasCallStack) =>
CSSFontFaceLoadEvent -> m DOMError
getErrorUnsafe CSSFontFaceLoadEvent
self
  = DOM DOMError -> m DOMError
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((CSSFontFaceLoadEvent
self CSSFontFaceLoadEvent
-> Getting (JSM JSVal) CSSFontFaceLoadEvent (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter CSSFontFaceLoadEvent (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"error") JSM JSVal
-> (JSVal -> DOM (Maybe DOMError)) -> DOM (Maybe DOMError)
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 (Maybe DOMError)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe DOMError)
-> (Maybe DOMError -> DOM DOMError) -> DOM DOMError
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM DOMError
-> (DOMError -> DOM DOMError) -> Maybe DOMError -> DOM DOMError
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM DOMError
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") DOMError -> DOM DOMError
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

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