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

module Gpu.Vulkan.Device.GroupDevice.Middle.Internal where

import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Storable
import Foreign.Storable.PeekPoke
import Control.Arrow
import Data.TypeLevel.Maybe qualified as TMaybe

import Gpu.Vulkan.PhysicalDevice.Middle.Internal qualified as PhysicalDevice
import Gpu.Vulkan.Device.GroupDevice.Core qualified as C

data CreateInfo mn = CreateInfo {
	forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). CreateInfo mn -> [P]
createInfoPhysicalDevices :: [PhysicalDevice.P] }

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

instance WithPoked (TMaybe.M mn) => WithPoked (CreateInfo mn) where
	withPoked' :: forall b.
CreateInfo mn -> (forall s. PtrS s (CreateInfo mn) -> IO b) -> IO b
withPoked' CreateInfo mn
ci forall s. PtrS s (CreateInfo mn) -> IO b
f = (Ptr CreateInfo -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr CreateInfo
pci -> do
		CreateInfo mn -> (CreateInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (CreateInfo -> IO a) -> IO ()
createInfoToCore CreateInfo mn
ci ((CreateInfo -> IO ()) -> IO ()) -> (CreateInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CreateInfo
cci -> Ptr CreateInfo -> CreateInfo -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CreateInfo
pci CreateInfo
cci
		PtrS Any (CreateInfo mn) -> IO b
forall s. PtrS s (CreateInfo mn) -> IO b
f (PtrS Any (CreateInfo mn) -> IO b)
-> (Ptr (CreateInfo mn) -> PtrS Any (CreateInfo mn))
-> Ptr (CreateInfo mn)
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (CreateInfo mn) -> PtrS Any (CreateInfo mn)
forall a s. Ptr a -> PtrS s a
ptrS (Ptr (CreateInfo mn) -> IO b) -> Ptr (CreateInfo mn) -> IO b
forall a b. (a -> b) -> a -> b
$ Ptr CreateInfo -> Ptr (CreateInfo mn)
forall a b. Ptr a -> Ptr b
castPtr Ptr CreateInfo
pci

createInfoToCore :: WithPoked (TMaybe.M mn) =>
	CreateInfo mn -> (C.CreateInfo -> IO a) -> IO ()
createInfoToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (CreateInfo -> IO a) -> IO ()
createInfoToCore CreateInfo {
	createInfoNext :: forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext = M mn
mnxt,
	createInfoPhysicalDevices :: forall (mn :: Maybe (*)). CreateInfo mn -> [P]
createInfoPhysicalDevices = ([P] -> [P]
forall a. a -> a
id ([P] -> [P]) -> ([P] -> Int) -> [P] -> ([P], Int)
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')
&&& [P] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) -> ([P]
pds, Int
pdc)
	} CreateInfo -> IO a
f =
	String -> IO ()
putStrLn String
"createInfoToCore begin" IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	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') ->
	Int -> (Ptr P -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
pdc \Ptr P
ppds -> do
		Ptr P -> [P] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr P
ppds (P -> P
phdToCore (P -> P) -> [P] -> [P]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [P]
pds)
		() () -> IO a -> IO ()
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CreateInfo -> IO a
f C.CreateInfo {
			createInfoSType :: ()
C.createInfoSType = (),
			createInfoPNext :: Ptr ()
C.createInfoPNext = Ptr ()
pnxt',
			createInfoPhysicalDeviceCount :: Word32
C.createInfoPhysicalDeviceCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pdc,
			createInfoPPhysicalDevices :: Ptr P
C.createInfoPPhysicalDevices = Ptr P
ppds }
	where
	phdToCore :: P -> P
phdToCore (PhysicalDevice.P P
p) = P
p