{-# OPTIONS_GHC -fno-warn-missing-methods #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
module Graphics.Vulkan.Marshal
( FlagType (..), FlagMask, FlagBit
, VulkanMarshal (..), VulkanMarshalPrim ()
, VulkanPtr (..)
, VkPtr (..)
, pattern VK_NULL_HANDLE, pattern VK_NULL
, clearStorable, withPtr
, HasField (..), CanReadField (..), CanWriteField (..)
, CanReadFieldArray (..), CanWriteFieldArray (..)
, IsFieldArray, IndexInBounds
, mallocForeignPtr, withForeignPtr, addForeignPtrFinalizer
, Int8, Int16, Int32, Int64
, Word8, Word16, Word32, Word64
, Ptr, FunPtr, Void, CString
, CInt (..), CSize (..), CChar (..), CWchar (..), CULong (..)
, withCStringField, unsafeCStringField
, getStringField, readStringField, writeStringField
, cmpCStrings, cmpCStringsN
) where
import Data.Data (Data)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Kind (Constraint, Type)
import Data.Void (Void)
import Data.Word (Word16, Word32, Word64,
Word8)
import Foreign.C.String (CString, peekCString)
import Foreign.C.Types (CChar (..), CWchar (..), CInt (..), CSize (..), CULong (..))
import Foreign.ForeignPtr (ForeignPtr,
addForeignPtrFinalizer,
mallocForeignPtr,
withForeignPtr)
import Foreign.Marshal.Array (pokeArray0)
import Foreign.Marshal.Utils (fillBytes)
import Foreign.Ptr (FunPtr, nullPtr, plusPtr)
import Foreign.Storable (Storable (sizeOf))
import GHC.Generics (Generic)
import GHC.Ptr (Ptr (..))
import GHC.TypeLits
import System.IO.Unsafe (unsafeDupablePerformIO)
import Graphics.Vulkan.Marshal.Internal
data FlagType = FlagMask | FlagBit
type FlagMask = 'FlagMask
type FlagBit = 'FlagBit
class VulkanMarshal a where
type StructFields a :: [Symbol]
type CUnionType a :: Bool
type ReturnedOnly a :: Bool
type StructExtends a :: [Type]
newVkData :: (Ptr a -> IO ()) -> IO a
default newVkData :: (Storable a, VulkanMarshalPrim a)
=> (Ptr a -> IO ()) -> IO a
newVkData = (Ptr a -> IO ()) -> IO a
forall a.
(Storable a, VulkanMarshalPrim a) =>
(Ptr a -> IO ()) -> IO a
newVkData#
{-# INLINE newVkData #-}
mallocVkData :: IO a
default mallocVkData :: (Storable a, VulkanMarshalPrim a) => IO a
mallocVkData = IO a
forall a. (Storable a, VulkanMarshalPrim a) => IO a
mallocVkData#
{-# INLINE mallocVkData #-}
mallocVkDataArray :: Int -> IO (Ptr a, [a])
default mallocVkDataArray :: (Storable a, VulkanMarshalPrim a)
=> Int -> IO (Ptr a, [a])
mallocVkDataArray = Int -> IO (Ptr a, [a])
forall a.
(Storable a, VulkanMarshalPrim a) =>
Int -> IO (Ptr a, [a])
mallocVkDataArray#
{-# INLINE mallocVkDataArray #-}
unsafePtr :: a -> Ptr a
default unsafePtr :: VulkanMarshalPrim a => a -> Ptr a
unsafePtr a
a = Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr (a -> Addr#
forall a. VulkanMarshalPrim a => a -> Addr#
unsafeAddr a
a)
{-# INLINE unsafePtr #-}
fromForeignPtr :: ForeignPtr a -> IO a
default fromForeignPtr :: (Storable a, VulkanMarshalPrim a)
=> ForeignPtr a -> IO a
fromForeignPtr = ForeignPtr a -> IO a
forall a. (Storable a, VulkanMarshalPrim a) => ForeignPtr a -> IO a
fromForeignPtr#
{-# INLINE fromForeignPtr #-}
toForeignPtr :: a -> IO (ForeignPtr a)
default toForeignPtr :: VulkanMarshalPrim a => a -> IO (ForeignPtr a)
toForeignPtr = a -> IO (ForeignPtr a)
forall a. VulkanMarshalPrim a => a -> IO (ForeignPtr a)
toForeignPtr#
{-# INLINE toForeignPtr #-}
toPlainForeignPtr :: a -> IO (ForeignPtr a)
default toPlainForeignPtr :: VulkanMarshalPrim a => a -> IO (ForeignPtr a)
toPlainForeignPtr = a -> IO (ForeignPtr a)
forall a. VulkanMarshalPrim a => a -> IO (ForeignPtr a)
toPlainForeignPtr#
{-# INLINE toPlainForeignPtr #-}
touchVkData :: a -> IO ()
default touchVkData :: VulkanMarshalPrim a => a -> IO ()
touchVkData = a -> IO ()
forall a. VulkanMarshalPrim a => a -> IO ()
touchVkData#
{-# INLINE touchVkData #-}
withPtr :: VulkanMarshal a => a -> (Ptr a -> IO b) -> IO b
withPtr :: a -> (Ptr a -> IO b) -> IO b
withPtr a
x Ptr a -> IO b
k = do
b
b <- Ptr a -> IO b
k (a -> Ptr a
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr a
x)
a -> IO ()
forall a. VulkanMarshal a => a -> IO ()
touchVkData a
x
b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
clearStorable :: Storable a => Ptr a -> IO ()
clearStorable :: Ptr a -> IO ()
clearStorable Ptr a
p = Ptr a -> Word8 -> Int -> IO ()
forall a. Ptr a -> Word8 -> Int -> IO ()
fillBytes Ptr a
p Word8
0 (a -> Int
forall a. Storable a => a -> Int
sizeOf (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ Ptr a -> a
forall b. Ptr b -> b
unptr Ptr a
p)
where
unptr :: Ptr b -> b
unptr :: Ptr b -> b
unptr ~Ptr b
_ = b
forall a. HasCallStack => a
undefined
newtype VkPtr a = VkPtr Word64
deriving (VkPtr a -> VkPtr a -> Bool
(VkPtr a -> VkPtr a -> Bool)
-> (VkPtr a -> VkPtr a -> Bool) -> Eq (VkPtr a)
forall a. VkPtr a -> VkPtr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VkPtr a -> VkPtr a -> Bool
$c/= :: forall a. VkPtr a -> VkPtr a -> Bool
== :: VkPtr a -> VkPtr a -> Bool
$c== :: forall a. VkPtr a -> VkPtr a -> Bool
Eq, Eq (VkPtr a)
Eq (VkPtr a)
-> (VkPtr a -> VkPtr a -> Ordering)
-> (VkPtr a -> VkPtr a -> Bool)
-> (VkPtr a -> VkPtr a -> Bool)
-> (VkPtr a -> VkPtr a -> Bool)
-> (VkPtr a -> VkPtr a -> Bool)
-> (VkPtr a -> VkPtr a -> VkPtr a)
-> (VkPtr a -> VkPtr a -> VkPtr a)
-> Ord (VkPtr a)
VkPtr a -> VkPtr a -> Bool
VkPtr a -> VkPtr a -> Ordering
VkPtr a -> VkPtr a -> VkPtr a
forall a. Eq (VkPtr a)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. VkPtr a -> VkPtr a -> Bool
forall a. VkPtr a -> VkPtr a -> Ordering
forall a. VkPtr a -> VkPtr a -> VkPtr a
min :: VkPtr a -> VkPtr a -> VkPtr a
$cmin :: forall a. VkPtr a -> VkPtr a -> VkPtr a
max :: VkPtr a -> VkPtr a -> VkPtr a
$cmax :: forall a. VkPtr a -> VkPtr a -> VkPtr a
>= :: VkPtr a -> VkPtr a -> Bool
$c>= :: forall a. VkPtr a -> VkPtr a -> Bool
> :: VkPtr a -> VkPtr a -> Bool
$c> :: forall a. VkPtr a -> VkPtr a -> Bool
<= :: VkPtr a -> VkPtr a -> Bool
$c<= :: forall a. VkPtr a -> VkPtr a -> Bool
< :: VkPtr a -> VkPtr a -> Bool
$c< :: forall a. VkPtr a -> VkPtr a -> Bool
compare :: VkPtr a -> VkPtr a -> Ordering
$ccompare :: forall a. VkPtr a -> VkPtr a -> Ordering
$cp1Ord :: forall a. Eq (VkPtr a)
Ord, Int -> VkPtr a -> ShowS
[VkPtr a] -> ShowS
VkPtr a -> String
(Int -> VkPtr a -> ShowS)
-> (VkPtr a -> String) -> ([VkPtr a] -> ShowS) -> Show (VkPtr a)
forall a. Int -> VkPtr a -> ShowS
forall a. [VkPtr a] -> ShowS
forall a. VkPtr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VkPtr a] -> ShowS
$cshowList :: forall a. [VkPtr a] -> ShowS
show :: VkPtr a -> String
$cshow :: forall a. VkPtr a -> String
showsPrec :: Int -> VkPtr a -> ShowS
$cshowsPrec :: forall a. Int -> VkPtr a -> ShowS
Show, Ptr b -> Int -> IO (VkPtr a)
Ptr b -> Int -> VkPtr a -> IO ()
Ptr (VkPtr a) -> IO (VkPtr a)
Ptr (VkPtr a) -> Int -> IO (VkPtr a)
Ptr (VkPtr a) -> Int -> VkPtr a -> IO ()
Ptr (VkPtr a) -> VkPtr a -> IO ()
VkPtr a -> Int
(VkPtr a -> Int)
-> (VkPtr a -> Int)
-> (Ptr (VkPtr a) -> Int -> IO (VkPtr a))
-> (Ptr (VkPtr a) -> Int -> VkPtr a -> IO ())
-> (forall b. Ptr b -> Int -> IO (VkPtr a))
-> (forall b. Ptr b -> Int -> VkPtr a -> IO ())
-> (Ptr (VkPtr a) -> IO (VkPtr a))
-> (Ptr (VkPtr a) -> VkPtr a -> IO ())
-> Storable (VkPtr a)
forall b. Ptr b -> Int -> IO (VkPtr a)
forall b. Ptr b -> Int -> VkPtr a -> IO ()
forall a. Ptr (VkPtr a) -> IO (VkPtr a)
forall a. Ptr (VkPtr a) -> Int -> IO (VkPtr a)
forall a. Ptr (VkPtr a) -> Int -> VkPtr a -> IO ()
forall a. Ptr (VkPtr a) -> VkPtr a -> IO ()
forall a. VkPtr a -> Int
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall a b. Ptr b -> Int -> IO (VkPtr a)
forall a b. Ptr b -> Int -> VkPtr a -> IO ()
poke :: Ptr (VkPtr a) -> VkPtr a -> IO ()
$cpoke :: forall a. Ptr (VkPtr a) -> VkPtr a -> IO ()
peek :: Ptr (VkPtr a) -> IO (VkPtr a)
$cpeek :: forall a. Ptr (VkPtr a) -> IO (VkPtr a)
pokeByteOff :: Ptr b -> Int -> VkPtr a -> IO ()
$cpokeByteOff :: forall a b. Ptr b -> Int -> VkPtr a -> IO ()
peekByteOff :: Ptr b -> Int -> IO (VkPtr a)
$cpeekByteOff :: forall a b. Ptr b -> Int -> IO (VkPtr a)
pokeElemOff :: Ptr (VkPtr a) -> Int -> VkPtr a -> IO ()
$cpokeElemOff :: forall a. Ptr (VkPtr a) -> Int -> VkPtr a -> IO ()
peekElemOff :: Ptr (VkPtr a) -> Int -> IO (VkPtr a)
$cpeekElemOff :: forall a. Ptr (VkPtr a) -> Int -> IO (VkPtr a)
alignment :: VkPtr a -> Int
$calignment :: forall a. VkPtr a -> Int
sizeOf :: VkPtr a -> Int
$csizeOf :: forall a. VkPtr a -> Int
Storable, (forall x. VkPtr a -> Rep (VkPtr a) x)
-> (forall x. Rep (VkPtr a) x -> VkPtr a) -> Generic (VkPtr a)
forall x. Rep (VkPtr a) x -> VkPtr a
forall x. VkPtr a -> Rep (VkPtr a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (VkPtr a) x -> VkPtr a
forall a x. VkPtr a -> Rep (VkPtr a) x
$cto :: forall a x. Rep (VkPtr a) x -> VkPtr a
$cfrom :: forall a x. VkPtr a -> Rep (VkPtr a) x
Generic, Typeable (VkPtr a)
DataType
Constr
Typeable (VkPtr a)
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VkPtr a -> c (VkPtr a))
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (VkPtr a))
-> (VkPtr a -> Constr)
-> (VkPtr a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (VkPtr a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (VkPtr a)))
-> ((forall b. Data b => b -> b) -> VkPtr a -> VkPtr a)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VkPtr a -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VkPtr a -> r)
-> (forall u. (forall d. Data d => d -> u) -> VkPtr a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> VkPtr a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VkPtr a -> m (VkPtr a))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VkPtr a -> m (VkPtr a))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VkPtr a -> m (VkPtr a))
-> Data (VkPtr a)
VkPtr a -> DataType
VkPtr a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (VkPtr a))
(forall b. Data b => b -> b) -> VkPtr a -> VkPtr a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VkPtr a -> c (VkPtr a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (VkPtr a)
forall a. Data a => Typeable (VkPtr a)
forall a. Data a => VkPtr a -> DataType
forall a. Data a => VkPtr a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> VkPtr a -> VkPtr a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> VkPtr a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> VkPtr a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VkPtr a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VkPtr a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> VkPtr a -> m (VkPtr a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> VkPtr a -> m (VkPtr a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (VkPtr a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VkPtr a -> c (VkPtr a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (VkPtr a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (VkPtr a))
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> VkPtr a -> u
forall u. (forall d. Data d => d -> u) -> VkPtr a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VkPtr a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VkPtr a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VkPtr a -> m (VkPtr a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VkPtr a -> m (VkPtr a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (VkPtr a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VkPtr a -> c (VkPtr a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (VkPtr a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (VkPtr a))
$cVkPtr :: Constr
$tVkPtr :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> VkPtr a -> m (VkPtr a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> VkPtr a -> m (VkPtr a)
gmapMp :: (forall d. Data d => d -> m d) -> VkPtr a -> m (VkPtr a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> VkPtr a -> m (VkPtr a)
gmapM :: (forall d. Data d => d -> m d) -> VkPtr a -> m (VkPtr a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> VkPtr a -> m (VkPtr a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> VkPtr a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> VkPtr a -> u
gmapQ :: (forall d. Data d => d -> u) -> VkPtr a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> VkPtr a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VkPtr a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VkPtr a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VkPtr a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VkPtr a -> r
gmapT :: (forall b. Data b => b -> b) -> VkPtr a -> VkPtr a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> VkPtr a -> VkPtr a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (VkPtr a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (VkPtr a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (VkPtr a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (VkPtr a))
dataTypeOf :: VkPtr a -> DataType
$cdataTypeOf :: forall a. Data a => VkPtr a -> DataType
toConstr :: VkPtr a -> Constr
$ctoConstr :: forall a. Data a => VkPtr a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (VkPtr a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (VkPtr a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VkPtr a -> c (VkPtr a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VkPtr a -> c (VkPtr a)
$cp1Data :: forall a. Data a => Typeable (VkPtr a)
Data)
type role VkPtr phantom
class VulkanPtr ptr where
vkNullPtr :: ptr a
instance VulkanPtr Ptr where
vkNullPtr :: Ptr a
vkNullPtr = Ptr a
forall a. Ptr a
nullPtr
{-# INLINE vkNullPtr #-}
instance VulkanPtr VkPtr where
vkNullPtr :: VkPtr a
vkNullPtr = Word64 -> VkPtr a
forall a. Word64 -> VkPtr a
VkPtr Word64
0
{-# INLINE vkNullPtr #-}
isNullPtr :: (Eq (ptr a), VulkanPtr ptr) => ptr a -> Bool
isNullPtr :: ptr a -> Bool
isNullPtr = (ptr a
forall (ptr :: * -> *) a. VulkanPtr ptr => ptr a
vkNullPtr ptr a -> ptr a -> Bool
forall a. Eq a => a -> a -> Bool
==)
{-# INLINE isNullPtr #-}
pattern VK_NULL :: (Eq (ptr a), VulkanPtr ptr) => ptr a
pattern $bVK_NULL :: ptr a
$mVK_NULL :: forall r (ptr :: * -> *) a.
(Eq (ptr a), VulkanPtr ptr) =>
ptr a -> (Void# -> r) -> (Void# -> r) -> r
VK_NULL <- (isNullPtr -> True)
where VK_NULL = ptr a
forall (ptr :: * -> *) a. VulkanPtr ptr => ptr a
vkNullPtr
pattern VK_NULL_HANDLE :: (Eq (ptr a), VulkanPtr ptr) => ptr a
pattern $bVK_NULL_HANDLE :: ptr a
$mVK_NULL_HANDLE :: forall r (ptr :: * -> *) a.
(Eq (ptr a), VulkanPtr ptr) =>
ptr a -> (Void# -> r) -> (Void# -> r) -> r
VK_NULL_HANDLE = VK_NULL
class HasField (fname :: Symbol) (a :: Type) where
type FieldType fname a :: Type
type FieldOptional fname a :: Bool
type FieldOffset fname a :: Nat
type FieldIsArray fname a :: Bool
fieldOptional :: Bool
fieldOffset :: Int
class ( HasField fname a
, IsFieldArray fname a 'False
) => CanReadField (fname :: Symbol) (a :: Type) where
getField :: a -> FieldType fname a
readField :: Ptr a -> IO (FieldType fname a)
class CanReadField fname a => CanWriteField (fname :: Symbol) (a :: Type) where
writeField :: Ptr a -> FieldType fname a -> IO ()
class ( HasField fname a
, IndexInBounds fname idx a
, IsFieldArray fname a 'True
) => CanReadFieldArray (fname :: Symbol) (idx :: Nat) (a :: Type) where
type FieldArrayLength fname a :: Nat
fieldArrayLength :: Int
getFieldArray :: a -> FieldType fname a
readFieldArray :: Ptr a -> IO (FieldType fname a)
class CanReadFieldArray fname idx a
=> CanWriteFieldArray (fname :: Symbol) (idx :: Nat) (a :: Type) where
writeFieldArray :: Ptr a -> FieldType fname a -> IO ()
instance {-# OVERLAPPABLE #-}
TypeError (ErrorNoSuchField fname a) => HasField fname a where
instance {-# OVERLAPPABLE #-}
( HasField fname a
, IsFieldArray fname a 'False
, TypeError (ErrorNotReadableField fname a)
) => CanReadField fname a where
instance {-# OVERLAPPABLE #-}
( CanReadField fname a
, TypeError (ErrorNotWritableField fname a)
) => CanWriteField fname a where
instance {-# OVERLAPPABLE #-}
( HasField fname a
, IsFieldArray fname a 'True
, IndexInBounds fname idx a
, TypeError (ErrorNotReadableField fname a)
) => CanReadFieldArray fname idx a where
instance {-# OVERLAPPABLE #-}
( CanReadFieldArray fname idx a
, TypeError (ErrorNotWritableField fname a)
) => CanWriteFieldArray fname idx a where
type IndexInBounds (s :: Symbol) (i :: Nat) (a :: Type)
= IndexInBounds' s i a (CmpNat i (FieldArrayLength s a))
type family IndexInBounds' (s :: Symbol)
(i :: Nat)
(a :: Type) (r :: Ordering) :: Constraint where
IndexInBounds' _ _ _ 'LT = ()
IndexInBounds' s i a _ = TypeError ( ErrorIndexOutOfBounds s i a )
type IsFieldArray s a e = IsFieldArray' s a (FieldIsArray s a) e
type family IsFieldArray' (s :: Symbol)
(a :: Type)
(actual :: Bool)
(expected :: Bool) :: Constraint where
IsFieldArray' _ _ 'True 'True = ()
IsFieldArray' _ _ 'False 'False = ()
IsFieldArray' s a 'True 'False = TypeError (ErrorIsArrayField s a)
IsFieldArray' s a 'False 'True = TypeError (ErrorIsNotArrayField s a)
type ErrorNoSuchField (s :: Symbol) (a :: Type)
= 'Text "Structure " ':<>: 'ShowType a
':<>: 'Text " does not have field " ':<>: 'ShowType s ':<>: 'Text "."
':$$: 'Text "Note, this structure has following fields: "
':<>: 'ShowType (StructFields a)
type ErrorIsNotArrayField (s :: Symbol) (a :: Type)
= 'Text "Field " ':<>: 'ShowType s ':<>:
'Text " of structure " ':<>: 'ShowType a ':<>:
'Text " is not an array field."
':$$: 'Text "Don't use ***FieldArray functions on it."
type ErrorIsArrayField (s :: Symbol) (a :: Type)
= 'Text "Field " ':<>: 'ShowType s ':<>:
'Text " of structure " ':<>: 'ShowType a ':<>:
'Text " is an array field."
':$$: 'Text "Use ***FieldArray functions on it."
type ErrorIndexOutOfBounds (s :: Symbol) (i :: Nat) (a :: Type)
= 'Text "Array index " ':<>: 'ShowType i ':<>:
'Text " is out of bounds for '" ':<>:
'Text s ':<>: 'Text "', member of type " ':<>: 'ShowType a ':<>: 'Text "."
':$$:
'Text "Note: the array size is "
':<>: 'ShowType (FieldArrayLength s a) ':<>: 'Text "."
type ErrorNotReadableField (s :: Symbol) (a :: Type)
= 'Text "Field " ':<>: 'ShowType s ':<>:
'Text " of structure " ':<>: 'ShowType a ':<>:
'Text " is not readable."
type ErrorNotWritableField (s :: Symbol) (a :: Type)
= 'Text "Field " ':<>: 'ShowType s ':<>:
'Text " of structure " ':<>: 'ShowType a ':<>:
'Text " is not writable."
withCStringField :: forall fname a b
. ( CanReadFieldArray fname 0 a
, FieldType fname a ~ CChar
, VulkanMarshal a
)
=> a -> (CString -> IO b) -> IO b
withCStringField :: a -> (CString -> IO b) -> IO b
withCStringField a
x CString -> IO b
f = do
b
r <- CString -> IO b
f (a -> CString
forall (fname :: Symbol) a.
(CanReadFieldArray fname 0 a, FieldType fname a ~ CChar,
VulkanMarshal a) =>
a -> CString
unsafeCStringField @fname @a a
x)
a -> IO ()
forall a. VulkanMarshal a => a -> IO ()
touchVkData a
x
b -> IO b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
r
unsafeCStringField :: forall fname a
. ( CanReadFieldArray fname 0 a
, FieldType fname a ~ CChar
, VulkanMarshal a
)
=> a -> CString
unsafeCStringField :: a -> CString
unsafeCStringField a
x = a -> Ptr a
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr a
x Ptr a -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` HasField fname a => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @fname @a
getStringField :: forall fname a
. ( CanReadFieldArray fname 0 a
, FieldType fname a ~ CChar
, VulkanMarshal a
)
=> a -> String
getStringField :: a -> String
getStringField a
x
= case Int -> String -> ((), String)
takeForce (CanReadFieldArray fname 0 a => Int
forall (fname :: Symbol) (idx :: Nat) a.
CanReadFieldArray fname idx a =>
Int
fieldArrayLength @fname @0 @a)
(String -> ((), String))
-> (IO String -> String) -> IO String -> ((), String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO String -> String
forall a. IO a -> a
unsafeDupablePerformIO
(IO String -> ((), String)) -> IO String -> ((), String)
forall a b. (a -> b) -> a -> b
$ a -> (CString -> IO String) -> IO String
forall (fname :: Symbol) a b.
(CanReadFieldArray fname 0 a, FieldType fname a ~ CChar,
VulkanMarshal a) =>
a -> (CString -> IO b) -> IO b
withCStringField @fname @a a
x CString -> IO String
peekCString of
((), String
s) -> String
s
readStringField :: forall fname a
. ( CanReadFieldArray fname 0 a
, FieldType fname a ~ CChar
, VulkanMarshal a
)
=> Ptr a -> IO String
readStringField :: Ptr a -> IO String
readStringField Ptr a
px = do
((), String
s) <- Int -> String -> ((), String)
takeForce (CanReadFieldArray fname 0 a => Int
forall (fname :: Symbol) (idx :: Nat) a.
CanReadFieldArray fname idx a =>
Int
fieldArrayLength @fname @0 @a)
(String -> ((), String)) -> IO String -> IO ((), String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO String
peekCString (Ptr a
px Ptr a -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` HasField fname a => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @fname @a)
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
writeStringField :: forall fname a
. ( CanWriteFieldArray fname 0 a
, FieldType fname a ~ CChar
, VulkanMarshal a
)
=> Ptr a -> String -> IO ()
writeStringField :: Ptr a -> String -> IO ()
writeStringField Ptr a
px =
Char -> Ptr Char -> String -> IO ()
forall a. Storable a => a -> Ptr a -> [a] -> IO ()
pokeArray0 Char
'\0' (Ptr a
px Ptr a -> Int -> Ptr Char
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` HasField fname a => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @fname @a)
takeForce :: Int -> String -> ((), String)
takeForce :: Int -> String -> ((), String)
takeForce Int
0 String
_ = ((), [])
takeForce Int
_ [] = ((), [])
takeForce Int
n (Char
x:String
xs) = Char -> ((), String) -> ((), String)
seq Char
x (((), String) -> ((), String)) -> ((), String) -> ((), String)
forall a b. (a -> b) -> a -> b
$ (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ((), String) -> ((), String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> String -> ((), String)
takeForce (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
xs
cmpCStrings :: CString -> CString -> Ordering
cmpCStrings :: CString -> CString -> Ordering
cmpCStrings CString
a CString
b
| CString
a CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
b = Ordering
EQ
| Bool
otherwise = CString -> CString -> CInt
c_strcmp CString
a CString
b CInt -> CInt -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CInt
0
cmpCStringsN :: CString -> CString -> Int -> Ordering
cmpCStringsN :: CString -> CString -> Int -> Ordering
cmpCStringsN CString
a CString
b Int
n
| CString
a CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
b = Ordering
EQ
| Bool
otherwise = CString -> CString -> CSize -> CInt
c_strncmp CString
a CString
b (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) CInt -> CInt -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CInt
0
foreign import ccall unsafe "strncmp"
c_strncmp :: CString -> CString -> CSize -> CInt
foreign import ccall unsafe "strcmp"
c_strcmp :: CString -> CString -> CInt