{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RoleAnnotations            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE Strict                     #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE UndecidableSuperClasses    #-}
{-# LANGUAGE ViewPatterns               #-}
-- | This module is not part of auto-generated code based on vk.xml.
--   Instead, it is hand-written to provide common types and classes.
module Graphics.Vulkan.Marshal
  ( FlagType (..), FlagMask, FlagBit
  , bitToMask, maskToBits
  , VulkanMarshal (..)
  , newVkData, mallocVkData, mallocVkDataArray, unsafePtr
  , fromForeignPtr, toForeignPtr, toPlainForeignPtr, touchVkData
  , VulkanPtr (..)
  , VkPtr (..)
  , pattern VK_ZERO_FLAGS
  , pattern VK_NULL_HANDLE, pattern VK_NULL
  , clearStorable, withPtr
    -- * Type-indexed access to struct members
  , StructFields, CUnionType, ReturnedOnly, StructExtends
  , StructFieldNames, HasField, FieldRep, FieldType
  , FieldOptional, FieldOffset
  , FieldIsArray, FieldArrayLength
  , CanReadField, CanWriteField
  , CanReadFieldArray, CanWriteFieldArray
  , fieldOptional, fieldOffset, fieldArrayLength
  , getField, readField, writeField
  , getFieldArrayUnsafe, readFieldArrayUnsafe, writeFieldArrayUnsafe
  , getFieldArray, readFieldArray, writeFieldArray
  , IndexInBounds
    -- * Type-level info about Structs
  , VulkanStruct (..), VulkanField (..), VulkanFields (..), KnownBool (..)
  , FieldMeta (..), StructMeta (..)
    -- * Re-exported functions from 'Foreign.ForeignPtr'
  , mallocForeignPtr, withForeignPtr, addForeignPtrFinalizer
    -- * Re-exported common types
  , Int8, Int16, Int32, Int64
  , Word8, Word16, Word32, Word64
  , Ptr, FunPtr, Void, CString
  , CInt (..), CSize (..), CChar (..), CWchar (..), CULong (..)
    -- * Utilities for string types
  , withCStringField, unsafeCStringField
  , getStringField, readStringField, writeStringField
  , cmpCStrings, cmpCStringsN
  ) where

import Data.Bits             (Bits (..))
import Data.Coerce
import Data.Int              (Int16, Int32, Int64, Int8)
import Data.Void             (Void)
import Data.Word             (Word16, Word32, Word64, Word8)
import Foreign.C.String      (CString)
import Foreign.C.Types       (CChar (..), CInt (..), CSize (..), CULong (..),
                              CWchar (..))
import Foreign.ForeignPtr    (addForeignPtrFinalizer, mallocForeignPtr,
                              withForeignPtr)
import Foreign.Marshal.Utils (fillBytes)
import Foreign.Ptr           (FunPtr, nullPtr)
import Foreign.Storable
import GHC.Ptr               (Ptr (..))


import Graphics.Vulkan.Marshal.Internal


-- | Distinguish single bits and bitmasks in vulkan flags
data FlagType = FlagMask | FlagBit

-- | Vulkan flags type that can have multiple bits set.
type FlagMask = 'FlagMask
-- | Vulkan single bit flag value.
type FlagBit  = 'FlagBit

-- | A synonym for `zeroBits`
pattern VK_ZERO_FLAGS :: Bits a => a
pattern $bVK_ZERO_FLAGS :: forall a. Bits a => a
$mVK_ZERO_FLAGS :: forall {r} {a}. Bits a => a -> (Void# -> r) -> (Void# -> r) -> r
VK_ZERO_FLAGS <- (popCount -> 0)
  where
    VK_ZERO_FLAGS = a
forall a. Bits a => a
zeroBits

-- | Convert a single bit (@XxxBits@) to a bitmask (@XxxFlags@)
bitToMask :: Coercible (x FlagBit) (x FlagMask) => x FlagBit -> x FlagMask
bitToMask :: forall (x :: FlagType -> *).
Coercible (x FlagBit) (x FlagMask) =>
x FlagBit -> x FlagMask
bitToMask = x FlagBit -> x FlagMask
coerce

-- | List all set bits of a bitmask (@XxxFlags@) in the increasing order.
maskToBits :: (Bits (x FlagMask), Coercible (x FlagBit) (x FlagMask))
           => x FlagMask -> [x FlagBit]
maskToBits :: forall (x :: FlagType -> *).
(Bits (x FlagMask), Coercible (x FlagBit) (x FlagMask)) =>
x FlagMask -> [x FlagBit]
maskToBits x FlagMask
x = Int -> x FlagMask -> [x FlagBit]
go (x FlagMask -> Int
forall a. Bits a => a -> Int
popCount x FlagMask
x) (Int -> x FlagMask
forall a. Bits a => Int -> a
bit Int
0)
  where
    zero :: x FlagMask
zero = x FlagMask
forall a. Bits a => a
zeroBits
    go :: Int -> x FlagMask -> [x FlagBit]
go Int
0 x FlagMask
_ = []
    go Int
n x FlagMask
i = let b :: x FlagMask
b = x FlagMask
i x FlagMask -> x FlagMask -> x FlagMask
forall a. Bits a => a -> a -> a
.&. x FlagMask
x
                 i' :: x FlagMask
i' = x FlagMask -> Int -> x FlagMask
forall a. Bits a => a -> Int -> a
unsafeShiftL x FlagMask
i Int
1
             in if x FlagMask
b x FlagMask -> x FlagMask -> Bool
forall a. Eq a => a -> a -> Bool
== x FlagMask
zero
                then Int -> x FlagMask -> [x FlagBit]
go Int
n x FlagMask
i'
                else x FlagMask -> x FlagBit
coerce x FlagMask
b x FlagBit -> [x FlagBit] -> [x FlagBit]
forall a. a -> [a] -> [a]
: Int -> x FlagMask -> [x FlagBit]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) x FlagMask
i'


-- | ===== @VK_DEFINE_NON_DISPATCHABLE_HANDLE@
-- Non-dispatchable handles are represented as `VkPtr`
--
-- Represented as `Word64`
--
-- >
-- > #if !defined(VK_DEFINE_NON_DISPATCHABLE_HANDLE)
-- > #if defined(__LP64__) || defined(_WIN64) || (defined(__x86_64__) && !defined(__ILP32__) ) || defined(_M_X64) || defined(__ia64) || defined (_M_IA64) || defined(__aarch64__) || defined(__powerpc64__)
-- >         #define VK_DEFINE_NON_DISPATCHABLE_HANDLE(object) typedef struct object##_T *object;
-- > #else
-- >         #define VK_DEFINE_NON_DISPATCHABLE_HANDLE(object) typedef uint64_t object;
-- > #endif
-- > #endif
-- >
--
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
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 (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 :: forall b. Ptr b -> Int -> VkPtr a -> IO ()
$cpokeByteOff :: forall a b. Ptr b -> Int -> VkPtr a -> IO ()
peekByteOff :: forall b. 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)
type role VkPtr phantom


-- | Unify dispatchable and non-dispatchable vulkan pointer types.
--
--  Dispatchable handles are represented as `Ptr`.
--
--  Non-dispatchable handles are represented as `VkPtr`.
--
class VulkanPtr ptr where
  vkNullPtr :: ptr a

instance VulkanPtr Ptr where
  vkNullPtr :: forall a. Ptr a
vkNullPtr = Ptr a
forall a. Ptr a
nullPtr
  {-# INLINE vkNullPtr #-}

instance VulkanPtr VkPtr where
  vkNullPtr :: forall a. 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 :: forall (ptr :: * -> *) a.
(Eq (ptr a), VulkanPtr ptr) =>
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 #-}

-- | Null pointer (either dispatchable or non-dispatchable)
pattern VK_NULL :: (Eq (ptr a), VulkanPtr ptr) => ptr a
pattern $bVK_NULL :: forall (ptr :: * -> *) a. (Eq (ptr a), VulkanPtr ptr) => 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

-- | >
--   > #define VK_NULL_HANDLE 0
--   >
pattern VK_NULL_HANDLE :: (Eq (ptr a), VulkanPtr ptr) => ptr a
pattern $bVK_NULL_HANDLE :: forall (ptr :: * -> *) a. (Eq (ptr a), VulkanPtr ptr) => 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


-- | Run some operation with a pointer to vulkan structure.
--
--   Should be used with care:
--     the structure pretends to be immutable, so it is better to only read
--     from the pointed memory area, not to write.
--     If an action needs to write something to the pointer, use `newVkData`.
withPtr :: VulkanMarshal a => a -> (Ptr a -> IO b) -> IO b
withPtr :: forall a b. VulkanMarshal a => 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. IsVkStruct a => a -> Ptr a
unsafePtr a
x)
  a -> IO ()
forall a. IsVkStruct a => a -> IO ()
touchVkData a
x
  b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

-- | Fill all bytes to zero getting data size from `Storable` instance.
clearStorable :: Storable a => Ptr a -> IO ()
clearStorable :: forall a. Storable a => 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 :: forall b. Ptr b -> b
unptr ~Ptr b
_ = b
forall a. HasCallStack => a
undefined