{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.DescriptorPool.Middle.Internal (
	D(..), CreateInfo(..), Size(..), create, destroy ) where

import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Storable
import Foreign.Storable.PeekPoke (WithPoked, withPoked, withPoked', withPtrS)
import Control.Arrow
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.Word

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

import Gpu.Vulkan.AllocationCallbacks.Middle.Internal
	qualified as AllocationCallbacks
import qualified Gpu.Vulkan.Device.Middle.Internal as Device
import qualified Gpu.Vulkan.DescriptorPool.Core as C

data Size = Size { Size -> Type
sizeType :: Type, Size -> Word32
sizeDescriptorCount :: Word32 }
	deriving Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
(Int -> Size -> ShowS)
-> (Size -> String) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Size -> ShowS
showsPrec :: Int -> Size -> ShowS
$cshow :: Size -> String
show :: Size -> String
$cshowList :: [Size] -> ShowS
showList :: [Size] -> ShowS
Show

sizeToCore :: Size -> C.Size
sizeToCore :: Size -> Size
sizeToCore Size { sizeType :: Size -> Type
sizeType = Type Word32
tp, sizeDescriptorCount :: Size -> Word32
sizeDescriptorCount = Word32
dc } =
	C.Size { sizeType :: Word32
C.sizeType = Word32
tp, sizeDescriptorCount :: Word32
C.sizeDescriptorCount = Word32
dc }

data CreateInfo mn = CreateInfo {
	forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags
createInfoFlags :: CreateFlags,
	forall (mn :: Maybe (*)). CreateInfo mn -> Word32
createInfoMaxSets :: Word32,
	forall (mn :: Maybe (*)). CreateInfo mn -> [Size]
createInfoPoolSizes :: [Size] }

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

createInfoToCore :: WithPoked (TMaybe.M mn) =>
	CreateInfo mn -> (Ptr C.CreateInfo -> IO a) -> IO ()
createInfoToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCore CreateInfo {
	createInfoNext :: forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext = M mn
mnxt,
	createInfoFlags :: forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags
createInfoFlags = CreateFlagBits Word32
flgs,
	createInfoMaxSets :: forall (mn :: Maybe (*)). CreateInfo mn -> Word32
createInfoMaxSets = Word32
ms,
	createInfoPoolSizes :: forall (mn :: Maybe (*)). CreateInfo mn -> [Size]
createInfoPoolSizes = ([Size] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Size] -> Int) -> ([Size] -> [Size]) -> [Size] -> (Int, [Size])
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')
&&& (Size -> Size
sizeToCore (Size -> Size) -> [Size] -> [Size]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) -> (Int
psc, [Size]
pss))
	} Ptr CreateInfo -> 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') ->
	Int -> (Ptr Size -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
psc \Ptr Size
ppss ->
	Ptr Size -> [Size] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Size
ppss [Size]
pss 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
>>
	CreateInfo -> (Ptr CreateInfo -> IO a) -> IO a
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked C.CreateInfo {
			createInfoSType :: ()
C.createInfoSType = (),
			createInfoPNext :: Ptr ()
C.createInfoPNext = Ptr ()
pnxt',
			createInfoFlags :: Word32
C.createInfoFlags = Word32
flgs,
			createInfoMaxSets :: Word32
C.createInfoMaxSets = Word32
ms,
			createInfoPoolSizeCount :: Word32
C.createInfoPoolSizeCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
psc,
			createInfoPPoolSizes :: Ptr Size
C.createInfoPPoolSizes = Ptr Size
ppss } Ptr CreateInfo -> IO a
f

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

create :: WithPoked (TMaybe.M mn) =>
	Device.D -> CreateInfo mn -> TPMaybe.M AllocationCallbacks.A mc -> IO D
create :: forall (mn :: Maybe (*)) (mc :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn -> M A mc -> IO D
create (Device.D D
dvc) CreateInfo mn
ci M A mc
mac = D -> D
D (D -> D) -> IO D -> IO D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr D -> IO D) -> IO D
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr D
pp -> do
	CreateInfo mn -> (Ptr CreateInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCore CreateInfo mn
ci \Ptr CreateInfo
pci ->
		M A mc -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A mc
mac \Ptr A
pac ->
		Result -> IO ()
throwUnlessSuccess (Result -> IO ()) -> (Int32 -> Result) -> Int32 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Result
Result (Int32 -> IO ()) -> IO Int32 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< D -> Ptr CreateInfo -> Ptr A -> Ptr D -> IO Int32
C.create D
dvc Ptr CreateInfo
pci Ptr A
pac Ptr D
pp
	Ptr D -> IO D
forall a. Storable a => Ptr a -> IO a
peek Ptr D
pp

destroy :: Device.D -> D -> TPMaybe.M AllocationCallbacks.A md -> IO ()
destroy :: forall (md :: Maybe (*)). D -> D -> M A md -> IO ()
destroy (Device.D D
dvc) (D D
p) M A md
mac =
	M A md -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A md
mac ((Ptr A -> IO ()) -> IO ()) -> (Ptr A -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ D -> D -> Ptr A -> IO ()
C.destroy D
dvc D
p