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

module Gpu.Vulkan.DescriptorSetLayout.Middle.Internal (
	D(..), CreateInfo(..), Binding(..), 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, pattern NullPtr )
import Control.Arrow
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.Word

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

import Gpu.Vulkan.AllocationCallbacks.Middle.Internal
	qualified as AllocationCallbacks
import qualified Gpu.Vulkan.Device.Middle.Internal as Device
import qualified Gpu.Vulkan.Sampler.Middle.Internal as Sampler
import qualified Gpu.Vulkan.Descriptor.Enum as Descriptor
import qualified Gpu.Vulkan.DescriptorSetLayout.Core as C

data Binding = Binding {
	Binding -> Word32
bindingBinding :: Word32,
	Binding -> Type
bindingDescriptorType :: Descriptor.Type,
	Binding -> Either Word32 [S]
bindingDescriptorCountOrImmutableSamplers :: Either Word32 [Sampler.S],
	Binding -> ShaderStageFlags
bindingStageFlags :: ShaderStageFlags }
	deriving Int -> Binding -> ShowS
[Binding] -> ShowS
Binding -> String
(Int -> Binding -> ShowS)
-> (Binding -> String) -> ([Binding] -> ShowS) -> Show Binding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Binding -> ShowS
showsPrec :: Int -> Binding -> ShowS
$cshow :: Binding -> String
show :: Binding -> String
$cshowList :: [Binding] -> ShowS
showList :: [Binding] -> ShowS
Show

bindingToCore :: Binding -> (C.Binding -> IO a) -> IO a
bindingToCore :: forall a. Binding -> (Binding -> IO a) -> IO a
bindingToCore Binding {
	bindingBinding :: Binding -> Word32
bindingBinding = Word32
b,
	bindingDescriptorType :: Binding -> Type
bindingDescriptorType = Descriptor.Type Word32
dt,
	bindingDescriptorCountOrImmutableSamplers :: Binding -> Either Word32 [S]
bindingDescriptorCountOrImmutableSamplers =
		(Word32 -> (Either Word32 Int, [S]))
-> ([S] -> (Either Word32 Int, [S]))
-> Either Word32 [S]
-> (Either Word32 Int, [S])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((, []) (Either Word32 Int -> (Either Word32 Int, [S]))
-> (Word32 -> Either Word32 Int)
-> Word32
-> (Either Word32 Int, [S])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Either Word32 Int
forall a b. a -> Either a b
Left) (Int -> Either Word32 Int
forall a b. b -> Either a b
Right (Int -> Either Word32 Int)
-> ([S] -> Int) -> [S] -> Either Word32 Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [S] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([S] -> Either Word32 Int)
-> ([S] -> [S]) -> [S] -> (Either Word32 Int, [S])
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')
&&& [S] -> [S]
forall a. a -> a
id) -> (Either Word32 Int
dc, [S]
ss),
	bindingStageFlags :: Binding -> ShaderStageFlags
bindingStageFlags = ShaderStageFlagBits Word32
sf } Binding -> IO a
f = case Either Word32 Int
dc of
		Left Word32
_ -> Binding -> IO a
f (Binding -> IO a) -> Binding -> IO a
forall a b. (a -> b) -> a -> b
$ PtrS -> Binding
mk PtrS
forall a. Ptr a
NullPtr
		Right Int
c -> Int -> (PtrS -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
c \PtrS
p -> do
			PtrS -> [S] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray PtrS
p ([S] -> IO ()) -> [S] -> IO ()
forall a b. (a -> b) -> a -> b
$ (\(Sampler.S S
s) -> S
s) (S -> S) -> [S] -> [S]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [S]
ss
			Binding -> IO a
f (Binding -> IO a) -> Binding -> IO a
forall a b. (a -> b) -> a -> b
$ PtrS -> Binding
mk PtrS
p
	where mk :: PtrS -> Binding
mk PtrS
p = C.Binding {
		bindingBinding :: Word32
C.bindingBinding = Word32
b,
		bindingDescriptorType :: Word32
C.bindingDescriptorType = Word32
dt,
		bindingDescriptorCount :: Word32
C.bindingDescriptorCount = (Word32 -> Word32)
-> (Int -> Word32) -> Either Word32 Int -> Word32
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Word32 -> Word32
forall a. a -> a
id Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Either Word32 Int
dc,
		bindingStageFlags :: Word32
C.bindingStageFlags = Word32
sf,
		bindingPImmutableSamplers :: PtrS
C.bindingPImmutableSamplers = PtrS
p }

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

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 -> [Binding]
createInfoBindings :: [Binding] }

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,
	createInfoBindings :: forall (mn :: Maybe (*)). CreateInfo mn -> [Binding]
createInfoBindings = [Binding] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Binding] -> Int)
-> ([Binding] -> [Binding]) -> [Binding] -> (Int, [Binding])
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')
&&& [Binding] -> [Binding]
forall a. a -> a
id -> (Int
bc, [Binding]
bs) } 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 Binding -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
bc \Ptr Binding
pbs ->
	(Binding -> (Binding -> IO a) -> IO a
forall a. Binding -> (Binding -> IO a) -> IO a
bindingToCore (Binding -> (Binding -> IO a) -> IO a)
-> [Binding] -> ([Binding] -> IO a) -> IO a
forall (m :: * -> *) a b c.
Monad m =>
(a -> (b -> m c) -> m c) -> [a] -> ([b] -> m c) -> m c
`mapContM` [Binding]
bs) \[Binding]
cbs -> do
		Ptr Binding -> [Binding] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Binding
pbs [Binding]
cbs
		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,
				createInfoBindingCount :: Word32
C.createInfoBindingCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bc,
				createInfoPBindings :: Ptr Binding
C.createInfoPBindings = Ptr Binding
pbs } Ptr CreateInfo -> IO a
f

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
pl -> 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
pl
	Ptr D -> IO D
forall a. Storable a => Ptr a -> IO a
peek Ptr D
pl

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
l) 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
pac -> D -> D -> Ptr A -> IO ()
C.destroy D
dvc D
l Ptr A
pac