{-# language CPP #-}
module Vulkan.Core10.Shader ( createShaderModule
, withShaderModule
, destroyShaderModule
, ShaderModuleCreateInfo(..)
, ShaderModule(..)
, ShaderModuleCreateFlags(..)
) where
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Bits ((.&.))
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (ptrToWordPtr)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import qualified Data.ByteString (length)
import Data.ByteString (packCStringLen)
import Data.ByteString.Unsafe (unsafeUseAsCString)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(..))
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Word (Word64)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCreateShaderModule))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyShaderModule))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Handles (ShaderModule)
import Vulkan.Core10.Handles (ShaderModule(..))
import Vulkan.Core10.Enums.ShaderModuleCreateFlags (ShaderModuleCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_validation_cache (ShaderModuleValidationCacheCreateInfoEXT)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_validation_features (ValidationFeaturesEXT)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Handles (ShaderModule(..))
import Vulkan.Core10.Enums.ShaderModuleCreateFlags (ShaderModuleCreateFlags(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateShaderModule
:: FunPtr (Ptr Device_T -> Ptr (SomeStruct ShaderModuleCreateInfo) -> Ptr AllocationCallbacks -> Ptr ShaderModule -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct ShaderModuleCreateInfo) -> Ptr AllocationCallbacks -> Ptr ShaderModule -> IO Result
createShaderModule :: forall a io
. ( Extendss ShaderModuleCreateInfo a
, PokeChain a
, MonadIO io )
=>
Device
->
(ShaderModuleCreateInfo a)
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (ShaderModule)
createShaderModule :: forall (a :: [*]) (io :: * -> *).
(Extendss ShaderModuleCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> ShaderModuleCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ShaderModule
createShaderModule Device
device ShaderModuleCreateInfo a
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = IO ShaderModule -> io ShaderModule
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShaderModule -> io ShaderModule)
-> (ContT ShaderModule IO ShaderModule -> IO ShaderModule)
-> ContT ShaderModule IO ShaderModule
-> io ShaderModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT ShaderModule IO ShaderModule -> IO ShaderModule
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT ShaderModule IO ShaderModule -> io ShaderModule)
-> ContT ShaderModule IO ShaderModule -> io ShaderModule
forall a b. (a -> b) -> a -> b
$ do
let vkCreateShaderModulePtr :: FunPtr
(Ptr Device_T
-> Ptr (SomeStruct ShaderModuleCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr ShaderModule
-> IO Result)
vkCreateShaderModulePtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> Ptr (SomeStruct ShaderModuleCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr ShaderModule
-> IO Result)
pVkCreateShaderModule (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
IO () -> ContT ShaderModule IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT ShaderModule m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ShaderModule IO ())
-> IO () -> ContT ShaderModule IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> Ptr (SomeStruct ShaderModuleCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr ShaderModule
-> IO Result)
vkCreateShaderModulePtr FunPtr
(Ptr Device_T
-> Ptr (SomeStruct ShaderModuleCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr ShaderModule
-> IO Result)
-> FunPtr
(Ptr Device_T
-> Ptr (SomeStruct ShaderModuleCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr ShaderModule
-> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> Ptr (SomeStruct ShaderModuleCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr ShaderModule
-> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCreateShaderModule is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkCreateShaderModule' :: Ptr Device_T
-> Ptr (SomeStruct ShaderModuleCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr ShaderModule
-> IO Result
vkCreateShaderModule' = FunPtr
(Ptr Device_T
-> Ptr (SomeStruct ShaderModuleCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr ShaderModule
-> IO Result)
-> Ptr Device_T
-> Ptr (SomeStruct ShaderModuleCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr ShaderModule
-> IO Result
mkVkCreateShaderModule FunPtr
(Ptr Device_T
-> Ptr (SomeStruct ShaderModuleCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr ShaderModule
-> IO Result)
vkCreateShaderModulePtr
pCreateInfo <- ((Ptr (ShaderModuleCreateInfo a) -> IO ShaderModule)
-> IO ShaderModule)
-> ContT ShaderModule IO (Ptr (ShaderModuleCreateInfo a))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (ShaderModuleCreateInfo a) -> IO ShaderModule)
-> IO ShaderModule)
-> ContT ShaderModule IO (Ptr (ShaderModuleCreateInfo a)))
-> ((Ptr (ShaderModuleCreateInfo a) -> IO ShaderModule)
-> IO ShaderModule)
-> ContT ShaderModule IO (Ptr (ShaderModuleCreateInfo a))
forall a b. (a -> b) -> a -> b
$ ShaderModuleCreateInfo a
-> (Ptr (ShaderModuleCreateInfo a) -> IO ShaderModule)
-> IO ShaderModule
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
ShaderModuleCreateInfo a
-> (Ptr (ShaderModuleCreateInfo a) -> IO b) -> IO b
withCStruct (ShaderModuleCreateInfo a
createInfo)
pAllocator <- case (allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> Ptr AllocationCallbacks
-> ContT ShaderModule IO (Ptr AllocationCallbacks)
forall a. a -> ContT ShaderModule IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> ((Ptr AllocationCallbacks -> IO ShaderModule) -> IO ShaderModule)
-> ContT ShaderModule IO (Ptr AllocationCallbacks)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCallbacks -> IO ShaderModule) -> IO ShaderModule)
-> ContT ShaderModule IO (Ptr AllocationCallbacks))
-> ((Ptr AllocationCallbacks -> IO ShaderModule)
-> IO ShaderModule)
-> ContT ShaderModule IO (Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (Ptr AllocationCallbacks -> IO ShaderModule) -> IO ShaderModule
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
AllocationCallbacks -> (Ptr AllocationCallbacks -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
pPShaderModule <- ContT $ bracket (callocBytes @ShaderModule 8) free
r <- lift $ traceAroundEvent "vkCreateShaderModule" (vkCreateShaderModule'
(deviceHandle (device))
(forgetExtensions pCreateInfo)
pAllocator
(pPShaderModule))
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pShaderModule <- lift $ peek @ShaderModule pPShaderModule
pure $ (pShaderModule)
withShaderModule :: forall a io r . (Extendss ShaderModuleCreateInfo a, PokeChain a, MonadIO io) => Device -> ShaderModuleCreateInfo a -> Maybe AllocationCallbacks -> (io ShaderModule -> (ShaderModule -> io ()) -> r) -> r
withShaderModule :: forall (a :: [*]) (io :: * -> *) r.
(Extendss ShaderModuleCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> ShaderModuleCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io ShaderModule -> (ShaderModule -> io ()) -> r)
-> r
withShaderModule Device
device ShaderModuleCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io ShaderModule -> (ShaderModule -> io ()) -> r
b =
io ShaderModule -> (ShaderModule -> io ()) -> r
b (Device
-> ShaderModuleCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ShaderModule
forall (a :: [*]) (io :: * -> *).
(Extendss ShaderModuleCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> ShaderModuleCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ShaderModule
createShaderModule Device
device ShaderModuleCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(ShaderModule
o0) -> Device
-> ShaderModule
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> ShaderModule
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyShaderModule Device
device ShaderModule
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroyShaderModule
:: FunPtr (Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ()
destroyShaderModule :: forall io
. (MonadIO io)
=>
Device
->
ShaderModule
->
("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyShaderModule :: forall (io :: * -> *).
MonadIO io =>
Device
-> ShaderModule
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyShaderModule Device
device ShaderModule
shaderModule "allocator" ::: Maybe AllocationCallbacks
allocator = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
let vkDestroyShaderModulePtr :: FunPtr
(Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ())
vkDestroyShaderModulePtr = DeviceCmds
-> FunPtr
(Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ())
pVkDestroyShaderModule (case Device
device of Device{DeviceCmds
deviceCmds :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ())
vkDestroyShaderModulePtr FunPtr
(Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ())
-> FunPtr
(Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkDestroyShaderModule is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkDestroyShaderModule' :: Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ()
vkDestroyShaderModule' = FunPtr
(Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ())
-> Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ()
mkVkDestroyShaderModule FunPtr
(Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ())
vkDestroyShaderModulePtr
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> Ptr AllocationCallbacks -> ContT () IO (Ptr AllocationCallbacks)
forall a. a -> ContT () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> ((Ptr AllocationCallbacks -> IO ()) -> IO ())
-> ContT () IO (Ptr AllocationCallbacks)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCallbacks -> IO ()) -> IO ())
-> ContT () IO (Ptr AllocationCallbacks))
-> ((Ptr AllocationCallbacks -> IO ()) -> IO ())
-> ContT () IO (Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks -> (Ptr AllocationCallbacks -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
AllocationCallbacks -> (Ptr AllocationCallbacks -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
lift $ traceAroundEvent "vkDestroyShaderModule" (vkDestroyShaderModule'
(deviceHandle (device))
(shaderModule)
pAllocator)
pure $ ()
data ShaderModuleCreateInfo (es :: [Type]) = ShaderModuleCreateInfo
{
forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
next :: Chain es
,
forall (es :: [*]).
ShaderModuleCreateInfo es -> ShaderModuleCreateFlags
flags :: ShaderModuleCreateFlags
,
forall (es :: [*]). ShaderModuleCreateInfo es -> ByteString
code :: ByteString
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ShaderModuleCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (ShaderModuleCreateInfo es)
instance Extensible ShaderModuleCreateInfo where
extensibleTypeName :: String
extensibleTypeName = String
"ShaderModuleCreateInfo"
setNext :: forall (ds :: [*]) (es :: [*]).
ShaderModuleCreateInfo ds -> Chain es -> ShaderModuleCreateInfo es
setNext ShaderModuleCreateInfo{ByteString
ShaderModuleCreateFlags
Chain ds
next :: forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
flags :: forall (es :: [*]).
ShaderModuleCreateInfo es -> ShaderModuleCreateFlags
code :: forall (es :: [*]). ShaderModuleCreateInfo es -> ByteString
next :: Chain ds
flags :: ShaderModuleCreateFlags
code :: ByteString
..} Chain es
next' = ShaderModuleCreateInfo{next :: Chain es
next = Chain es
next', ByteString
ShaderModuleCreateFlags
flags :: ShaderModuleCreateFlags
code :: ByteString
flags :: ShaderModuleCreateFlags
code :: ByteString
..}
getNext :: forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
getNext ShaderModuleCreateInfo{ByteString
ShaderModuleCreateFlags
Chain es
next :: forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
flags :: forall (es :: [*]).
ShaderModuleCreateInfo es -> ShaderModuleCreateFlags
code :: forall (es :: [*]). ShaderModuleCreateInfo es -> ByteString
next :: Chain es
flags :: ShaderModuleCreateFlags
code :: ByteString
..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends ShaderModuleCreateInfo e => b) -> Maybe b
extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends ShaderModuleCreateInfo e => b) -> Maybe b
extends proxy e
_ Extends ShaderModuleCreateInfo e => b
f
| Just e :~: ShaderModuleValidationCacheCreateInfoEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @e @ShaderModuleValidationCacheCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends ShaderModuleCreateInfo e => b
f
| Just e :~: ValidationFeaturesEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @e @ValidationFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends ShaderModuleCreateInfo e => b
f
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
instance ( Extendss ShaderModuleCreateInfo es
, PokeChain es ) => ToCStruct (ShaderModuleCreateInfo es) where
withCStruct :: forall b.
ShaderModuleCreateInfo es
-> (Ptr (ShaderModuleCreateInfo es) -> IO b) -> IO b
withCStruct ShaderModuleCreateInfo es
x Ptr (ShaderModuleCreateInfo es) -> IO b
f = Int -> (Ptr (ShaderModuleCreateInfo es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 ((Ptr (ShaderModuleCreateInfo es) -> IO b) -> IO b)
-> (Ptr (ShaderModuleCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (ShaderModuleCreateInfo es)
p -> Ptr (ShaderModuleCreateInfo es)
-> ShaderModuleCreateInfo es -> IO b -> IO b
forall b.
Ptr (ShaderModuleCreateInfo es)
-> ShaderModuleCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (ShaderModuleCreateInfo es)
p ShaderModuleCreateInfo es
x (Ptr (ShaderModuleCreateInfo es) -> IO b
f Ptr (ShaderModuleCreateInfo es)
p)
pokeCStruct :: forall b.
Ptr (ShaderModuleCreateInfo es)
-> ShaderModuleCreateInfo es -> IO b -> IO b
pokeCStruct Ptr (ShaderModuleCreateInfo es)
p ShaderModuleCreateInfo{ByteString
ShaderModuleCreateFlags
Chain es
next :: forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
flags :: forall (es :: [*]).
ShaderModuleCreateInfo es -> ShaderModuleCreateFlags
code :: forall (es :: [*]). ShaderModuleCreateInfo es -> ByteString
next :: Chain es
flags :: ShaderModuleCreateFlags
code :: ByteString
..} IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p Ptr (ShaderModuleCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO)
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> ContT b IO a -> ContT b IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
forall a. Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
lift $ poke ((p `plusPtr` 8 :: Ptr (Ptr ()))) pNext''
lift $ poke ((p `plusPtr` 16 :: Ptr ShaderModuleCreateFlags)) (flags)
lift $ poke ((p `plusPtr` 24 :: Ptr CSize)) (fromIntegral $ Data.ByteString.length (code))
lift $ unless (Data.ByteString.length (code) .&. 3 == 0) $
throwIO $ IOError Nothing InvalidArgument "" "code size must be a multiple of 4" Nothing Nothing
unalignedCode <- ContT $ unsafeUseAsCString (code)
pCode'' <- if ptrToWordPtr unalignedCode .&. 3 == 0
then pure $ castPtr @CChar @Word32 unalignedCode
else do
let len = ByteString -> Int
Data.ByteString.length (ByteString
code)
mem <- ContT $ allocaBytes @Word32 len
lift $ copyBytes mem (castPtr @CChar @Word32 unalignedCode) len
pure mem
lift $ poke ((p `plusPtr` 32 :: Ptr (Ptr Word32))) pCode''
lift $ f
cStructSize :: Int
cStructSize = Int
40
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr (ShaderModuleCreateInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (ShaderModuleCreateInfo es)
p IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p Ptr (ShaderModuleCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO)
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> ContT b IO a -> ContT b IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
lift $ poke ((p `plusPtr` 8 :: Ptr (Ptr ()))) pNext'
lift $ f
instance ( Extendss ShaderModuleCreateInfo es
, PeekChain es ) => FromCStruct (ShaderModuleCreateInfo es) where
peekCStruct :: Ptr (ShaderModuleCreateInfo es) -> IO (ShaderModuleCreateInfo es)
peekCStruct Ptr (ShaderModuleCreateInfo es)
p = do
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (ShaderModuleCreateInfo es)
p Ptr (ShaderModuleCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
next <- peekChain (castPtr pNext)
flags <- peek @ShaderModuleCreateFlags ((p `plusPtr` 16 :: Ptr ShaderModuleCreateFlags))
codeSize <- peek @CSize ((p `plusPtr` 24 :: Ptr CSize))
pCode <- peek @(Ptr Word32) ((p `plusPtr` 32 :: Ptr (Ptr Word32)))
code <- packCStringLen ( castPtr @Word32 @CChar pCode
, fromIntegral $ (coerce @CSize @Word64 codeSize) * 4 )
pure $ ShaderModuleCreateInfo
next flags code
instance es ~ '[] => Zero (ShaderModuleCreateInfo es) where
zero :: ShaderModuleCreateInfo es
zero = Chain es
-> ShaderModuleCreateFlags
-> ByteString
-> ShaderModuleCreateInfo es
forall (es :: [*]).
Chain es
-> ShaderModuleCreateFlags
-> ByteString
-> ShaderModuleCreateInfo es
ShaderModuleCreateInfo
()
ShaderModuleCreateFlags
forall a. Zero a => a
zero
ByteString
forall a. Monoid a => a
mempty