{-# language CPP #-}
-- No documentation found for Chapter "Utils"
module Vulkan.CStruct.Utils  ( pokeFixedLengthByteString
                             , pokeFixedLengthNullTerminatedByteString
                             , peekByteStringFromSizedVectorPtr
                             , callocFixedArray
                             , lowerArrayPtr
                             , advancePtrBytes
                             , FixedArray
                             ) where

import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Array (allocaArray)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Storable (peekElemOff)
import Foreign.Storable (pokeElemOff)
import Foreign.Storable (sizeOf)
import GHC.Ptr (castPtr)
import Foreign.Ptr (plusPtr)
import GHC.TypeNats (natVal)
import qualified Data.ByteString (length)
import Data.ByteString (packCString)
import Data.ByteString (packCStringLen)
import Data.ByteString (take)
import Data.ByteString (unpack)
import Data.ByteString.Unsafe (unsafeUseAsCString)
import Data.Vector (ifoldr)
import qualified Data.Vector (length)
import qualified Data.Vector.Generic ((++))
import qualified Data.Vector.Generic (empty)
import qualified Data.Vector.Generic (fromList)
import qualified Data.Vector.Generic (length)
import qualified Data.Vector.Generic (replicate)
import qualified Data.Vector.Generic (snoc)
import qualified Data.Vector.Generic (take)
import Data.Proxy (Proxy(..))
import Foreign.C.Types (CChar(..))
import Foreign.Storable (Storable)
import Foreign.Ptr (Ptr)
import GHC.TypeNats (type(<=))
import GHC.TypeNats (KnownNat)
import GHC.TypeNats (Nat)
import Data.Word (Word8)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Data.Vector (Vector)
import qualified Data.Vector.Generic (Vector)

-- | An unpopulated type intended to be used as in @'Ptr' (FixedArray n a)@ to
-- indicate that the pointer points to an array of @n@ @a@s
data FixedArray (n :: Nat) (a :: Type)

-- | Store a 'ByteString' in a fixed amount of space inserting a null
-- character at the end and truncating if necessary.
--
-- If the 'ByteString' is not long enough to fill the space the remaining
-- bytes are unchanged
--
-- Note that if the 'ByteString' is exactly long enough the last byte will
-- still be replaced with 0
pokeFixedLengthNullTerminatedByteString
  :: forall n
   . KnownNat n
  => Ptr (FixedArray n CChar)
  -> ByteString
  -> IO ()
pokeFixedLengthNullTerminatedByteString :: forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString Ptr (FixedArray n CChar)
to ByteString
bs =
  forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString ByteString
bs forall a b. (a -> b) -> a -> b
$ \CString
from -> do
    let maxLength :: Int
maxLength = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall {k} (t :: k). Proxy t
Proxy @n))
        len :: Int
len       = forall a. Ord a => a -> a -> a
min Int
maxLength (ByteString -> Int
Data.ByteString.length ByteString
bs)
        end :: Int
end       = forall a. Ord a => a -> a -> a
min (Int
maxLength forall a. Num a => a -> a -> a
- Int
1) Int
len
    -- Copy the entire string into the buffer
    forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr Ptr (FixedArray n CChar)
to) CString
from Int
len
    -- Make the last byte (the one following the string, or the
    -- one at the end of the buffer)
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr Ptr (FixedArray n CChar)
to) Int
end CChar
0

-- | Store a 'ByteString' in a fixed amount of space, truncating if necessary.
--
-- If the 'ByteString' is not long enough to fill the space the remaining
-- bytes are unchanged
pokeFixedLengthByteString
  :: forall n
   . KnownNat n
  => Ptr (FixedArray n Word8)
  -> ByteString
  -> IO ()
pokeFixedLengthByteString :: forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ByteString -> IO ()
pokeFixedLengthByteString Ptr (FixedArray n Word8)
to ByteString
bs = forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString ByteString
bs forall a b. (a -> b) -> a -> b
$ \CString
from -> do
  let maxLength :: Int
maxLength = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall {k} (t :: k). Proxy t
Proxy @n))
      len :: Int
len       = forall a. Ord a => a -> a -> a
min Int
maxLength (ByteString -> Int
Data.ByteString.length ByteString
bs)
  forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr Ptr (FixedArray n Word8)
to) (forall a b. Ptr a -> Ptr b
castPtr @CChar @Word8 CString
from) Int
len

-- | Peek a 'ByteString' from a fixed sized array of bytes
peekByteStringFromSizedVectorPtr
  :: forall n
   . KnownNat n
  => Ptr (FixedArray n Word8)
  -> IO ByteString
peekByteStringFromSizedVectorPtr :: forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> IO ByteString
peekByteStringFromSizedVectorPtr Ptr (FixedArray n Word8)
p = CStringLen -> IO ByteString
packCStringLen (forall a b. Ptr a -> Ptr b
castPtr Ptr (FixedArray n Word8)
p, forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall {k} (t :: k). Proxy t
Proxy @n)))

-- | Allocate a zero array with the size specified by the 'FixedArray'
-- return type. Make sure to release the memory with 'free'
callocFixedArray
  :: forall n a . (KnownNat n, Storable a) => IO (Ptr (FixedArray n a))
callocFixedArray :: forall (n :: Nat) a.
(KnownNat n, Storable a) =>
IO (Ptr (FixedArray n a))
callocFixedArray = forall a. Int -> IO (Ptr a)
callocBytes
  ( forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => [Char] -> a
error [Char]
"sizeOf evaluated its argument" :: a)
  forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall {k} (t :: k). Proxy t
Proxy @n))
  )

-- | Get the pointer to the first element in the array
lowerArrayPtr
  :: forall a n
   . Ptr (FixedArray n a)
  -> Ptr a
lowerArrayPtr :: forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr = forall a b. Ptr a -> Ptr b
castPtr

-- | A type restricted 'plusPtr'
advancePtrBytes :: Ptr a -> Int -> Ptr a
advancePtrBytes :: forall a. Ptr a -> Int -> Ptr a
advancePtrBytes = forall a b. Ptr a -> Int -> Ptr b
plusPtr