{-# 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 -- | newWebGPURenderPipelineDescriptor :: (MonadDOM m) => m WebGPURenderPipelineDescriptor newWebGPURenderPipelineDescriptor = liftDOM (WebGPURenderPipelineDescriptor <$> new (jsg "WebGPURenderPipelineDescriptor") ()) -- | reset :: (MonadDOM m) => WebGPURenderPipelineDescriptor -> m () reset self = liftDOM (void (self ^. jsf "reset" ())) -- | setVertexFunction :: (MonadDOM m) => WebGPURenderPipelineDescriptor -> Maybe WebGPUFunction -> m () setVertexFunction self val = liftDOM (self ^. jss "vertexFunction" (toJSVal val)) -- | getVertexFunction :: (MonadDOM m) => WebGPURenderPipelineDescriptor -> m (Maybe WebGPUFunction) getVertexFunction self = liftDOM ((self ^. js "vertexFunction") >>= fromJSVal) -- | getVertexFunctionUnsafe :: (MonadDOM m, HasCallStack) => WebGPURenderPipelineDescriptor -> m WebGPUFunction getVertexFunctionUnsafe self = liftDOM (((self ^. js "vertexFunction") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getVertexFunctionUnchecked :: (MonadDOM m) => WebGPURenderPipelineDescriptor -> m WebGPUFunction getVertexFunctionUnchecked self = liftDOM ((self ^. js "vertexFunction") >>= fromJSValUnchecked) -- | setFragmentFunction :: (MonadDOM m) => WebGPURenderPipelineDescriptor -> Maybe WebGPUFunction -> m () setFragmentFunction self val = liftDOM (self ^. jss "fragmentFunction" (toJSVal val)) -- | getFragmentFunction :: (MonadDOM m) => WebGPURenderPipelineDescriptor -> m (Maybe WebGPUFunction) getFragmentFunction self = liftDOM ((self ^. js "fragmentFunction") >>= fromJSVal) -- | getFragmentFunctionUnsafe :: (MonadDOM m, HasCallStack) => WebGPURenderPipelineDescriptor -> m WebGPUFunction getFragmentFunctionUnsafe self = liftDOM (((self ^. js "fragmentFunction") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getFragmentFunctionUnchecked :: (MonadDOM m) => WebGPURenderPipelineDescriptor -> m WebGPUFunction getFragmentFunctionUnchecked self = liftDOM ((self ^. js "fragmentFunction") >>= fromJSValUnchecked) -- | getColorAttachments :: (MonadDOM m) => WebGPURenderPipelineDescriptor -> m [WebGPURenderPipelineColorAttachmentDescriptor] getColorAttachments self = liftDOM ((self ^. js "colorAttachments") >>= fromJSArrayUnchecked) -- | setDepthAttachmentPixelFormat :: (MonadDOM m) => WebGPURenderPipelineDescriptor -> Word -> m () setDepthAttachmentPixelFormat self val = liftDOM (self ^. jss "depthAttachmentPixelFormat" (toJSVal val)) -- | getDepthAttachmentPixelFormat :: (MonadDOM m) => WebGPURenderPipelineDescriptor -> m Word getDepthAttachmentPixelFormat self = liftDOM (round <$> ((self ^. js "depthAttachmentPixelFormat") >>= valToNumber))