{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.WebGPURenderPipelineDescriptor
       (newWebGPURenderPipelineDescriptor, reset, setVertexFunction,
        getVertexFunction, getVertexFunctionUnsafe,
        getVertexFunctionUnchecked, setFragmentFunction,
        getFragmentFunction, getFragmentFunctionUnsafe,
        getFragmentFunctionUnchecked, getColorAttachments,
        setDepthAttachmentPixelFormat, getDepthAttachmentPixelFormat,
        WebGPURenderPipelineDescriptor(..),
        gTypeWebGPURenderPipelineDescriptor)
       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/WebGPURenderPipelineDescriptor Mozilla WebGPURenderPipelineDescriptor documentation> 
newWebGPURenderPipelineDescriptor ::
                                  (MonadDOM m) => m WebGPURenderPipelineDescriptor
newWebGPURenderPipelineDescriptor :: m WebGPURenderPipelineDescriptor
newWebGPURenderPipelineDescriptor
  = DOM WebGPURenderPipelineDescriptor
-> m WebGPURenderPipelineDescriptor
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSVal -> WebGPURenderPipelineDescriptor
WebGPURenderPipelineDescriptor (JSVal -> WebGPURenderPipelineDescriptor)
-> JSM JSVal -> DOM WebGPURenderPipelineDescriptor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         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]
"WebGPURenderPipelineDescriptor") ())

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderPipelineDescriptor.reset Mozilla WebGPURenderPipelineDescriptor.reset documentation> 
reset :: (MonadDOM m) => WebGPURenderPipelineDescriptor -> m ()
reset :: WebGPURenderPipelineDescriptor -> m ()
reset WebGPURenderPipelineDescriptor
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 (WebGPURenderPipelineDescriptor
self WebGPURenderPipelineDescriptor
-> Getting (JSM JSVal) WebGPURenderPipelineDescriptor (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"reset" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderPipelineDescriptor.vertexFunction Mozilla WebGPURenderPipelineDescriptor.vertexFunction documentation> 
setVertexFunction ::
                  (MonadDOM m) =>
                    WebGPURenderPipelineDescriptor -> Maybe WebGPUFunction -> m ()
setVertexFunction :: WebGPURenderPipelineDescriptor -> Maybe WebGPUFunction -> m ()
setVertexFunction WebGPURenderPipelineDescriptor
self Maybe WebGPUFunction
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (WebGPURenderPipelineDescriptor
self WebGPURenderPipelineDescriptor
-> Getting (DOM ()) WebGPURenderPipelineDescriptor (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]
"vertexFunction" (Maybe WebGPUFunction -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe WebGPUFunction
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderPipelineDescriptor.vertexFunction Mozilla WebGPURenderPipelineDescriptor.vertexFunction documentation> 
getVertexFunction ::
                  (MonadDOM m) =>
                    WebGPURenderPipelineDescriptor -> m (Maybe WebGPUFunction)
getVertexFunction :: WebGPURenderPipelineDescriptor -> m (Maybe WebGPUFunction)
getVertexFunction WebGPURenderPipelineDescriptor
self
  = DOM (Maybe WebGPUFunction) -> m (Maybe WebGPUFunction)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((WebGPURenderPipelineDescriptor
self WebGPURenderPipelineDescriptor
-> Getting (JSM JSVal) WebGPURenderPipelineDescriptor (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char]
-> IndexPreservingGetter WebGPURenderPipelineDescriptor (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"vertexFunction") 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/WebGPURenderPipelineDescriptor.vertexFunction Mozilla WebGPURenderPipelineDescriptor.vertexFunction documentation> 
getVertexFunctionUnsafe ::
                        (MonadDOM m, HasCallStack) =>
                          WebGPURenderPipelineDescriptor -> m WebGPUFunction
getVertexFunctionUnsafe :: WebGPURenderPipelineDescriptor -> m WebGPUFunction
getVertexFunctionUnsafe WebGPURenderPipelineDescriptor
self
  = DOM WebGPUFunction -> m WebGPUFunction
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((WebGPURenderPipelineDescriptor
self WebGPURenderPipelineDescriptor
-> Getting (JSM JSVal) WebGPURenderPipelineDescriptor (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char]
-> IndexPreservingGetter WebGPURenderPipelineDescriptor (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"vertexFunction") 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/WebGPURenderPipelineDescriptor.vertexFunction Mozilla WebGPURenderPipelineDescriptor.vertexFunction documentation> 
getVertexFunctionUnchecked ::
                           (MonadDOM m) => WebGPURenderPipelineDescriptor -> m WebGPUFunction
getVertexFunctionUnchecked :: WebGPURenderPipelineDescriptor -> m WebGPUFunction
getVertexFunctionUnchecked WebGPURenderPipelineDescriptor
self
  = DOM WebGPUFunction -> m WebGPUFunction
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((WebGPURenderPipelineDescriptor
self WebGPURenderPipelineDescriptor
-> Getting (JSM JSVal) WebGPURenderPipelineDescriptor (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char]
-> IndexPreservingGetter WebGPURenderPipelineDescriptor (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"vertexFunction") 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/WebGPURenderPipelineDescriptor.fragmentFunction Mozilla WebGPURenderPipelineDescriptor.fragmentFunction documentation> 
setFragmentFunction ::
                    (MonadDOM m) =>
                      WebGPURenderPipelineDescriptor -> Maybe WebGPUFunction -> m ()
setFragmentFunction :: WebGPURenderPipelineDescriptor -> Maybe WebGPUFunction -> m ()
setFragmentFunction WebGPURenderPipelineDescriptor
self Maybe WebGPUFunction
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (WebGPURenderPipelineDescriptor
self WebGPURenderPipelineDescriptor
-> Getting (DOM ()) WebGPURenderPipelineDescriptor (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]
"fragmentFunction" (Maybe WebGPUFunction -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe WebGPUFunction
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderPipelineDescriptor.fragmentFunction Mozilla WebGPURenderPipelineDescriptor.fragmentFunction documentation> 
getFragmentFunction ::
                    (MonadDOM m) =>
                      WebGPURenderPipelineDescriptor -> m (Maybe WebGPUFunction)
getFragmentFunction :: WebGPURenderPipelineDescriptor -> m (Maybe WebGPUFunction)
getFragmentFunction WebGPURenderPipelineDescriptor
self
  = DOM (Maybe WebGPUFunction) -> m (Maybe WebGPUFunction)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((WebGPURenderPipelineDescriptor
self WebGPURenderPipelineDescriptor
-> Getting (JSM JSVal) WebGPURenderPipelineDescriptor (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char]
-> IndexPreservingGetter WebGPURenderPipelineDescriptor (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"fragmentFunction") 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/WebGPURenderPipelineDescriptor.fragmentFunction Mozilla WebGPURenderPipelineDescriptor.fragmentFunction documentation> 
getFragmentFunctionUnsafe ::
                          (MonadDOM m, HasCallStack) =>
                            WebGPURenderPipelineDescriptor -> m WebGPUFunction
getFragmentFunctionUnsafe :: WebGPURenderPipelineDescriptor -> m WebGPUFunction
getFragmentFunctionUnsafe WebGPURenderPipelineDescriptor
self
  = DOM WebGPUFunction -> m WebGPUFunction
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((WebGPURenderPipelineDescriptor
self WebGPURenderPipelineDescriptor
-> Getting (JSM JSVal) WebGPURenderPipelineDescriptor (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char]
-> IndexPreservingGetter WebGPURenderPipelineDescriptor (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"fragmentFunction") 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/WebGPURenderPipelineDescriptor.fragmentFunction Mozilla WebGPURenderPipelineDescriptor.fragmentFunction documentation> 
getFragmentFunctionUnchecked ::
                             (MonadDOM m) => WebGPURenderPipelineDescriptor -> m WebGPUFunction
getFragmentFunctionUnchecked :: WebGPURenderPipelineDescriptor -> m WebGPUFunction
getFragmentFunctionUnchecked WebGPURenderPipelineDescriptor
self
  = DOM WebGPUFunction -> m WebGPUFunction
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((WebGPURenderPipelineDescriptor
self WebGPURenderPipelineDescriptor
-> Getting (JSM JSVal) WebGPURenderPipelineDescriptor (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char]
-> IndexPreservingGetter WebGPURenderPipelineDescriptor (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"fragmentFunction") 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/WebGPURenderPipelineDescriptor.colorAttachments Mozilla WebGPURenderPipelineDescriptor.colorAttachments documentation> 
getColorAttachments ::
                    (MonadDOM m) =>
                      WebGPURenderPipelineDescriptor ->
                        m [WebGPURenderPipelineColorAttachmentDescriptor]
getColorAttachments :: WebGPURenderPipelineDescriptor
-> m [WebGPURenderPipelineColorAttachmentDescriptor]
getColorAttachments WebGPURenderPipelineDescriptor
self
  = DOM [WebGPURenderPipelineColorAttachmentDescriptor]
-> m [WebGPURenderPipelineColorAttachmentDescriptor]
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGPURenderPipelineDescriptor
self WebGPURenderPipelineDescriptor
-> Getting (JSM JSVal) WebGPURenderPipelineDescriptor (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char]
-> IndexPreservingGetter WebGPURenderPipelineDescriptor (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"colorAttachments") JSM JSVal
-> (JSVal -> DOM [WebGPURenderPipelineColorAttachmentDescriptor])
-> DOM [WebGPURenderPipelineColorAttachmentDescriptor]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM [WebGPURenderPipelineColorAttachmentDescriptor]
forall o. FromJSVal o => JSVal -> JSM [o]
fromJSArrayUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderPipelineDescriptor.depthAttachmentPixelFormat Mozilla WebGPURenderPipelineDescriptor.depthAttachmentPixelFormat documentation> 
setDepthAttachmentPixelFormat ::
                              (MonadDOM m) => WebGPURenderPipelineDescriptor -> Word -> m ()
setDepthAttachmentPixelFormat :: WebGPURenderPipelineDescriptor -> Word -> m ()
setDepthAttachmentPixelFormat WebGPURenderPipelineDescriptor
self Word
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (WebGPURenderPipelineDescriptor
self WebGPURenderPipelineDescriptor
-> Getting (DOM ()) WebGPURenderPipelineDescriptor (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]
"depthAttachmentPixelFormat" (Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderPipelineDescriptor.depthAttachmentPixelFormat Mozilla WebGPURenderPipelineDescriptor.depthAttachmentPixelFormat documentation> 
getDepthAttachmentPixelFormat ::
                              (MonadDOM m) => WebGPURenderPipelineDescriptor -> m Word
getDepthAttachmentPixelFormat :: WebGPURenderPipelineDescriptor -> m Word
getDepthAttachmentPixelFormat WebGPURenderPipelineDescriptor
self
  = DOM Word -> m Word
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (Double -> Word
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Word) -> JSM Double -> DOM Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         ((WebGPURenderPipelineDescriptor
self WebGPURenderPipelineDescriptor
-> Getting (JSM JSVal) WebGPURenderPipelineDescriptor (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char]
-> IndexPreservingGetter WebGPURenderPipelineDescriptor (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"depthAttachmentPixelFormat") JSM JSVal -> (JSVal -> JSM Double) -> JSM Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM Double
forall value. ToJSVal value => value -> JSM Double
valToNumber))