{-# language CPP #-}
module Vulkan.Core10.QueueSemaphore ( createSemaphore
, withSemaphore
, destroySemaphore
, SemaphoreCreateInfo(..)
, Semaphore(..)
, SemaphoreCreateFlags(..)
) where
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
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 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.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.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(pVkCreateSemaphore))
import Vulkan.Dynamic (DeviceCmds(pVkDestroySemaphore))
import Vulkan.Core10.Handles (Device_T)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_metal_objects (ExportMetalObjectCreateInfoEXT)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_external_semaphore (ExportSemaphoreCreateInfo)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_external_semaphore_win32 (ExportSemaphoreWin32HandleInfoKHR)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_metal_objects (ImportMetalSharedEventInfoEXT)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_low_latency (QueryLowLatencySupportNV)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Handles (Semaphore)
import Vulkan.Core10.Handles (Semaphore(..))
import Vulkan.Core10.Enums.SemaphoreCreateFlags (SemaphoreCreateFlags)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore (SemaphoreTypeCreateInfo)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SEMAPHORE_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Handles (Semaphore(..))
import Vulkan.Core10.Enums.SemaphoreCreateFlags (SemaphoreCreateFlags(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateSemaphore
:: FunPtr (Ptr Device_T -> Ptr (SomeStruct SemaphoreCreateInfo) -> Ptr AllocationCallbacks -> Ptr Semaphore -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct SemaphoreCreateInfo) -> Ptr AllocationCallbacks -> Ptr Semaphore -> IO Result
createSemaphore :: forall a io
. (Extendss SemaphoreCreateInfo a, PokeChain a, MonadIO io)
=>
Device
->
(SemaphoreCreateInfo a)
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (Semaphore)
createSemaphore :: forall (a :: [*]) (io :: * -> *).
(Extendss SemaphoreCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> SemaphoreCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Semaphore
createSemaphore Device
device SemaphoreCreateInfo a
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkCreateSemaphorePtr :: FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result)
vkCreateSemaphorePtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result)
pVkCreateSemaphore (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result)
vkCreateSemaphorePtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCreateSemaphore is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkCreateSemaphore' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result
vkCreateSemaphore' = FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result
mkVkCreateSemaphore FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result)
vkCreateSemaphorePtr
Ptr (SemaphoreCreateInfo a)
pCreateInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SemaphoreCreateInfo a
createInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
"pSemaphore" ::: Ptr Semaphore
pPSemaphore <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Semaphore Int
8) forall a. Ptr a -> IO ()
free
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateSemaphore" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result
vkCreateSemaphore'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (SemaphoreCreateInfo a)
pCreateInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator
("pSemaphore" ::: Ptr Semaphore
pPSemaphore))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
Semaphore
pSemaphore <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Semaphore "pSemaphore" ::: Ptr Semaphore
pPSemaphore
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Semaphore
pSemaphore)
withSemaphore :: forall a io r . (Extendss SemaphoreCreateInfo a, PokeChain a, MonadIO io) => Device -> SemaphoreCreateInfo a -> Maybe AllocationCallbacks -> (io Semaphore -> (Semaphore -> io ()) -> r) -> r
withSemaphore :: forall (a :: [*]) (io :: * -> *) r.
(Extendss SemaphoreCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> SemaphoreCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io Semaphore -> (Semaphore -> io ()) -> r)
-> r
withSemaphore Device
device SemaphoreCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io Semaphore -> (Semaphore -> io ()) -> r
b =
io Semaphore -> (Semaphore -> io ()) -> r
b (forall (a :: [*]) (io :: * -> *).
(Extendss SemaphoreCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> SemaphoreCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Semaphore
createSemaphore Device
device SemaphoreCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(Semaphore
o0) -> forall (io :: * -> *).
MonadIO io =>
Device
-> Semaphore
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroySemaphore Device
device Semaphore
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroySemaphore
:: FunPtr (Ptr Device_T -> Semaphore -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> Semaphore -> Ptr AllocationCallbacks -> IO ()
destroySemaphore :: forall io
. (MonadIO io)
=>
Device
->
Semaphore
->
("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroySemaphore :: forall (io :: * -> *).
MonadIO io =>
Device
-> Semaphore
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroySemaphore Device
device Semaphore
semaphore "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkDestroySemaphorePtr :: FunPtr
(Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroySemaphorePtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
pVkDestroySemaphore (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroySemaphorePtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkDestroySemaphore is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkDestroySemaphore' :: Ptr Device_T
-> Semaphore -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroySemaphore' = FunPtr
(Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
-> Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroySemaphore FunPtr
(Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroySemaphorePtr
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkDestroySemaphore" (Ptr Device_T
-> Semaphore -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroySemaphore'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(Semaphore
semaphore)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()
data SemaphoreCreateInfo (es :: [Type]) = SemaphoreCreateInfo
{
forall (es :: [*]). SemaphoreCreateInfo es -> Chain es
next :: Chain es
,
forall (es :: [*]). SemaphoreCreateInfo es -> SemaphoreCreateFlags
flags :: SemaphoreCreateFlags
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SemaphoreCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (SemaphoreCreateInfo es)
instance Extensible SemaphoreCreateInfo where
extensibleTypeName :: String
extensibleTypeName = String
"SemaphoreCreateInfo"
setNext :: forall (ds :: [*]) (es :: [*]).
SemaphoreCreateInfo ds -> Chain es -> SemaphoreCreateInfo es
setNext SemaphoreCreateInfo{Chain ds
SemaphoreCreateFlags
flags :: SemaphoreCreateFlags
next :: Chain ds
$sel:flags:SemaphoreCreateInfo :: forall (es :: [*]). SemaphoreCreateInfo es -> SemaphoreCreateFlags
$sel:next:SemaphoreCreateInfo :: forall (es :: [*]). SemaphoreCreateInfo es -> Chain es
..} Chain es
next' = SemaphoreCreateInfo{$sel:next:SemaphoreCreateInfo :: Chain es
next = Chain es
next', SemaphoreCreateFlags
flags :: SemaphoreCreateFlags
$sel:flags:SemaphoreCreateInfo :: SemaphoreCreateFlags
..}
getNext :: forall (es :: [*]). SemaphoreCreateInfo es -> Chain es
getNext SemaphoreCreateInfo{Chain es
SemaphoreCreateFlags
flags :: SemaphoreCreateFlags
next :: Chain es
$sel:flags:SemaphoreCreateInfo :: forall (es :: [*]). SemaphoreCreateInfo es -> SemaphoreCreateFlags
$sel:next:SemaphoreCreateInfo :: forall (es :: [*]). SemaphoreCreateInfo es -> Chain es
..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends SemaphoreCreateInfo e => b) -> Maybe b
extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends SemaphoreCreateInfo e => b) -> Maybe b
extends proxy e
_ Extends SemaphoreCreateInfo e => b
f
| Just e :~: QueryLowLatencySupportNV
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @QueryLowLatencySupportNV = forall a. a -> Maybe a
Just Extends SemaphoreCreateInfo e => b
f
| Just e :~: ImportMetalSharedEventInfoEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ImportMetalSharedEventInfoEXT = forall a. a -> Maybe a
Just Extends SemaphoreCreateInfo e => b
f
| Just e :~: ExportMetalObjectCreateInfoEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportMetalObjectCreateInfoEXT = forall a. a -> Maybe a
Just Extends SemaphoreCreateInfo e => b
f
| Just e :~: SemaphoreTypeCreateInfo
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SemaphoreTypeCreateInfo = forall a. a -> Maybe a
Just Extends SemaphoreCreateInfo e => b
f
| Just e :~: ExportSemaphoreWin32HandleInfoKHR
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportSemaphoreWin32HandleInfoKHR = forall a. a -> Maybe a
Just Extends SemaphoreCreateInfo e => b
f
| Just e :~: ExportSemaphoreCreateInfo
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportSemaphoreCreateInfo = forall a. a -> Maybe a
Just Extends SemaphoreCreateInfo e => b
f
| Bool
otherwise = forall a. Maybe a
Nothing
instance ( Extendss SemaphoreCreateInfo es
, PokeChain es ) => ToCStruct (SemaphoreCreateInfo es) where
withCStruct :: forall b.
SemaphoreCreateInfo es
-> (Ptr (SemaphoreCreateInfo es) -> IO b) -> IO b
withCStruct SemaphoreCreateInfo es
x Ptr (SemaphoreCreateInfo es) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr (SemaphoreCreateInfo es)
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (SemaphoreCreateInfo es)
p SemaphoreCreateInfo es
x (Ptr (SemaphoreCreateInfo es) -> IO b
f Ptr (SemaphoreCreateInfo es)
p)
pokeCStruct :: forall b.
Ptr (SemaphoreCreateInfo es)
-> SemaphoreCreateInfo es -> IO b -> IO b
pokeCStruct Ptr (SemaphoreCreateInfo es)
p SemaphoreCreateInfo{Chain es
SemaphoreCreateFlags
flags :: SemaphoreCreateFlags
next :: Chain es
$sel:flags:SemaphoreCreateInfo :: forall (es :: [*]). SemaphoreCreateInfo es -> SemaphoreCreateFlags
$sel:next:SemaphoreCreateInfo :: forall (es :: [*]). SemaphoreCreateInfo es -> Chain es
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SEMAPHORE_CREATE_INFO)
Ptr ()
pNext'' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SemaphoreCreateFlags)) (SemaphoreCreateFlags
flags)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr (SemaphoreCreateInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (SemaphoreCreateInfo es)
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SEMAPHORE_CREATE_INFO)
Ptr ()
pNext' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
instance ( Extendss SemaphoreCreateInfo es
, PeekChain es ) => FromCStruct (SemaphoreCreateInfo es) where
peekCStruct :: Ptr (SemaphoreCreateInfo es) -> IO (SemaphoreCreateInfo es)
peekCStruct Ptr (SemaphoreCreateInfo es)
p = do
Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (SemaphoreCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
Chain es
next <- forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
SemaphoreCreateFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @SemaphoreCreateFlags ((Ptr (SemaphoreCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SemaphoreCreateFlags))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (es :: [*]).
Chain es -> SemaphoreCreateFlags -> SemaphoreCreateInfo es
SemaphoreCreateInfo
Chain es
next SemaphoreCreateFlags
flags
instance es ~ '[] => Zero (SemaphoreCreateInfo es) where
zero :: SemaphoreCreateInfo es
zero = forall (es :: [*]).
Chain es -> SemaphoreCreateFlags -> SemaphoreCreateInfo es
SemaphoreCreateInfo
()
forall a. Zero a => a
zero