{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.WebGPURenderPassAttachmentDescriptor
       (setTexture, getTexture, getTextureUnsafe, getTextureUnchecked,
        setLoadAction, getLoadAction, setStoreAction, getStoreAction,
        WebGPURenderPassAttachmentDescriptor(..),
        gTypeWebGPURenderPassAttachmentDescriptor,
        IsWebGPURenderPassAttachmentDescriptor,
        toWebGPURenderPassAttachmentDescriptor)
       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/WebGPURenderPassAttachmentDescriptor.texture Mozilla WebGPURenderPassAttachmentDescriptor.texture documentation> 
setTexture ::
           (MonadDOM m, IsWebGPURenderPassAttachmentDescriptor self) =>
             self -> Maybe WebGPUTexture -> m ()
setTexture :: self -> Maybe WebGPUTexture -> m ()
setTexture self
self Maybe WebGPUTexture
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((self -> WebGPURenderPassAttachmentDescriptor
forall o.
IsWebGPURenderPassAttachmentDescriptor o =>
o -> WebGPURenderPassAttachmentDescriptor
toWebGPURenderPassAttachmentDescriptor self
self) WebGPURenderPassAttachmentDescriptor
-> Getting (DOM ()) WebGPURenderPassAttachmentDescriptor (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]
"texture"
         (Maybe WebGPUTexture -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe WebGPUTexture
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderPassAttachmentDescriptor.texture Mozilla WebGPURenderPassAttachmentDescriptor.texture documentation> 
getTexture ::
           (MonadDOM m, IsWebGPURenderPassAttachmentDescriptor self) =>
             self -> m (Maybe WebGPUTexture)
getTexture :: self -> m (Maybe WebGPUTexture)
getTexture self
self
  = DOM (Maybe WebGPUTexture) -> m (Maybe WebGPUTexture)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> WebGPURenderPassAttachmentDescriptor
forall o.
IsWebGPURenderPassAttachmentDescriptor o =>
o -> WebGPURenderPassAttachmentDescriptor
toWebGPURenderPassAttachmentDescriptor self
self) WebGPURenderPassAttachmentDescriptor
-> Getting
     (JSM JSVal) WebGPURenderPassAttachmentDescriptor (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char]
-> IndexPreservingGetter
     WebGPURenderPassAttachmentDescriptor (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"texture")
         JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUTexture))
-> DOM (Maybe WebGPUTexture)
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/WebGPURenderPassAttachmentDescriptor.texture Mozilla WebGPURenderPassAttachmentDescriptor.texture documentation> 
getTextureUnsafe ::
                 (MonadDOM m, IsWebGPURenderPassAttachmentDescriptor self,
                  HasCallStack) =>
                   self -> m WebGPUTexture
getTextureUnsafe :: self -> m WebGPUTexture
getTextureUnsafe self
self
  = DOM WebGPUTexture -> m WebGPUTexture
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> WebGPURenderPassAttachmentDescriptor
forall o.
IsWebGPURenderPassAttachmentDescriptor o =>
o -> WebGPURenderPassAttachmentDescriptor
toWebGPURenderPassAttachmentDescriptor self
self) WebGPURenderPassAttachmentDescriptor
-> Getting
     (JSM JSVal) WebGPURenderPassAttachmentDescriptor (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char]
-> IndexPreservingGetter
     WebGPURenderPassAttachmentDescriptor (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"texture")
          JSM JSVal
-> (JSVal -> DOM (Maybe WebGPUTexture))
-> DOM (Maybe WebGPUTexture)
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 (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 ([Char] -> DOM WebGPUTexture
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") WebGPUTexture -> DOM WebGPUTexture
forall (m :: * -> *) a. Monad m => a -> m a
return)

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

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderPassAttachmentDescriptor.loadAction Mozilla WebGPURenderPassAttachmentDescriptor.loadAction documentation> 
getLoadAction ::
              (MonadDOM m, IsWebGPURenderPassAttachmentDescriptor self) =>
                self -> m Word
getLoadAction :: self -> m Word
getLoadAction self
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
<$>
         (((self -> WebGPURenderPassAttachmentDescriptor
forall o.
IsWebGPURenderPassAttachmentDescriptor o =>
o -> WebGPURenderPassAttachmentDescriptor
toWebGPURenderPassAttachmentDescriptor self
self) WebGPURenderPassAttachmentDescriptor
-> Getting
     (JSM JSVal) WebGPURenderPassAttachmentDescriptor (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char]
-> IndexPreservingGetter
     WebGPURenderPassAttachmentDescriptor (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"loadAction")
            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))

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPURenderPassAttachmentDescriptor.storeAction Mozilla WebGPURenderPassAttachmentDescriptor.storeAction documentation> 
getStoreAction ::
               (MonadDOM m, IsWebGPURenderPassAttachmentDescriptor self) =>
                 self -> m Word
getStoreAction :: self -> m Word
getStoreAction self
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
<$>
         (((self -> WebGPURenderPassAttachmentDescriptor
forall o.
IsWebGPURenderPassAttachmentDescriptor o =>
o -> WebGPURenderPassAttachmentDescriptor
toWebGPURenderPassAttachmentDescriptor self
self) WebGPURenderPassAttachmentDescriptor
-> Getting
     (JSM JSVal) WebGPURenderPassAttachmentDescriptor (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^.
             [Char]
-> IndexPreservingGetter
     WebGPURenderPassAttachmentDescriptor (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"storeAction")
            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))