{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.WebGPULibrary
       (functionWithName, functionWithName_, functionWithNameUnsafe,
        functionWithNameUnchecked, getSourceCode, setLabel, getLabel,
        getFunctionNames, WebGPULibrary(..), gTypeWebGPULibrary)
       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/WebGPULibrary.functionWithName Mozilla WebGPULibrary.functionWithName documentation> 
functionWithName ::
                 (MonadDOM m, ToJSString name) =>
                   WebGPULibrary -> name -> m (Maybe WebGPUFunction)
functionWithName :: WebGPULibrary -> name -> m (Maybe WebGPUFunction)
functionWithName WebGPULibrary
self name
name
  = DOM (Maybe WebGPUFunction) -> m (Maybe WebGPUFunction)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPULibrary
self WebGPULibrary
-> Getting (JSM JSVal) WebGPULibrary (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]
"functionWithName" [name -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal name
name]) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUFunction))
-> DOM (Maybe WebGPUFunction)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe WebGPUFunction)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPULibrary.functionWithName Mozilla WebGPULibrary.functionWithName documentation> 
functionWithName_ ::
                  (MonadDOM m, ToJSString name) => WebGPULibrary -> name -> m ()
functionWithName_ :: WebGPULibrary -> name -> m ()
functionWithName_ WebGPULibrary
self name
name
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (WebGPULibrary
self WebGPULibrary
-> Getting (JSM JSVal) WebGPULibrary (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]
"functionWithName" [name -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal name
name]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPULibrary.functionWithName Mozilla WebGPULibrary.functionWithName documentation> 
functionWithNameUnsafe ::
                       (MonadDOM m, ToJSString name, HasCallStack) =>
                         WebGPULibrary -> name -> m WebGPUFunction
functionWithNameUnsafe :: WebGPULibrary -> name -> m WebGPUFunction
functionWithNameUnsafe WebGPULibrary
self name
name
  = DOM WebGPUFunction -> m WebGPUFunction
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((WebGPULibrary
self WebGPULibrary
-> Getting (JSM JSVal) WebGPULibrary (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]
"functionWithName" [name -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal name
name]) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUFunction))
-> DOM (Maybe WebGPUFunction)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe WebGPUFunction)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)
         DOM (Maybe WebGPUFunction)
-> (Maybe WebGPUFunction -> DOM WebGPUFunction)
-> DOM WebGPUFunction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DOM WebGPUFunction
-> (WebGPUFunction -> DOM WebGPUFunction)
-> Maybe WebGPUFunction
-> DOM WebGPUFunction
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> DOM WebGPUFunction
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") WebGPUFunction -> DOM WebGPUFunction
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPULibrary.functionWithName Mozilla WebGPULibrary.functionWithName documentation> 
functionWithNameUnchecked ::
                          (MonadDOM m, ToJSString name) =>
                            WebGPULibrary -> name -> m WebGPUFunction
functionWithNameUnchecked :: WebGPULibrary -> name -> m WebGPUFunction
functionWithNameUnchecked WebGPULibrary
self name
name
  = DOM WebGPUFunction -> m WebGPUFunction
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPULibrary
self WebGPULibrary
-> Getting (JSM JSVal) WebGPULibrary (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]
"functionWithName" [name -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal name
name]) JSM JSVal -> (JSVal -> DOM WebGPUFunction) -> DOM WebGPUFunction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM WebGPUFunction
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPULibrary.label Mozilla WebGPULibrary.label documentation> 
setLabel ::
         (MonadDOM m, ToJSString val) => WebGPULibrary -> val -> m ()
setLabel :: WebGPULibrary -> val -> m ()
setLabel WebGPULibrary
self val
val = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (WebGPULibrary
self WebGPULibrary -> Getting (DOM ()) WebGPULibrary (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. [Char]
-> JSM JSVal
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
forall name val.
(ToJSString name, ToJSVal val) =>
name
-> val
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
jss [Char]
"label" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPULibrary.functionNames Mozilla WebGPULibrary.functionNames documentation> 
getFunctionNames ::
                 (MonadDOM m, FromJSString result) => WebGPULibrary -> m [result]
getFunctionNames :: WebGPULibrary -> m [result]
getFunctionNames WebGPULibrary
self
  = DOM [result] -> m [result]
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((WebGPULibrary
self WebGPULibrary
-> Getting (JSM JSVal) WebGPULibrary (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter WebGPULibrary (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"functionNames") JSM JSVal -> (JSVal -> DOM [result]) -> DOM [result]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM [result]
forall o. FromJSVal o => JSVal -> JSM [o]
fromJSArrayUnchecked)