{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments, LambdaCase, TupleSections #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.DescriptorSet.Middle.Internal (
	D(..), AllocateInfo(..), allocateDs, freeDs,
	Write(..), WriteSources(..), Copy(..),
	updateDs, WriteListToCore, CopyListToCore ) where

import Foreign.Ptr
import Foreign.Marshal.Array
import Foreign.Storable
import Foreign.Storable.PeekPoke (
	WithPoked, withPoked, withPoked', withPtrS, pattern NullPtr )
import Control.Arrow
import Control.Monad.Trans
import Control.Monad.Cont
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.List (genericLength)
import Data.HeteroParList (pattern (:**))
import Data.HeteroParList qualified as HeteroParList
import Data.Word

import Gpu.Vulkan.Exception.Middle.Internal
import Gpu.Vulkan.Exception.Enum

import qualified Gpu.Vulkan.Device.Middle.Internal as Device
import qualified Gpu.Vulkan.BufferView.Middle.Internal as BufferView
import qualified Gpu.Vulkan.Descriptor.Enum as Descriptor
import qualified Gpu.Vulkan.Descriptor.Middle.Internal as Descriptor
import qualified Gpu.Vulkan.DescriptorPool.Middle.Internal as Pool
import qualified Gpu.Vulkan.DescriptorSetLayout.Middle.Internal as Layout
import qualified Gpu.Vulkan.DescriptorSet.Core as C

import qualified Gpu.Vulkan.Descriptor.Core as Descriptor.C
import qualified Gpu.Vulkan.BufferView.Core as BufferView.C

data AllocateInfo mn = AllocateInfo {
	forall (mn :: Maybe (*)). AllocateInfo mn -> M mn
allocateInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). AllocateInfo mn -> D
allocateInfoDescriptorPool :: Pool.D,
	forall (mn :: Maybe (*)). AllocateInfo mn -> [D]
allocateInfoSetLayouts :: [Layout.D] }

deriving instance Show (TMaybe.M mn) => Show (AllocateInfo mn)

allocateInfoToCore :: WithPoked (TMaybe.M mn) =>
	AllocateInfo mn -> (C.AllocateInfo -> IO a) -> IO ()
allocateInfoToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
AllocateInfo mn -> (AllocateInfo -> IO a) -> IO ()
allocateInfoToCore AllocateInfo {
	allocateInfoNext :: forall (mn :: Maybe (*)). AllocateInfo mn -> M mn
allocateInfoNext = M mn
mnxt,
	allocateInfoDescriptorPool :: forall (mn :: Maybe (*)). AllocateInfo mn -> D
allocateInfoDescriptorPool = Pool.D D
pl,
	allocateInfoSetLayouts :: forall (mn :: Maybe (*)). AllocateInfo mn -> [D]
allocateInfoSetLayouts =
		(((Int -> Int
forall a. a -> a
id (Int -> Int) -> (Int -> Word32) -> Int -> (Int, Word32)
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')
&&& Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Int -> (Int, Word32)) -> (Int, [D]) -> ((Int, Word32), [D])
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
`first`) ((Int, [D]) -> ((Int, Word32), [D]))
-> ([D] -> (Int, [D])) -> [D] -> ((Int, Word32), [D])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([D] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([D] -> Int) -> ([D] -> [D]) -> [D] -> (Int, [D])
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')
&&& [D] -> [D]
forall a. a -> a
id)) ->
		((Int
dsci, Word32
dscw), [D]
sls) } AllocateInfo -> IO a
f =
	M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO ()
forall a b.
WithPoked a =>
a -> (forall s. PtrS s a -> IO b) -> IO b
forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b
withPoked' M mn
mnxt \PtrS s (M mn)
pnxt -> PtrS s (M mn) -> (Ptr (M mn) -> IO a) -> IO ()
forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO ()
withPtrS PtrS s (M mn)
pnxt \(Ptr (M mn) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
pnxt') -> do
	psls <- Int -> (Ptr D -> IO (Ptr D)) -> IO (Ptr D)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
dsci \Ptr D
p ->
		Ptr D
p Ptr D -> IO () -> IO (Ptr D)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Ptr D -> [D] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr D
p ([D] -> IO ()) -> [D] -> IO ()
forall a b. (a -> b) -> a -> b
$ (\(Layout.D D
l) -> D
l) (D -> D) -> [D] -> [D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [D]
sls)
	f C.AllocateInfo {
		C.allocateInfoSType = (),
		C.allocateInfoPNext = pnxt',
		C.allocateInfoDescriptorPool = pl,
		C.allocateInfoDescriptorSetCount = dscw,
		C.allocateInfoPSetLayouts = psls }

newtype D = D C.D deriving Int -> D -> ShowS
[D] -> ShowS
D -> String
(Int -> D -> ShowS) -> (D -> String) -> ([D] -> ShowS) -> Show D
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> D -> ShowS
showsPrec :: Int -> D -> ShowS
$cshow :: D -> String
show :: D -> String
$cshowList :: [D] -> ShowS
showList :: [D] -> ShowS
Show

allocateDs :: WithPoked (TMaybe.M mn) => Device.D -> AllocateInfo mn -> IO [D]
allocateDs :: forall (mn :: Maybe (*)).
WithPoked (M mn) =>
D -> AllocateInfo mn -> IO [D]
allocateDs (Device.D D
dvc) AllocateInfo mn
ai = ((D -> D
D (D -> D) -> [D] -> [D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([D] -> [D]) -> IO [D] -> IO [D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO [D] -> IO [D])
-> ((([D] -> IO [D]) -> IO [D]) -> IO [D])
-> (([D] -> IO [D]) -> IO [D])
-> IO [D]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((([D] -> IO [D]) -> IO [D]) -> ([D] -> IO [D]) -> IO [D]
forall a b. (a -> b) -> a -> b
$ [D] -> IO [D]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) ((([D] -> IO [D]) -> IO [D]) -> IO [D])
-> (([D] -> IO [D]) -> IO [D]) -> IO [D]
forall a b. (a -> b) -> a -> b
$ ContT [D] IO [D] -> ([D] -> IO [D]) -> IO [D]
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT do
	let	dsc :: Int
dsc = [D] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([D] -> Int) -> [D] -> Int
forall a b. (a -> b) -> a -> b
$ AllocateInfo mn -> [D]
forall (mn :: Maybe (*)). AllocateInfo mn -> [D]
allocateInfoSetLayouts AllocateInfo mn
ai
	pss <- ((Ptr D -> IO [D]) -> IO [D]) -> ContT [D] IO (Ptr D)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr D -> IO [D]) -> IO [D]) -> ContT [D] IO (Ptr D))
-> ((Ptr D -> IO [D]) -> IO [D]) -> ContT [D] IO (Ptr D)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr D -> IO [D]) -> IO [D]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
dsc
	lift $ allocateInfoToCore ai \AllocateInfo
fai ->
		AllocateInfo -> (Ptr AllocateInfo -> IO ()) -> IO ()
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked AllocateInfo
fai \Ptr AllocateInfo
pai -> do
			r <- D -> Ptr AllocateInfo -> Ptr D -> IO Int32
C.allocateDs D
dvc Ptr AllocateInfo
pai Ptr D
pss
			throwUnlessSuccess $ Result r
	lift $ peekArray dsc pss

freeDs :: Device.D -> Pool.D -> [D] -> IO ()
freeDs :: D -> D -> [D] -> IO ()
freeDs (Device.D D
dvc) (Pool.D D
pl) [D]
ds = Int -> (Ptr D -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
forall n. Integral n => n
ln \Ptr D
pds -> do
	Ptr D -> [D] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr D
pds ([D] -> IO ()) -> [D] -> IO ()
forall a b. (a -> b) -> a -> b
$ (\(D D
d) -> D
d) (D -> D) -> [D] -> [D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [D]
ds
	r <- D -> D -> Word32 -> Ptr D -> IO Int32
C.freeDs D
dvc D
pl Word32
forall n. Integral n => n
ln Ptr D
pds
	throwUnlessSuccess $ Result r
	where
	ln :: Integral n => n
	ln :: forall n. Integral n => n
ln = [D] -> n
forall i a. Num i => [a] -> i
genericLength [D]
ds

data Copy mn = Copy {
	forall (mn :: Maybe (*)). Copy mn -> M mn
copyNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). Copy mn -> D
copySrcSet :: D,
	forall (mn :: Maybe (*)). Copy mn -> Word32
copySrcBinding :: Word32,
	forall (mn :: Maybe (*)). Copy mn -> Word32
copySrcArrayElement :: Word32,
	forall (mn :: Maybe (*)). Copy mn -> D
copyDstSet :: D,
	forall (mn :: Maybe (*)). Copy mn -> Word32
copyDstBinding :: Word32,
	forall (mn :: Maybe (*)). Copy mn -> Word32
copyDstArrayElement :: Word32,
	forall (mn :: Maybe (*)). Copy mn -> Word32
copyDescriptorCount :: Word32 }

deriving instance Show (TMaybe.M mn) => Show (Copy mn)

class CopyListToCore cs where
	copyListToCore ::
		HeteroParList.PL Copy cs -> ([C.Copy] -> IO a) -> IO ()

instance CopyListToCore '[] where
	copyListToCore :: forall a. PL Copy '[] -> ([Copy] -> IO a) -> IO ()
copyListToCore PL Copy '[]
HeteroParList.Nil [Copy] -> IO a
f = () () -> IO a -> IO ()
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Copy] -> IO a
f []

instance (WithPoked (TMaybe.M c), CopyListToCore cs) =>
	CopyListToCore (c ': cs) where
	copyListToCore :: forall a. PL Copy (c : cs) -> ([Copy] -> IO a) -> IO ()
copyListToCore (Copy s
c :** PL Copy ss1
cs) [Copy] -> IO a
f =
		Copy s -> (Copy -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
Copy mn -> (Copy -> IO a) -> IO ()
copyToCore Copy s
c \Copy
cc -> PL Copy ss1 -> ([Copy] -> IO a) -> IO ()
forall (cs :: [Maybe (*)]) a.
CopyListToCore cs =>
PL Copy cs -> ([Copy] -> IO a) -> IO ()
forall a. PL Copy ss1 -> ([Copy] -> IO a) -> IO ()
copyListToCore PL Copy ss1
cs \[Copy]
ccs -> [Copy] -> IO a
f ([Copy] -> IO a) -> [Copy] -> IO a
forall a b. (a -> b) -> a -> b
$ Copy
cc Copy -> [Copy] -> [Copy]
forall a. a -> [a] -> [a]
: [Copy]
ccs

copyToCore :: WithPoked (TMaybe.M mn) => Copy mn -> (C.Copy -> IO a) -> IO ()
copyToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
Copy mn -> (Copy -> IO a) -> IO ()
copyToCore Copy {
	copyNext :: forall (mn :: Maybe (*)). Copy mn -> M mn
copyNext = M mn
mnxt,
	copySrcSet :: forall (mn :: Maybe (*)). Copy mn -> D
copySrcSet = D D
ss,
	copySrcBinding :: forall (mn :: Maybe (*)). Copy mn -> Word32
copySrcBinding = Word32
sb,
	copySrcArrayElement :: forall (mn :: Maybe (*)). Copy mn -> Word32
copySrcArrayElement = Word32
sae,
	copyDstSet :: forall (mn :: Maybe (*)). Copy mn -> D
copyDstSet = D D
ds,
	copyDstBinding :: forall (mn :: Maybe (*)). Copy mn -> Word32
copyDstBinding = Word32
db,
	copyDstArrayElement :: forall (mn :: Maybe (*)). Copy mn -> Word32
copyDstArrayElement = Word32
dae,
	copyDescriptorCount :: forall (mn :: Maybe (*)). Copy mn -> Word32
copyDescriptorCount = Word32
dc } Copy -> IO a
f =
	M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO ()
forall a b.
WithPoked a =>
a -> (forall s. PtrS s a -> IO b) -> IO b
forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b
withPoked' M mn
mnxt \PtrS s (M mn)
pnxt ->
	PtrS s (M mn) -> (Ptr (M mn) -> IO a) -> IO ()
forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO ()
withPtrS PtrS s (M mn)
pnxt \(Ptr (M mn) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
pnxt') -> Copy -> IO a
f C.Copy {
		copySType :: ()
C.copySType = (),
		copyPNext :: Ptr ()
C.copyPNext = Ptr ()
pnxt',
		copySrcSet :: D
C.copySrcSet = D
ss,
		copySrcBinding :: Word32
C.copySrcBinding = Word32
sb,
		copySrcArrayElement :: Word32
C.copySrcArrayElement = Word32
sae,
		copyDstSet :: D
C.copyDstSet = D
ds,
		copyDstBinding :: Word32
C.copyDstBinding = Word32
db,
		copyDstArrayElement :: Word32
C.copyDstArrayElement = Word32
dae,
		copyDescriptorCount :: Word32
C.copyDescriptorCount = Word32
dc }

data Write mn = Write {
	forall (mn :: Maybe (*)). Write mn -> M mn
writeNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). Write mn -> D
writeDstSet :: D,
	forall (mn :: Maybe (*)). Write mn -> Word32
writeDstBinding :: Word32,
	forall (mn :: Maybe (*)). Write mn -> Word32
writeDstArrayElement :: Word32,
	forall (mn :: Maybe (*)). Write mn -> Type
writeDescriptorType :: Descriptor.Type,
	forall (mn :: Maybe (*)). Write mn -> WriteSources
writeSources :: WriteSources }

deriving instance Show (TMaybe.M mn) => Show (Write mn)

data WriteSources
	= WriteSourcesInNext Word32
	| WriteSourcesImageInfo [Descriptor.ImageInfo]
	| WriteSourcesBufferInfo [Descriptor.BufferInfo]
	| WriteSourcesBufferView [BufferView.B]
	deriving Int -> WriteSources -> ShowS
[WriteSources] -> ShowS
WriteSources -> String
(Int -> WriteSources -> ShowS)
-> (WriteSources -> String)
-> ([WriteSources] -> ShowS)
-> Show WriteSources
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WriteSources -> ShowS
showsPrec :: Int -> WriteSources -> ShowS
$cshow :: WriteSources -> String
show :: WriteSources -> String
$cshowList :: [WriteSources] -> ShowS
showList :: [WriteSources] -> ShowS
Show

class WriteListToCore ws where
	writeListToCore ::
		HeteroParList.PL Write ws -> ([C.Write] -> IO a) -> IO ()

instance WriteListToCore '[] where
	writeListToCore :: forall a. PL Write '[] -> ([Write] -> IO a) -> IO ()
writeListToCore PL Write '[]
HeteroParList.Nil [Write] -> IO a
f = () () -> IO a -> IO ()
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Write] -> IO a
f []

instance (WithPoked (TMaybe.M w), WriteListToCore ws) => WriteListToCore (w ': ws) where
	writeListToCore :: forall a. PL Write (w : ws) -> ([Write] -> IO a) -> IO ()
writeListToCore (Write s
w :** PL Write ss1
ws) [Write] -> IO a
f =
		Write s -> (Write -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
Write mn -> (Write -> IO a) -> IO ()
writeToCore Write s
w \Write
cw -> PL Write ss1 -> ([Write] -> IO a) -> IO ()
forall (ws :: [Maybe (*)]) a.
WriteListToCore ws =>
PL Write ws -> ([Write] -> IO a) -> IO ()
forall a. PL Write ss1 -> ([Write] -> IO a) -> IO ()
writeListToCore PL Write ss1
ws \[Write]
cws -> [Write] -> IO a
f ([Write] -> IO a) -> [Write] -> IO a
forall a b. (a -> b) -> a -> b
$ Write
cw Write -> [Write] -> [Write]
forall a. a -> [a] -> [a]
: [Write]
cws

writeToCore :: WithPoked (TMaybe.M mn) => Write mn -> (C.Write -> IO a) -> IO ()
writeToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
Write mn -> (Write -> IO a) -> IO ()
writeToCore Write {
	writeNext :: forall (mn :: Maybe (*)). Write mn -> M mn
writeNext = M mn
mnxt,
	writeDstSet :: forall (mn :: Maybe (*)). Write mn -> D
writeDstSet = D D
s,
	writeDstBinding :: forall (mn :: Maybe (*)). Write mn -> Word32
writeDstBinding = Word32
bdg,
	writeDstArrayElement :: forall (mn :: Maybe (*)). Write mn -> Word32
writeDstArrayElement = Word32
ae,
	writeDescriptorType :: forall (mn :: Maybe (*)). Write mn -> Type
writeDescriptorType = Descriptor.Type Word32
tp,
	writeSources :: forall (mn :: Maybe (*)). Write mn -> WriteSources
writeSources = WriteSources
srcs } Write -> IO a
f =
	M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO ()
forall a b.
WithPoked a =>
a -> (forall s. PtrS s a -> IO b) -> IO b
forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b
withPoked' M mn
mnxt \PtrS s (M mn)
pnxt -> PtrS s (M mn) -> (Ptr (M mn) -> IO a) -> IO ()
forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO ()
withPtrS PtrS s (M mn)
pnxt \(Ptr (M mn) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
pnxt') ->
	WriteSources
-> ((Word32, Ptr ImageInfo, Ptr BufferInfo, Ptr B) -> IO a) -> IO a
forall a.
WriteSources
-> ((Word32, Ptr ImageInfo, Ptr BufferInfo, Ptr B) -> IO a) -> IO a
writeSourcesToCore WriteSources
srcs \(Word32
cnt, Ptr ImageInfo
pii, Ptr BufferInfo
pbi, Ptr B
ptbv) ->
	Write -> IO a
f C.Write {
		writeSType :: ()
C.writeSType = (),
		writePNext :: Ptr ()
C.writePNext = Ptr ()
pnxt',
		writeDstSet :: D
C.writeDstSet = D
s,
		writeDstBinding :: Word32
C.writeDstBinding = Word32
bdg,
		writeDstArrayElement :: Word32
C.writeDstArrayElement = Word32
ae,
		writeDescriptorCount :: Word32
C.writeDescriptorCount = Word32
cnt,
		writeDescriptorType :: Word32
C.writeDescriptorType = Word32
tp,
		writePImageInfo :: Ptr ImageInfo
C.writePImageInfo = Ptr ImageInfo
pii,
		writePBufferInfo :: Ptr BufferInfo
C.writePBufferInfo = Ptr BufferInfo
pbi,
		writePTexelBufferView :: Ptr B
C.writePTexelBufferView = Ptr B
ptbv }

writeSourcesToCore :: WriteSources -> ((
	Word32, Ptr Descriptor.C.ImageInfo,
	Ptr Descriptor.C.BufferInfo, Ptr BufferView.C.B ) -> IO a) -> IO a
writeSourcesToCore :: forall a.
WriteSources
-> ((Word32, Ptr ImageInfo, Ptr BufferInfo, Ptr B) -> IO a) -> IO a
writeSourcesToCore WriteSources
ws (Word32, Ptr ImageInfo, Ptr BufferInfo, Ptr B) -> IO a
f = case WriteSources
ws of
	WriteSourcesInNext Word32
c -> (Word32, Ptr ImageInfo, Ptr BufferInfo, Ptr B) -> IO a
f (Word32
c, Ptr ImageInfo
forall a. Ptr a
NullPtr, Ptr BufferInfo
forall a. Ptr a
NullPtr, Ptr B
forall a. Ptr a
NullPtr)
	WriteSourcesImageInfo ([ImageInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ImageInfo] -> Int)
-> ([ImageInfo] -> [ImageInfo])
-> [ImageInfo]
-> (Int, [ImageInfo])
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')
&&& [ImageInfo] -> [ImageInfo]
forall a. a -> a
id -> (Int
ln, [ImageInfo]
iis)) ->
		Int -> (Ptr ImageInfo -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
ln \Ptr ImageInfo
piis ->
		ImageInfo -> IO ImageInfo
Descriptor.imageInfoToCore (ImageInfo -> IO ImageInfo) -> [ImageInfo] -> IO [ImageInfo]
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` [ImageInfo]
iis IO [ImageInfo] -> ([ImageInfo] -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[ImageInfo]
iis' ->
		Ptr ImageInfo -> [ImageInfo] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr ImageInfo
piis [ImageInfo]
iis' IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
		(Word32, Ptr ImageInfo, Ptr BufferInfo, Ptr B) -> IO a
f (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ln, Ptr ImageInfo
piis, Ptr BufferInfo
forall a. Ptr a
NullPtr, Ptr B
forall a. Ptr a
NullPtr)
	WriteSourcesBufferInfo
		([BufferInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([BufferInfo] -> Int)
-> ([BufferInfo] -> [BufferInfo])
-> [BufferInfo]
-> (Int, [BufferInfo])
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')
&&& (BufferInfo -> BufferInfo
Descriptor.bufferInfoToCore (BufferInfo -> BufferInfo) -> [BufferInfo] -> [BufferInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) -> (Int
ln, [BufferInfo]
bis)) ->
		Int -> (Ptr BufferInfo -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
ln \Ptr BufferInfo
pbis ->
		Ptr BufferInfo -> [BufferInfo] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr BufferInfo
pbis [BufferInfo]
bis IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
		(Word32, Ptr ImageInfo, Ptr BufferInfo, Ptr B) -> IO a
f (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ln, Ptr ImageInfo
forall a. Ptr a
NullPtr, Ptr BufferInfo
pbis, Ptr B
forall a. Ptr a
NullPtr)
	WriteSourcesBufferView
		([B] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([B] -> Int) -> ([B] -> [B]) -> [B] -> (Int, [B])
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')
&&& ((\(BufferView.B B
b) -> B
b) (B -> B) -> [B] -> [B]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) -> (Int
ln, [B]
bvs)) ->
		Int -> (Ptr B -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
ln \Ptr B
pbvs ->
		Ptr B -> [B] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr B
pbvs [B]
bvs IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
		(Word32, Ptr ImageInfo, Ptr BufferInfo, Ptr B) -> IO a
f (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ln, Ptr ImageInfo
forall a. Ptr a
NullPtr, Ptr BufferInfo
forall a. Ptr a
NullPtr, Ptr B
pbvs)

updateDs :: (WriteListToCore ws, CopyListToCore cs) =>
	Device.D ->
	HeteroParList.PL Write ws -> HeteroParList.PL Copy cs ->
	IO ()
updateDs :: forall (ws :: [Maybe (*)]) (cs :: [Maybe (*)]).
(WriteListToCore ws, CopyListToCore cs) =>
D -> PL Write ws -> PL Copy cs -> IO ()
updateDs (Device.D D
dvc) PL Write ws
ws PL Copy cs
cs =
	PL Write ws -> ([Write] -> IO ()) -> IO ()
forall (ws :: [Maybe (*)]) a.
WriteListToCore ws =>
PL Write ws -> ([Write] -> IO a) -> IO ()
forall a. PL Write ws -> ([Write] -> IO a) -> IO ()
writeListToCore PL Write ws
ws \[Write]
cws ->
	[Write] -> ((Int, Ptr Write) -> IO ()) -> IO ()
forall a b. Storable a => [a] -> ((Int, Ptr a) -> IO b) -> IO b
allocaAndPokeArray [Write]
cws \(Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
wc, Ptr Write
pws) ->
	PL Copy cs -> ([Copy] -> IO ()) -> IO ()
forall (cs :: [Maybe (*)]) a.
CopyListToCore cs =>
PL Copy cs -> ([Copy] -> IO a) -> IO ()
forall a. PL Copy cs -> ([Copy] -> IO a) -> IO ()
copyListToCore PL Copy cs
cs \[Copy]
ccs ->
	[Copy] -> ((Int, Ptr Copy) -> IO ()) -> IO ()
forall a b. Storable a => [a] -> ((Int, Ptr a) -> IO b) -> IO b
allocaAndPokeArray [Copy]
ccs \(Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
cc, Ptr Copy
pcs) ->
	D -> Word32 -> Ptr Write -> Word32 -> Ptr Copy -> IO ()
C.updateDs D
dvc Word32
wc Ptr Write
pws Word32
cc Ptr Copy
pcs

allocaAndPokeArray :: Storable a => [a] -> ((Int, Ptr a) -> IO b) -> IO b
allocaAndPokeArray :: forall a b. Storable a => [a] -> ((Int, Ptr a) -> IO b) -> IO b
allocaAndPokeArray ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> ([a] -> [a]) -> [a] -> (Int, [a])
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')
&&& [a] -> [a]
forall a. a -> a
id -> (Int
xc, [a]
xs)) (Int, Ptr a) -> IO b
f
	= Int -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
xc \Ptr a
p -> Ptr a -> [a] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr a
p [a]
xs IO () -> IO b -> IO b
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int, Ptr a) -> IO b
f (Int
xc, Ptr a
p)