{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.WebGPURenderingContext
       (createLibrary, createLibrary_, createRenderPipelineState,
        createRenderPipelineState_, createRenderPipelineStateUnsafe,
        createRenderPipelineStateUnchecked, createDepthStencilState,
        createDepthStencilState_, createDepthStencilStateUnsafe,
        createDepthStencilStateUnchecked, createComputePipelineState,
        createComputePipelineState_, createComputePipelineStateUnsafe,
        createComputePipelineStateUnchecked, createCommandQueue,
        createCommandQueue_, createCommandQueueUnsafe,
        createCommandQueueUnchecked, nextDrawable, nextDrawable_,
        nextDrawableUnsafe, nextDrawableUnchecked, createBuffer,
        createBuffer_, createBufferUnsafe, createBufferUnchecked,
        createTexture, createTexture_, createTextureUnsafe,
        createTextureUnchecked, pattern PixelFormatBGRA8Unorm,
        pattern PixelFormatDepth32Float, pattern PixelFormatStencil8,
        pattern PixelFormatInvalid, pattern LoadActionDontCare,
        pattern LoadActionLoad, pattern LoadActionClear,
        pattern StoreActionDontCare, pattern StoreActionStore,
        pattern StoreActionMultisampleResolve, pattern PrimitiveTypePoint,
        pattern PrimitiveTypeLine, pattern PrimitiveTypeLineStrip,
        pattern PrimitiveTypeTriangle, pattern PrimitiveTypeTriangleStrip,
        pattern CompareFunctionNever, pattern CompareFunctionLess,
        pattern CompareFunctionEqual, pattern CompareFunctionLessEqual,
        pattern CompareFunctionGreater, pattern CompareFunctionNotEqual,
        pattern CompareFunctionGreaterEqual, pattern CompareFunctionAlways,
        pattern TextureType1D, pattern TextureType1DArray,
        pattern TextureType2D, pattern TextureType2DArray,
        pattern TextureType2DMultisample, pattern TextureTypeCube,
        pattern TextureTypeCubeArray, pattern TextureType3D,
        pattern StorageModeShared, pattern StorageModeManaged,
        pattern StorageModePrivate, pattern TextureUsageUnknown,
        pattern TextureUsageShaderRead, pattern TextureUsageShaderWrite,
        pattern TextureUsageRenderTarget,
        pattern TextureUsagePixelFormatView, WebGPURenderingContext(..),
        gTypeWebGPURenderingContext)
       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/WebGPURenderingContext.createLibrary Mozilla WebGPURenderingContext.createLibrary documentation> 
createLibrary ::
              (MonadDOM m, ToJSString sourceCode) =>
                WebGPURenderingContext -> sourceCode -> m WebGPULibrary
createLibrary :: forall (m :: * -> *) sourceCode.
(MonadDOM m, ToJSString sourceCode) =>
WebGPURenderingContext -> sourceCode -> m WebGPULibrary
createLibrary WebGPURenderingContext
self sourceCode
sourceCode
  = DOM WebGPULibrary -> m WebGPULibrary
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createLibrary" [sourceCode -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal sourceCode
sourceCode]) JSM JSVal -> (JSVal -> DOM WebGPULibrary) -> DOM WebGPULibrary
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 WebGPULibrary
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createLibrary Mozilla WebGPURenderingContext.createLibrary documentation> 
createLibrary_ ::
               (MonadDOM m, ToJSString sourceCode) =>
                 WebGPURenderingContext -> sourceCode -> m ()
createLibrary_ :: forall (m :: * -> *) sourceCode.
(MonadDOM m, ToJSString sourceCode) =>
WebGPURenderingContext -> sourceCode -> m ()
createLibrary_ WebGPURenderingContext
self sourceCode
sourceCode
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createLibrary" [sourceCode -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal sourceCode
sourceCode]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createRenderPipelineState Mozilla WebGPURenderingContext.createRenderPipelineState documentation> 
createRenderPipelineState ::
                          (MonadDOM m) =>
                            WebGPURenderingContext ->
                              WebGPURenderPipelineDescriptor ->
                                m (Maybe WebGPURenderPipelineState)
createRenderPipelineState :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext
-> WebGPURenderPipelineDescriptor
-> m (Maybe WebGPURenderPipelineState)
createRenderPipelineState WebGPURenderingContext
self WebGPURenderPipelineDescriptor
descriptor
  = DOM (Maybe WebGPURenderPipelineState)
-> m (Maybe WebGPURenderPipelineState)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createRenderPipelineState" [WebGPURenderPipelineDescriptor -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPURenderPipelineDescriptor
descriptor]) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPURenderPipelineState))
-> DOM (Maybe WebGPURenderPipelineState)
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 WebGPURenderPipelineState)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createRenderPipelineState Mozilla WebGPURenderingContext.createRenderPipelineState documentation> 
createRenderPipelineState_ ::
                           (MonadDOM m) =>
                             WebGPURenderingContext -> WebGPURenderPipelineDescriptor -> m ()
createRenderPipelineState_ :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext -> WebGPURenderPipelineDescriptor -> m ()
createRenderPipelineState_ WebGPURenderingContext
self WebGPURenderPipelineDescriptor
descriptor
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createRenderPipelineState" [WebGPURenderPipelineDescriptor -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPURenderPipelineDescriptor
descriptor]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createRenderPipelineState Mozilla WebGPURenderingContext.createRenderPipelineState documentation> 
createRenderPipelineStateUnsafe ::
                                (MonadDOM m, HasCallStack) =>
                                  WebGPURenderingContext ->
                                    WebGPURenderPipelineDescriptor -> m WebGPURenderPipelineState
createRenderPipelineStateUnsafe :: forall (m :: * -> *).
(MonadDOM m, HasCallStack) =>
WebGPURenderingContext
-> WebGPURenderPipelineDescriptor -> m WebGPURenderPipelineState
createRenderPipelineStateUnsafe WebGPURenderingContext
self WebGPURenderPipelineDescriptor
descriptor
  = DOM WebGPURenderPipelineState -> m WebGPURenderPipelineState
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createRenderPipelineState" [WebGPURenderPipelineDescriptor -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPURenderPipelineDescriptor
descriptor])
          JSM JSVal
-> (JSVal -> DOM (Maybe WebGPURenderPipelineState))
-> DOM (Maybe WebGPURenderPipelineState)
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 WebGPURenderPipelineState)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)
         DOM (Maybe WebGPURenderPipelineState)
-> (Maybe WebGPURenderPipelineState
    -> DOM WebGPURenderPipelineState)
-> DOM WebGPURenderPipelineState
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DOM WebGPURenderPipelineState
-> (WebGPURenderPipelineState -> DOM WebGPURenderPipelineState)
-> Maybe WebGPURenderPipelineState
-> DOM WebGPURenderPipelineState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM WebGPURenderPipelineState
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") WebGPURenderPipelineState -> DOM WebGPURenderPipelineState
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createRenderPipelineState Mozilla WebGPURenderingContext.createRenderPipelineState documentation> 
createRenderPipelineStateUnchecked ::
                                   (MonadDOM m) =>
                                     WebGPURenderingContext ->
                                       WebGPURenderPipelineDescriptor -> m WebGPURenderPipelineState
createRenderPipelineStateUnchecked :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext
-> WebGPURenderPipelineDescriptor -> m WebGPURenderPipelineState
createRenderPipelineStateUnchecked WebGPURenderingContext
self WebGPURenderPipelineDescriptor
descriptor
  = DOM WebGPURenderPipelineState -> m WebGPURenderPipelineState
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createRenderPipelineState" [WebGPURenderPipelineDescriptor -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPURenderPipelineDescriptor
descriptor]) JSM JSVal
-> (JSVal -> DOM WebGPURenderPipelineState)
-> DOM WebGPURenderPipelineState
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 WebGPURenderPipelineState
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createDepthStencilState Mozilla WebGPURenderingContext.createDepthStencilState documentation> 
createDepthStencilState ::
                        (MonadDOM m) =>
                          WebGPURenderingContext ->
                            WebGPUDepthStencilDescriptor -> m (Maybe WebGPUDepthStencilState)
createDepthStencilState :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext
-> WebGPUDepthStencilDescriptor
-> m (Maybe WebGPUDepthStencilState)
createDepthStencilState WebGPURenderingContext
self WebGPUDepthStencilDescriptor
descriptor
  = DOM (Maybe WebGPUDepthStencilState)
-> m (Maybe WebGPUDepthStencilState)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createDepthStencilState" [WebGPUDepthStencilDescriptor -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUDepthStencilDescriptor
descriptor]) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUDepthStencilState))
-> DOM (Maybe WebGPUDepthStencilState)
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 WebGPUDepthStencilState)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createDepthStencilState Mozilla WebGPURenderingContext.createDepthStencilState documentation> 
createDepthStencilState_ ::
                         (MonadDOM m) =>
                           WebGPURenderingContext -> WebGPUDepthStencilDescriptor -> m ()
createDepthStencilState_ :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext -> WebGPUDepthStencilDescriptor -> m ()
createDepthStencilState_ WebGPURenderingContext
self WebGPUDepthStencilDescriptor
descriptor
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createDepthStencilState" [WebGPUDepthStencilDescriptor -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUDepthStencilDescriptor
descriptor]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createDepthStencilState Mozilla WebGPURenderingContext.createDepthStencilState documentation> 
createDepthStencilStateUnsafe ::
                              (MonadDOM m, HasCallStack) =>
                                WebGPURenderingContext ->
                                  WebGPUDepthStencilDescriptor -> m WebGPUDepthStencilState
createDepthStencilStateUnsafe :: forall (m :: * -> *).
(MonadDOM m, HasCallStack) =>
WebGPURenderingContext
-> WebGPUDepthStencilDescriptor -> m WebGPUDepthStencilState
createDepthStencilStateUnsafe WebGPURenderingContext
self WebGPUDepthStencilDescriptor
descriptor
  = DOM WebGPUDepthStencilState -> m WebGPUDepthStencilState
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createDepthStencilState" [WebGPUDepthStencilDescriptor -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUDepthStencilDescriptor
descriptor]) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUDepthStencilState))
-> DOM (Maybe WebGPUDepthStencilState)
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 WebGPUDepthStencilState)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)
         DOM (Maybe WebGPUDepthStencilState)
-> (Maybe WebGPUDepthStencilState -> DOM WebGPUDepthStencilState)
-> DOM WebGPUDepthStencilState
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DOM WebGPUDepthStencilState
-> (WebGPUDepthStencilState -> DOM WebGPUDepthStencilState)
-> Maybe WebGPUDepthStencilState
-> DOM WebGPUDepthStencilState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM WebGPUDepthStencilState
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") WebGPUDepthStencilState -> DOM WebGPUDepthStencilState
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createDepthStencilState Mozilla WebGPURenderingContext.createDepthStencilState documentation> 
createDepthStencilStateUnchecked ::
                                 (MonadDOM m) =>
                                   WebGPURenderingContext ->
                                     WebGPUDepthStencilDescriptor -> m WebGPUDepthStencilState
createDepthStencilStateUnchecked :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext
-> WebGPUDepthStencilDescriptor -> m WebGPUDepthStencilState
createDepthStencilStateUnchecked WebGPURenderingContext
self WebGPUDepthStencilDescriptor
descriptor
  = DOM WebGPUDepthStencilState -> m WebGPUDepthStencilState
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createDepthStencilState" [WebGPUDepthStencilDescriptor -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUDepthStencilDescriptor
descriptor]) JSM JSVal
-> (JSVal -> DOM WebGPUDepthStencilState)
-> DOM WebGPUDepthStencilState
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 WebGPUDepthStencilState
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createComputePipelineState Mozilla WebGPURenderingContext.createComputePipelineState documentation> 
createComputePipelineState ::
                           (MonadDOM m) =>
                             WebGPURenderingContext ->
                               WebGPUFunction -> m (Maybe WebGPUComputePipelineState)
createComputePipelineState :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext
-> WebGPUFunction -> m (Maybe WebGPUComputePipelineState)
createComputePipelineState WebGPURenderingContext
self WebGPUFunction
function
  = DOM (Maybe WebGPUComputePipelineState)
-> m (Maybe WebGPUComputePipelineState)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createComputePipelineState" [WebGPUFunction -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUFunction
function]) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUComputePipelineState))
-> DOM (Maybe WebGPUComputePipelineState)
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 WebGPUComputePipelineState)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createComputePipelineState Mozilla WebGPURenderingContext.createComputePipelineState documentation> 
createComputePipelineState_ ::
                            (MonadDOM m) => WebGPURenderingContext -> WebGPUFunction -> m ()
createComputePipelineState_ :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext -> WebGPUFunction -> m ()
createComputePipelineState_ WebGPURenderingContext
self WebGPUFunction
function
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createComputePipelineState" [WebGPUFunction -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUFunction
function]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createComputePipelineState Mozilla WebGPURenderingContext.createComputePipelineState documentation> 
createComputePipelineStateUnsafe ::
                                 (MonadDOM m, HasCallStack) =>
                                   WebGPURenderingContext ->
                                     WebGPUFunction -> m WebGPUComputePipelineState
createComputePipelineStateUnsafe :: forall (m :: * -> *).
(MonadDOM m, HasCallStack) =>
WebGPURenderingContext
-> WebGPUFunction -> m WebGPUComputePipelineState
createComputePipelineStateUnsafe WebGPURenderingContext
self WebGPUFunction
function
  = DOM WebGPUComputePipelineState -> m WebGPUComputePipelineState
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createComputePipelineState" [WebGPUFunction -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUFunction
function]) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUComputePipelineState))
-> DOM (Maybe WebGPUComputePipelineState)
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 WebGPUComputePipelineState)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)
         DOM (Maybe WebGPUComputePipelineState)
-> (Maybe WebGPUComputePipelineState
    -> DOM WebGPUComputePipelineState)
-> DOM WebGPUComputePipelineState
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DOM WebGPUComputePipelineState
-> (WebGPUComputePipelineState -> DOM WebGPUComputePipelineState)
-> Maybe WebGPUComputePipelineState
-> DOM WebGPUComputePipelineState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM WebGPUComputePipelineState
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") WebGPUComputePipelineState -> DOM WebGPUComputePipelineState
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createComputePipelineState Mozilla WebGPURenderingContext.createComputePipelineState documentation> 
createComputePipelineStateUnchecked ::
                                    (MonadDOM m) =>
                                      WebGPURenderingContext ->
                                        WebGPUFunction -> m WebGPUComputePipelineState
createComputePipelineStateUnchecked :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext
-> WebGPUFunction -> m WebGPUComputePipelineState
createComputePipelineStateUnchecked WebGPURenderingContext
self WebGPUFunction
function
  = DOM WebGPUComputePipelineState -> m WebGPUComputePipelineState
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createComputePipelineState" [WebGPUFunction -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUFunction
function]) JSM JSVal
-> (JSVal -> DOM WebGPUComputePipelineState)
-> DOM WebGPUComputePipelineState
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 WebGPUComputePipelineState
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createCommandQueue Mozilla WebGPURenderingContext.createCommandQueue documentation> 
createCommandQueue ::
                   (MonadDOM m) =>
                     WebGPURenderingContext -> m (Maybe WebGPUCommandQueue)
createCommandQueue :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext -> m (Maybe WebGPUCommandQueue)
createCommandQueue WebGPURenderingContext
self
  = DOM (Maybe WebGPUCommandQueue) -> m (Maybe WebGPUCommandQueue)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createCommandQueue" ()) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUCommandQueue))
-> DOM (Maybe WebGPUCommandQueue)
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 WebGPUCommandQueue)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createCommandQueue Mozilla WebGPURenderingContext.createCommandQueue documentation> 
createCommandQueue_ ::
                    (MonadDOM m) => WebGPURenderingContext -> m ()
createCommandQueue_ :: forall (m :: * -> *). MonadDOM m => WebGPURenderingContext -> m ()
createCommandQueue_ WebGPURenderingContext
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createCommandQueue" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createCommandQueue Mozilla WebGPURenderingContext.createCommandQueue documentation> 
createCommandQueueUnsafe ::
                         (MonadDOM m, HasCallStack) =>
                           WebGPURenderingContext -> m WebGPUCommandQueue
createCommandQueueUnsafe :: forall (m :: * -> *).
(MonadDOM m, HasCallStack) =>
WebGPURenderingContext -> m WebGPUCommandQueue
createCommandQueueUnsafe WebGPURenderingContext
self
  = DOM WebGPUCommandQueue -> m WebGPUCommandQueue
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createCommandQueue" ()) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUCommandQueue))
-> DOM (Maybe WebGPUCommandQueue)
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 WebGPUCommandQueue)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe WebGPUCommandQueue)
-> (Maybe WebGPUCommandQueue -> DOM WebGPUCommandQueue)
-> DOM WebGPUCommandQueue
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM WebGPUCommandQueue
-> (WebGPUCommandQueue -> DOM WebGPUCommandQueue)
-> Maybe WebGPUCommandQueue
-> DOM WebGPUCommandQueue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM WebGPUCommandQueue
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") WebGPUCommandQueue -> DOM WebGPUCommandQueue
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createCommandQueue Mozilla WebGPURenderingContext.createCommandQueue documentation> 
createCommandQueueUnchecked ::
                            (MonadDOM m) => WebGPURenderingContext -> m WebGPUCommandQueue
createCommandQueueUnchecked :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext -> m WebGPUCommandQueue
createCommandQueueUnchecked WebGPURenderingContext
self
  = DOM WebGPUCommandQueue -> m WebGPUCommandQueue
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createCommandQueue" ()) JSM JSVal
-> (JSVal -> DOM WebGPUCommandQueue) -> DOM WebGPUCommandQueue
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 WebGPUCommandQueue
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.nextDrawable Mozilla WebGPURenderingContext.nextDrawable documentation> 
nextDrawable ::
             (MonadDOM m) => WebGPURenderingContext -> m (Maybe WebGPUDrawable)
nextDrawable :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext -> m (Maybe WebGPUDrawable)
nextDrawable WebGPURenderingContext
self
  = DOM (Maybe WebGPUDrawable) -> m (Maybe WebGPUDrawable)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"nextDrawable" ()) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUDrawable))
-> DOM (Maybe WebGPUDrawable)
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 WebGPUDrawable)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.nextDrawable Mozilla WebGPURenderingContext.nextDrawable documentation> 
nextDrawable_ :: (MonadDOM m) => WebGPURenderingContext -> m ()
nextDrawable_ :: forall (m :: * -> *). MonadDOM m => WebGPURenderingContext -> m ()
nextDrawable_ WebGPURenderingContext
self = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"nextDrawable" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.nextDrawable Mozilla WebGPURenderingContext.nextDrawable documentation> 
nextDrawableUnsafe ::
                   (MonadDOM m, HasCallStack) =>
                     WebGPURenderingContext -> m WebGPUDrawable
nextDrawableUnsafe :: forall (m :: * -> *).
(MonadDOM m, HasCallStack) =>
WebGPURenderingContext -> m WebGPUDrawable
nextDrawableUnsafe WebGPURenderingContext
self
  = DOM WebGPUDrawable -> m WebGPUDrawable
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"nextDrawable" ()) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUDrawable))
-> DOM (Maybe WebGPUDrawable)
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 WebGPUDrawable)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe WebGPUDrawable)
-> (Maybe WebGPUDrawable -> DOM WebGPUDrawable)
-> DOM WebGPUDrawable
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM WebGPUDrawable
-> (WebGPUDrawable -> DOM WebGPUDrawable)
-> Maybe WebGPUDrawable
-> DOM WebGPUDrawable
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM WebGPUDrawable
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") WebGPUDrawable -> DOM WebGPUDrawable
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.nextDrawable Mozilla WebGPURenderingContext.nextDrawable documentation> 
nextDrawableUnchecked ::
                      (MonadDOM m) => WebGPURenderingContext -> m WebGPUDrawable
nextDrawableUnchecked :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext -> m WebGPUDrawable
nextDrawableUnchecked WebGPURenderingContext
self
  = DOM WebGPUDrawable -> m WebGPUDrawable
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"nextDrawable" ()) JSM JSVal -> (JSVal -> DOM WebGPUDrawable) -> DOM WebGPUDrawable
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 WebGPUDrawable
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createBuffer Mozilla WebGPURenderingContext.createBuffer documentation> 
createBuffer ::
             (MonadDOM m, IsArrayBufferView data') =>
               WebGPURenderingContext -> data' -> m (Maybe WebGPUBuffer)
createBuffer :: forall (m :: * -> *) data'.
(MonadDOM m, IsArrayBufferView data') =>
WebGPURenderingContext -> data' -> m (Maybe WebGPUBuffer)
createBuffer WebGPURenderingContext
self data'
data'
  = DOM (Maybe WebGPUBuffer) -> m (Maybe WebGPUBuffer)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createBuffer" [data' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal data'
data']) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUBuffer)) -> DOM (Maybe WebGPUBuffer)
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 WebGPUBuffer)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createBuffer Mozilla WebGPURenderingContext.createBuffer documentation> 
createBuffer_ ::
              (MonadDOM m, IsArrayBufferView data') =>
                WebGPURenderingContext -> data' -> m ()
createBuffer_ :: forall (m :: * -> *) data'.
(MonadDOM m, IsArrayBufferView data') =>
WebGPURenderingContext -> data' -> m ()
createBuffer_ WebGPURenderingContext
self data'
data'
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createBuffer" [data' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal data'
data']))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createBuffer Mozilla WebGPURenderingContext.createBuffer documentation> 
createBufferUnsafe ::
                   (MonadDOM m, IsArrayBufferView data', HasCallStack) =>
                     WebGPURenderingContext -> data' -> m WebGPUBuffer
createBufferUnsafe :: forall (m :: * -> *) data'.
(MonadDOM m, IsArrayBufferView data', HasCallStack) =>
WebGPURenderingContext -> data' -> m WebGPUBuffer
createBufferUnsafe WebGPURenderingContext
self data'
data'
  = DOM WebGPUBuffer -> m WebGPUBuffer
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createBuffer" [data' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal data'
data']) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUBuffer)) -> DOM (Maybe WebGPUBuffer)
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 WebGPUBuffer)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe WebGPUBuffer)
-> (Maybe WebGPUBuffer -> DOM WebGPUBuffer) -> DOM WebGPUBuffer
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM WebGPUBuffer
-> (WebGPUBuffer -> DOM WebGPUBuffer)
-> Maybe WebGPUBuffer
-> DOM WebGPUBuffer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM WebGPUBuffer
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") WebGPUBuffer -> DOM WebGPUBuffer
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createBuffer Mozilla WebGPURenderingContext.createBuffer documentation> 
createBufferUnchecked ::
                      (MonadDOM m, IsArrayBufferView data') =>
                        WebGPURenderingContext -> data' -> m WebGPUBuffer
createBufferUnchecked :: forall (m :: * -> *) data'.
(MonadDOM m, IsArrayBufferView data') =>
WebGPURenderingContext -> data' -> m WebGPUBuffer
createBufferUnchecked WebGPURenderingContext
self data'
data'
  = DOM WebGPUBuffer -> m WebGPUBuffer
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createBuffer" [data' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal data'
data']) JSM JSVal -> (JSVal -> DOM WebGPUBuffer) -> DOM WebGPUBuffer
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 WebGPUBuffer
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createTexture Mozilla WebGPURenderingContext.createTexture documentation> 
createTexture ::
              (MonadDOM m) =>
                WebGPURenderingContext ->
                  WebGPUTextureDescriptor -> m (Maybe WebGPUTexture)
createTexture :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext
-> WebGPUTextureDescriptor -> m (Maybe WebGPUTexture)
createTexture WebGPURenderingContext
self WebGPUTextureDescriptor
descriptor
  = DOM (Maybe WebGPUTexture) -> m (Maybe WebGPUTexture)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createTexture" [WebGPUTextureDescriptor -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUTextureDescriptor
descriptor]) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUTexture))
-> DOM (Maybe WebGPUTexture)
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 WebGPUTexture)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createTexture Mozilla WebGPURenderingContext.createTexture documentation> 
createTexture_ ::
               (MonadDOM m) =>
                 WebGPURenderingContext -> WebGPUTextureDescriptor -> m ()
createTexture_ :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext -> WebGPUTextureDescriptor -> m ()
createTexture_ WebGPURenderingContext
self WebGPUTextureDescriptor
descriptor
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createTexture" [WebGPUTextureDescriptor -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUTextureDescriptor
descriptor]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createTexture Mozilla WebGPURenderingContext.createTexture documentation> 
createTextureUnsafe ::
                    (MonadDOM m, HasCallStack) =>
                      WebGPURenderingContext ->
                        WebGPUTextureDescriptor -> m WebGPUTexture
createTextureUnsafe :: forall (m :: * -> *).
(MonadDOM m, HasCallStack) =>
WebGPURenderingContext
-> WebGPUTextureDescriptor -> m WebGPUTexture
createTextureUnsafe WebGPURenderingContext
self WebGPUTextureDescriptor
descriptor
  = DOM WebGPUTexture -> m WebGPUTexture
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createTexture" [WebGPUTextureDescriptor -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUTextureDescriptor
descriptor]) JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUTexture))
-> DOM (Maybe WebGPUTexture)
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 WebGPUTexture)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)
         DOM (Maybe WebGPUTexture)
-> (Maybe WebGPUTexture -> DOM WebGPUTexture) -> DOM WebGPUTexture
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DOM WebGPUTexture
-> (WebGPUTexture -> DOM WebGPUTexture)
-> Maybe WebGPUTexture
-> DOM WebGPUTexture
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM WebGPUTexture
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") WebGPUTexture -> DOM WebGPUTexture
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderingContext.createTexture Mozilla WebGPURenderingContext.createTexture documentation> 
createTextureUnchecked ::
                       (MonadDOM m) =>
                         WebGPURenderingContext ->
                           WebGPUTextureDescriptor -> m WebGPUTexture
createTextureUnchecked :: forall (m :: * -> *).
MonadDOM m =>
WebGPURenderingContext
-> WebGPUTextureDescriptor -> m WebGPUTexture
createTextureUnchecked WebGPURenderingContext
self WebGPUTextureDescriptor
descriptor
  = DOM WebGPUTexture -> m WebGPUTexture
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPURenderingContext
self WebGPURenderingContext
-> Getting (JSM JSVal) WebGPURenderingContext (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createTexture" [WebGPUTextureDescriptor -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUTextureDescriptor
descriptor]) JSM JSVal -> (JSVal -> DOM WebGPUTexture) -> DOM WebGPUTexture
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 WebGPUTexture
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)
pattern $mPixelFormatBGRA8Unorm :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bPixelFormatBGRA8Unorm :: forall {a}. (Eq a, Num a) => a
PixelFormatBGRA8Unorm = 80
pattern $mPixelFormatDepth32Float :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bPixelFormatDepth32Float :: forall {a}. (Eq a, Num a) => a
PixelFormatDepth32Float = 252
pattern $mPixelFormatStencil8 :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bPixelFormatStencil8 :: forall {a}. (Eq a, Num a) => a
PixelFormatStencil8 = 253
pattern $mPixelFormatInvalid :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bPixelFormatInvalid :: forall {a}. (Eq a, Num a) => a
PixelFormatInvalid = 0
pattern $mLoadActionDontCare :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bLoadActionDontCare :: forall {a}. (Eq a, Num a) => a
LoadActionDontCare = 0
pattern $mLoadActionLoad :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bLoadActionLoad :: forall {a}. (Eq a, Num a) => a
LoadActionLoad = 1
pattern $mLoadActionClear :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bLoadActionClear :: forall {a}. (Eq a, Num a) => a
LoadActionClear = 2
pattern $mStoreActionDontCare :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bStoreActionDontCare :: forall {a}. (Eq a, Num a) => a
StoreActionDontCare = 0
pattern $mStoreActionStore :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bStoreActionStore :: forall {a}. (Eq a, Num a) => a
StoreActionStore = 1
pattern $mStoreActionMultisampleResolve :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bStoreActionMultisampleResolve :: forall {a}. (Eq a, Num a) => a
StoreActionMultisampleResolve = 2
pattern $mPrimitiveTypePoint :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bPrimitiveTypePoint :: forall {a}. (Eq a, Num a) => a
PrimitiveTypePoint = 0
pattern $mPrimitiveTypeLine :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bPrimitiveTypeLine :: forall {a}. (Eq a, Num a) => a
PrimitiveTypeLine = 1
pattern $mPrimitiveTypeLineStrip :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bPrimitiveTypeLineStrip :: forall {a}. (Eq a, Num a) => a
PrimitiveTypeLineStrip = 2
pattern $mPrimitiveTypeTriangle :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bPrimitiveTypeTriangle :: forall {a}. (Eq a, Num a) => a
PrimitiveTypeTriangle = 3
pattern $mPrimitiveTypeTriangleStrip :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bPrimitiveTypeTriangleStrip :: forall {a}. (Eq a, Num a) => a
PrimitiveTypeTriangleStrip = 4
pattern $mCompareFunctionNever :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bCompareFunctionNever :: forall {a}. (Eq a, Num a) => a
CompareFunctionNever = 0
pattern $mCompareFunctionLess :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bCompareFunctionLess :: forall {a}. (Eq a, Num a) => a
CompareFunctionLess = 1
pattern $mCompareFunctionEqual :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bCompareFunctionEqual :: forall {a}. (Eq a, Num a) => a
CompareFunctionEqual = 2
pattern $mCompareFunctionLessEqual :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bCompareFunctionLessEqual :: forall {a}. (Eq a, Num a) => a
CompareFunctionLessEqual = 3
pattern $mCompareFunctionGreater :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bCompareFunctionGreater :: forall {a}. (Eq a, Num a) => a
CompareFunctionGreater = 4
pattern $mCompareFunctionNotEqual :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bCompareFunctionNotEqual :: forall {a}. (Eq a, Num a) => a
CompareFunctionNotEqual = 5
pattern $mCompareFunctionGreaterEqual :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bCompareFunctionGreaterEqual :: forall {a}. (Eq a, Num a) => a
CompareFunctionGreaterEqual = 6
pattern $mCompareFunctionAlways :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bCompareFunctionAlways :: forall {a}. (Eq a, Num a) => a
CompareFunctionAlways = 7
pattern $mTextureType1D :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bTextureType1D :: forall {a}. (Eq a, Num a) => a
TextureType1D = 0
pattern $mTextureType1DArray :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bTextureType1DArray :: forall {a}. (Eq a, Num a) => a
TextureType1DArray = 1
pattern $mTextureType2D :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bTextureType2D :: forall {a}. (Eq a, Num a) => a
TextureType2D = 2
pattern $mTextureType2DArray :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bTextureType2DArray :: forall {a}. (Eq a, Num a) => a
TextureType2DArray = 3
pattern $mTextureType2DMultisample :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bTextureType2DMultisample :: forall {a}. (Eq a, Num a) => a
TextureType2DMultisample = 4
pattern $mTextureTypeCube :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bTextureTypeCube :: forall {a}. (Eq a, Num a) => a
TextureTypeCube = 5
pattern $mTextureTypeCubeArray :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bTextureTypeCubeArray :: forall {a}. (Eq a, Num a) => a
TextureTypeCubeArray = 6
pattern $mTextureType3D :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bTextureType3D :: forall {a}. (Eq a, Num a) => a
TextureType3D = 7
pattern $mStorageModeShared :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bStorageModeShared :: forall {a}. (Eq a, Num a) => a
StorageModeShared = 0
pattern $mStorageModeManaged :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bStorageModeManaged :: forall {a}. (Eq a, Num a) => a
StorageModeManaged = 1
pattern $mStorageModePrivate :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bStorageModePrivate :: forall {a}. (Eq a, Num a) => a
StorageModePrivate = 2
pattern $mTextureUsageUnknown :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bTextureUsageUnknown :: forall {a}. (Eq a, Num a) => a
TextureUsageUnknown = 0
pattern $mTextureUsageShaderRead :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bTextureUsageShaderRead :: forall {a}. (Eq a, Num a) => a
TextureUsageShaderRead = 1
pattern $mTextureUsageShaderWrite :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bTextureUsageShaderWrite :: forall {a}. (Eq a, Num a) => a
TextureUsageShaderWrite = 2
pattern $mTextureUsageRenderTarget :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bTextureUsageRenderTarget :: forall {a}. (Eq a, Num a) => a
TextureUsageRenderTarget = 4
pattern $mTextureUsagePixelFormatView :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bTextureUsagePixelFormatView :: forall {a}. (Eq a, Num a) => a
TextureUsagePixelFormatView = 16