{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Sparse.Buffer.Middle.Internal where

import Foreign.Marshal.Array
import Control.Arrow

import Gpu.Vulkan.Buffer.Middle.Internal qualified as Buffer
import Gpu.Vulkan.Sparse.Middle.Internal

import Gpu.Vulkan.Sparse.Buffer.Core qualified as C

data MemoryBindInfo = MemoryBindInfo {
	MemoryBindInfo -> B
memoryBindInfoBuffer :: Buffer.B,
	MemoryBindInfo -> [MemoryBind]
memoryBindInfoBinds :: [MemoryBind] }

memoryBindInfoToCore :: MemoryBindInfo -> (C.MemoryBindInfo -> IO a) -> IO a
memoryBindInfoToCore :: forall a. MemoryBindInfo -> (MemoryBindInfo -> IO a) -> IO a
memoryBindInfoToCore MemoryBindInfo {
	memoryBindInfoBuffer :: MemoryBindInfo -> B
memoryBindInfoBuffer = Buffer.B B
bffr,
	memoryBindInfoBinds :: MemoryBindInfo -> [MemoryBind]
memoryBindInfoBinds = [MemoryBind] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([MemoryBind] -> Int)
-> ([MemoryBind] -> [MemoryBind])
-> [MemoryBind]
-> (Int, [MemoryBind])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [MemoryBind] -> [MemoryBind]
forall a. a -> a
id -> (Int
bndc, [MemoryBind]
bnds) } MemoryBindInfo -> IO a
f = do
	cbnds <- MemoryBind -> IO MemoryBind
memoryBindToCore (MemoryBind -> IO MemoryBind) -> [MemoryBind] -> IO [MemoryBind]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` [MemoryBind]
bnds
	allocaArray bndc \Ptr MemoryBind
pbnds -> do
		Ptr MemoryBind -> [MemoryBind] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr MemoryBind
pbnds [MemoryBind]
cbnds
		MemoryBindInfo -> IO a
f C.MemoryBindInfo {
			memoryBindInfoBuffer :: B
C.memoryBindInfoBuffer = B
bffr,
			memoryBindInfoBindCount :: Word32
C.memoryBindInfoBindCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bndc,
			memoryBindInfoPBinds :: Ptr MemoryBind
C.memoryBindInfoPBinds = Ptr MemoryBind
pbnds }