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

module Gpu.Vulkan.Instance.Middle.Internal (

	-- * CREATE AND DESTROY

	create, destroy, I(..), CreateInfo(..),

	-- * ENUMERATE

	enumerateLayerProperties, enumerateExtensionProperties

	) where

import Foreign.Ptr
import Foreign.Marshal
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.Default

import Data.Text qualified as T
import Data.Text.Foreign.MiscYj

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

import qualified Gpu.Vulkan.Instance.Core as C
import Gpu.Vulkan.AllocationCallbacks.Middle.Internal
	qualified as AllocationCallbacks

data CreateInfo mn a = CreateInfo {
	forall (mn :: Maybe (*)) (a :: Maybe (*)). CreateInfo mn a -> M mn
createInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)) (a :: Maybe (*)).
CreateInfo mn a -> CreateFlags
createInfoFlags :: CreateFlags,
	forall (mn :: Maybe (*)) (a :: Maybe (*)).
CreateInfo mn a -> Maybe (ApplicationInfo a)
createInfoApplicationInfo :: Maybe (ApplicationInfo a),
	forall (mn :: Maybe (*)) (a :: Maybe (*)).
CreateInfo mn a -> [Text]
createInfoEnabledLayerNames :: [T.Text],
	forall (mn :: Maybe (*)) (a :: Maybe (*)).
CreateInfo mn a -> [Text]
createInfoEnabledExtensionNames :: [T.Text] }

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

instance Default (CreateInfo 'Nothing a) where
	def :: CreateInfo 'Nothing a
def = CreateInfo {
		createInfoNext :: M 'Nothing
createInfoNext = M 'Nothing
TMaybe.N,
		createInfoFlags :: CreateFlags
createInfoFlags = CreateFlags
CreateFlagsZero,
		createInfoApplicationInfo :: Maybe (ApplicationInfo a)
createInfoApplicationInfo = Maybe (ApplicationInfo a)
forall a. Maybe a
Nothing,
		createInfoEnabledLayerNames :: [Text]
createInfoEnabledLayerNames = [],
		createInfoEnabledExtensionNames :: [Text]
createInfoEnabledExtensionNames = [] }

createInfoToCore :: (WithPoked (TMaybe.M mn), WithPoked (TMaybe.M n')) =>
	CreateInfo mn n' -> (Ptr C.CreateInfo -> IO a) -> IO ()
createInfoToCore :: forall (mn :: Maybe (*)) (n' :: Maybe (*)) a.
(WithPoked (M mn), WithPoked (M n')) =>
CreateInfo mn n' -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCore CreateInfo {
	createInfoNext :: forall (mn :: Maybe (*)) (a :: Maybe (*)). CreateInfo mn a -> M mn
createInfoNext = M mn
mnxt,
	createInfoFlags :: forall (mn :: Maybe (*)) (a :: Maybe (*)).
CreateInfo mn a -> CreateFlags
createInfoFlags = (\(CreateFlags Word32
f) -> Word32
f) -> Word32
flgs,
	createInfoApplicationInfo :: forall (mn :: Maybe (*)) (a :: Maybe (*)).
CreateInfo mn a -> Maybe (ApplicationInfo a)
createInfoApplicationInfo = Maybe (ApplicationInfo n')
mai,
	createInfoEnabledLayerNames :: forall (mn :: Maybe (*)) (a :: Maybe (*)).
CreateInfo mn a -> [Text]
createInfoEnabledLayerNames =
		(Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> ([Text] -> Int) -> [Text] -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Word32)
-> ([Text] -> [Text]) -> [Text] -> (Word32, [Text])
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')
&&& [Text] -> [Text]
forall a. a -> a
id) -> (Word32
elnc, [Text]
elns),
	createInfoEnabledExtensionNames :: forall (mn :: Maybe (*)) (a :: Maybe (*)).
CreateInfo mn a -> [Text]
createInfoEnabledExtensionNames =
		(Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> ([Text] -> Int) -> [Text] -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Word32)
-> ([Text] -> [Text]) -> [Text] -> (Word32, [Text])
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')
&&& [Text] -> [Text]
forall a. a -> a
id) -> (Word32
eenc, [Text]
eens) } 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 ()) -> 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') ->
	[Text] -> (Ptr CString -> IO ()) -> IO ()
forall a. [Text] -> (Ptr CString -> IO a) -> IO a
textListToCStringArray [Text]
elns \Ptr CString
pelna ->
	[Text] -> (Ptr CString -> IO ()) -> IO ()
forall a. [Text] -> (Ptr CString -> IO a) -> IO a
textListToCStringArray [Text]
eens \Ptr CString
peena ->
	let	ci :: PtrApplicationInfo -> CreateInfo
ci PtrApplicationInfo
pai = C.CreateInfo {
			createInfoSType :: ()
C.createInfoSType = (),
			createInfoPNext :: Ptr ()
C.createInfoPNext = Ptr ()
pnxt',
			createInfoFlags :: Word32
C.createInfoFlags = Word32
flgs,
			createInfoPApplicationInfo :: PtrApplicationInfo
C.createInfoPApplicationInfo = PtrApplicationInfo
pai,
			createInfoEnabledLayerCount :: Word32
C.createInfoEnabledLayerCount = Word32
elnc,
			createInfoPpEnabledLayerNames :: Ptr CString
C.createInfoPpEnabledLayerNames = Ptr CString
pelna,
			createInfoEnabledExtensionCount :: Word32
C.createInfoEnabledExtensionCount = Word32
eenc,
			createInfoPpEnabledExtensionNames :: Ptr CString
C.createInfoPpEnabledExtensionNames = Ptr CString
peena } in
	case Maybe (ApplicationInfo n')
mai of
		Maybe (ApplicationInfo n')
Nothing -> () () -> IO a -> IO ()
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CreateInfo -> (Ptr CreateInfo -> IO a) -> IO a
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked (PtrApplicationInfo -> CreateInfo
ci PtrApplicationInfo
forall a. Ptr a
NullPtr) Ptr CreateInfo -> IO a
f
		Just ApplicationInfo n'
ai -> ApplicationInfo n' -> (PtrApplicationInfo -> IO a) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
ApplicationInfo mn -> (PtrApplicationInfo -> IO a) -> IO ()
applicationInfoToCore ApplicationInfo n'
ai \PtrApplicationInfo
pai ->
			CreateInfo -> (Ptr CreateInfo -> IO a) -> IO a
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked (PtrApplicationInfo -> CreateInfo
ci PtrApplicationInfo
pai) Ptr CreateInfo -> IO a
f

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

create :: (WithPoked (TMaybe.M mn), WithPoked (TMaybe.M a)) =>
	CreateInfo mn a -> TPMaybe.M AllocationCallbacks.A mc -> IO I
create :: forall (mn :: Maybe (*)) (a :: Maybe (*)) (mc :: Maybe (*)).
(WithPoked (M mn), WithPoked (M a)) =>
CreateInfo mn a -> M A mc -> IO I
create CreateInfo mn a
ci M A mc
mac = I -> I
I (I -> I) -> IO I -> IO I
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr I -> IO I) -> IO I
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr I
pist -> do
	CreateInfo mn a -> (Ptr CreateInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) (n' :: Maybe (*)) a.
(WithPoked (M mn), WithPoked (M n')) =>
CreateInfo mn n' -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCore CreateInfo mn a
ci \Ptr CreateInfo
pcci ->
		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 -> do
			r <- Ptr CreateInfo -> Ptr A -> Ptr I -> IO Int32
C.create Ptr CreateInfo
pcci Ptr A
pac Ptr I
pist
			throwUnlessSuccess $ Result r
	Ptr I -> IO I
forall a. Storable a => Ptr a -> IO a
peek Ptr I
pist

destroy :: I -> TPMaybe.M AllocationCallbacks.A md -> IO ()
destroy :: forall (md :: Maybe (*)). I -> M A md -> IO ()
destroy (I I
cist) 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
$ I -> Ptr A -> IO ()
C.destroy I
cist

enumerateLayerProperties :: IO [LayerProperties]
enumerateLayerProperties :: IO [LayerProperties]
enumerateLayerProperties =
	(LayerProperties -> LayerProperties)
-> [LayerProperties] -> [LayerProperties]
forall a b. (a -> b) -> [a] -> [b]
map LayerProperties -> LayerProperties
layerPropertiesFromCore ([LayerProperties] -> [LayerProperties])
-> IO [LayerProperties] -> IO [LayerProperties]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr Word32 -> IO [LayerProperties]) -> IO [LayerProperties]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Word32
pLayerCount ->
	Ptr Word32 -> Ptr LayerProperties -> IO Int32
C.enumerateLayerProperties Ptr Word32
pLayerCount Ptr LayerProperties
forall a. Ptr a
NullPtr IO Int32 -> (Int32 -> IO [LayerProperties]) -> IO [LayerProperties]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int32
r ->
	Result -> IO ()
throwUnlessSuccess (Int32 -> Result
Result Int32
r) IO () -> IO Word32 -> IO Word32
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
pLayerCount IO Word32
-> (Word32 -> IO [LayerProperties]) -> IO [LayerProperties]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
layerCount) ->
	Int
-> (Ptr LayerProperties -> IO [LayerProperties])
-> IO [LayerProperties]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
layerCount \Ptr LayerProperties
pLayerProps ->
	Ptr Word32 -> Ptr LayerProperties -> IO Int32
C.enumerateLayerProperties Ptr Word32
pLayerCount Ptr LayerProperties
pLayerProps IO Int32 -> (Int32 -> IO [LayerProperties]) -> IO [LayerProperties]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int32
r' ->
	Result -> IO ()
throwUnlessSuccess (Int32 -> Result
Result Int32
r') IO () -> IO [LayerProperties] -> IO [LayerProperties]
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	Int -> Ptr LayerProperties -> IO [LayerProperties]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
layerCount Ptr LayerProperties
pLayerProps

enumerateExtensionProperties :: Maybe T.Text -> IO [ExtensionProperties]
enumerateExtensionProperties :: Maybe Text -> IO [ExtensionProperties]
enumerateExtensionProperties Maybe Text
mln =
	(ExtensionProperties -> ExtensionProperties)
-> [ExtensionProperties] -> [ExtensionProperties]
forall a b. (a -> b) -> [a] -> [b]
map ExtensionProperties -> ExtensionProperties
extensionPropertiesFromCore ([ExtensionProperties] -> [ExtensionProperties])
-> IO [ExtensionProperties] -> IO [ExtensionProperties]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe Text
mln of
		Maybe Text
Nothing -> CString -> IO [ExtensionProperties]
go CString
forall a. Ptr a
NullPtr
		Just Text
ln -> Text
-> (CString -> IO [ExtensionProperties])
-> IO [ExtensionProperties]
forall a. Text -> (CString -> IO a) -> IO a
textToCString Text
ln CString -> IO [ExtensionProperties]
go
	where go :: CString -> IO [ExtensionProperties]
go CString
cln = (Ptr Word32 -> IO [ExtensionProperties])
-> IO [ExtensionProperties]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Word32
pExtCount ->
		CString -> Ptr Word32 -> Ptr ExtensionProperties -> IO Int32
C.enumerateExtensionProperties CString
cln Ptr Word32
pExtCount Ptr ExtensionProperties
forall a. Ptr a
NullPtr IO Int32
-> (Int32 -> IO [ExtensionProperties]) -> IO [ExtensionProperties]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int32
r ->
		Result -> IO ()
throwUnlessSuccess (Int32 -> Result
Result Int32
r) IO () -> IO Word32 -> IO Word32
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
		Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
pExtCount IO Word32
-> (Word32 -> IO [ExtensionProperties]) -> IO [ExtensionProperties]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
extCount) ->
		Int
-> (Ptr ExtensionProperties -> IO [ExtensionProperties])
-> IO [ExtensionProperties]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
extCount \Ptr ExtensionProperties
pExts ->
		CString -> Ptr Word32 -> Ptr ExtensionProperties -> IO Int32
C.enumerateExtensionProperties CString
cln Ptr Word32
pExtCount Ptr ExtensionProperties
pExts IO Int32
-> (Int32 -> IO [ExtensionProperties]) -> IO [ExtensionProperties]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int32
r' ->
		Result -> IO ()
throwUnlessSuccess (Int32 -> Result
Result Int32
r') IO () -> IO [ExtensionProperties] -> IO [ExtensionProperties]
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
		Int -> Ptr ExtensionProperties -> IO [ExtensionProperties]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
extCount Ptr ExtensionProperties
pExts