{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.WebGPURenderPassDescriptor
       (newWebGPURenderPassDescriptor, getColorAttachments,
        getDepthAttachment, WebGPURenderPassDescriptor(..),
        gTypeWebGPURenderPassDescriptor)
       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/WebGPURenderPassDescriptor Mozilla WebGPURenderPassDescriptor documentation> 
newWebGPURenderPassDescriptor ::
                              (MonadDOM m) => m WebGPURenderPassDescriptor
newWebGPURenderPassDescriptor :: m WebGPURenderPassDescriptor
newWebGPURenderPassDescriptor
  = DOM WebGPURenderPassDescriptor -> m WebGPURenderPassDescriptor
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSVal -> WebGPURenderPassDescriptor
WebGPURenderPassDescriptor (JSVal -> WebGPURenderPassDescriptor)
-> JSM JSVal -> DOM WebGPURenderPassDescriptor
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]
"WebGPURenderPassDescriptor") ())

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

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