{-# 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 = IO Semaphore -> io Semaphore
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Semaphore -> io Semaphore)
-> (ContT Semaphore IO Semaphore -> IO Semaphore)
-> ContT Semaphore IO Semaphore
-> io Semaphore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Semaphore IO Semaphore -> IO Semaphore
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Semaphore IO Semaphore -> io Semaphore)
-> ContT Semaphore IO Semaphore -> io Semaphore
forall a b. (a -> b) -> a -> b
$ do
let vkCreateSemaphorePtr :: FunPtr
(Ptr Device_T
-> Ptr (SomeStruct SemaphoreCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr Semaphore
-> IO Result)
vkCreateSemaphorePtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> Ptr (SomeStruct SemaphoreCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr Semaphore
-> IO Result)
pVkCreateSemaphore (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
IO () -> ContT Semaphore IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT Semaphore m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Semaphore IO ()) -> IO () -> ContT Semaphore 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 SemaphoreCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr Semaphore
-> IO Result)
vkCreateSemaphorePtr FunPtr
(Ptr Device_T
-> Ptr (SomeStruct SemaphoreCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr Semaphore
-> IO Result)
-> FunPtr
(Ptr Device_T
-> Ptr (SomeStruct SemaphoreCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr Semaphore
-> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> Ptr (SomeStruct SemaphoreCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr Semaphore
-> 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 vkCreateSemaphore is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkCreateSemaphore' :: Ptr Device_T
-> Ptr (SomeStruct SemaphoreCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr Semaphore
-> IO Result
vkCreateSemaphore' = 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
mkVkCreateSemaphore FunPtr
(Ptr Device_T
-> Ptr (SomeStruct SemaphoreCreateInfo)
-> Ptr AllocationCallbacks
-> Ptr Semaphore
-> IO Result)
vkCreateSemaphorePtr
pCreateInfo <- ((Ptr (SemaphoreCreateInfo a) -> IO Semaphore) -> IO Semaphore)
-> ContT Semaphore IO (Ptr (SemaphoreCreateInfo a))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (SemaphoreCreateInfo a) -> IO Semaphore) -> IO Semaphore)
-> ContT Semaphore IO (Ptr (SemaphoreCreateInfo a)))
-> ((Ptr (SemaphoreCreateInfo a) -> IO Semaphore) -> IO Semaphore)
-> ContT Semaphore IO (Ptr (SemaphoreCreateInfo a))
forall a b. (a -> b) -> a -> b
$ SemaphoreCreateInfo a
-> (Ptr (SemaphoreCreateInfo a) -> IO Semaphore) -> IO Semaphore
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
SemaphoreCreateInfo a
-> (Ptr (SemaphoreCreateInfo a) -> IO b) -> IO b
withCStruct (SemaphoreCreateInfo a
createInfo)
pAllocator <- case (allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> Ptr AllocationCallbacks
-> ContT Semaphore IO (Ptr AllocationCallbacks)
forall a. a -> ContT Semaphore IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> ((Ptr AllocationCallbacks -> IO Semaphore) -> IO Semaphore)
-> ContT Semaphore IO (Ptr AllocationCallbacks)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCallbacks -> IO Semaphore) -> IO Semaphore)
-> ContT Semaphore IO (Ptr AllocationCallbacks))
-> ((Ptr AllocationCallbacks -> IO Semaphore) -> IO Semaphore)
-> ContT Semaphore IO (Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (Ptr AllocationCallbacks -> IO Semaphore) -> IO Semaphore
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
AllocationCallbacks -> (Ptr AllocationCallbacks -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
pPSemaphore <- ContT $ bracket (callocBytes @Semaphore 8) free
r <- lift $ traceAroundEvent "vkCreateSemaphore" (vkCreateSemaphore'
(deviceHandle (device))
(forgetExtensions pCreateInfo)
pAllocator
(pPSemaphore))
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pSemaphore <- lift $ peek @Semaphore pPSemaphore
pure $ (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 (Device
-> SemaphoreCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Semaphore
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) -> Device
-> Semaphore
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
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 = 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 vkDestroySemaphorePtr :: FunPtr
(Ptr Device_T -> Semaphore -> Ptr AllocationCallbacks -> IO ())
vkDestroySemaphorePtr = DeviceCmds
-> FunPtr
(Ptr Device_T -> Semaphore -> Ptr AllocationCallbacks -> IO ())
pVkDestroySemaphore (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 -> Semaphore -> Ptr AllocationCallbacks -> IO ())
vkDestroySemaphorePtr FunPtr
(Ptr Device_T -> Semaphore -> Ptr AllocationCallbacks -> IO ())
-> FunPtr
(Ptr Device_T -> Semaphore -> Ptr AllocationCallbacks -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T -> Semaphore -> 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 vkDestroySemaphore is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkDestroySemaphore' :: Ptr Device_T -> Semaphore -> Ptr AllocationCallbacks -> IO ()
vkDestroySemaphore' = FunPtr
(Ptr Device_T -> Semaphore -> Ptr AllocationCallbacks -> IO ())
-> Ptr Device_T -> Semaphore -> Ptr AllocationCallbacks -> IO ()
mkVkDestroySemaphore FunPtr
(Ptr Device_T -> Semaphore -> Ptr AllocationCallbacks -> IO ())
vkDestroySemaphorePtr
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 "vkDestroySemaphore" (vkDestroySemaphore'
(deviceHandle (device))
(semaphore)
pAllocator)
pure $ ()
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{SemaphoreCreateFlags
Chain ds
next :: forall (es :: [*]). SemaphoreCreateInfo es -> Chain es
flags :: forall (es :: [*]). SemaphoreCreateInfo es -> SemaphoreCreateFlags
next :: Chain ds
flags :: SemaphoreCreateFlags
..} Chain es
next' = SemaphoreCreateInfo{next :: Chain es
next = Chain es
next', SemaphoreCreateFlags
flags :: SemaphoreCreateFlags
flags :: SemaphoreCreateFlags
..}
getNext :: forall (es :: [*]). SemaphoreCreateInfo es -> Chain es
getNext SemaphoreCreateInfo{SemaphoreCreateFlags
Chain es
next :: forall (es :: [*]). SemaphoreCreateInfo es -> Chain es
flags :: forall (es :: [*]). SemaphoreCreateInfo es -> SemaphoreCreateFlags
next :: Chain es
flags :: SemaphoreCreateFlags
..} = 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)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @e @QueryLowLatencySupportNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SemaphoreCreateInfo e => b
f
| Just e :~: ImportMetalSharedEventInfoEXT
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 @ImportMetalSharedEventInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SemaphoreCreateInfo e => b
f
| Just e :~: ExportMetalObjectCreateInfoEXT
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 @ExportMetalObjectCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SemaphoreCreateInfo e => b
f
| Just e :~: SemaphoreTypeCreateInfo
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 @SemaphoreTypeCreateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SemaphoreCreateInfo e => b
f
| Just e :~: ExportSemaphoreWin32HandleInfoKHR
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 @ExportSemaphoreWin32HandleInfoKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SemaphoreCreateInfo e => b
f
| Just e :~: ExportSemaphoreCreateInfo
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 @ExportSemaphoreCreateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SemaphoreCreateInfo e => b
f
| Bool
otherwise = Maybe b
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 = Int -> (Ptr (SemaphoreCreateInfo es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr (SemaphoreCreateInfo es) -> IO b) -> IO b)
-> (Ptr (SemaphoreCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (SemaphoreCreateInfo es)
p -> Ptr (SemaphoreCreateInfo es)
-> SemaphoreCreateInfo es -> IO b -> IO b
forall b.
Ptr (SemaphoreCreateInfo es)
-> SemaphoreCreateInfo es -> IO b -> IO b
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{SemaphoreCreateFlags
Chain es
next :: forall (es :: [*]). SemaphoreCreateInfo es -> Chain es
flags :: forall (es :: [*]). SemaphoreCreateInfo es -> SemaphoreCreateFlags
next :: Chain es
flags :: SemaphoreCreateFlags
..} 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 (SemaphoreCreateInfo es)
p Ptr (SemaphoreCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SEMAPHORE_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 SemaphoreCreateFlags)) (flags)
lift $ 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 = 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 (SemaphoreCreateInfo es)
p Ptr (SemaphoreCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SEMAPHORE_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 SemaphoreCreateInfo es
, PeekChain es ) => FromCStruct (SemaphoreCreateInfo es) where
peekCStruct :: Ptr (SemaphoreCreateInfo es) -> IO (SemaphoreCreateInfo es)
peekCStruct Ptr (SemaphoreCreateInfo es)
p = do
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (SemaphoreCreateInfo es)
p Ptr (SemaphoreCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
next <- peekChain (castPtr pNext)
flags <- peek @SemaphoreCreateFlags ((p `plusPtr` 16 :: Ptr SemaphoreCreateFlags))
pure $ SemaphoreCreateInfo
next flags
instance es ~ '[] => Zero (SemaphoreCreateInfo es) where
zero :: SemaphoreCreateInfo es
zero = Chain es -> SemaphoreCreateFlags -> SemaphoreCreateInfo es
forall (es :: [*]).
Chain es -> SemaphoreCreateFlags -> SemaphoreCreateInfo es
SemaphoreCreateInfo
()
SemaphoreCreateFlags
forall a. Zero a => a
zero