{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures, TypeOperators #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.PNextOld.Middle.Internal (

	-- * STRUCT COMMON

	StructCommon(..), structCommonFromCore,

	-- * FIND P NEXT CHAIN ALL

	FindPNextChainAll(..), Nextable(..),

	FindPNextChainAll'(..), Nextable'(..),

	-- * OTHERS

--	ClearedChain(..)

	) where

import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Storable
import Foreign.Storable.PeekPoke
import Data.Kind
import Data.HeteroParList (pattern (:**))
import Data.HeteroParList qualified as HeteroParList

import Gpu.Vulkan.Enum
import Gpu.Vulkan.Core qualified as C

import Data.TypeLevel.Maybe qualified as TMaybe

data StructCommon = StructCommon {
	StructCommon -> StructureType
structCommonSType :: StructureType,
	StructCommon -> Ptr ()
structCommonPNext :: Ptr () }
	deriving Int -> StructCommon -> ShowS
[StructCommon] -> ShowS
StructCommon -> String
(Int -> StructCommon -> ShowS)
-> (StructCommon -> String)
-> ([StructCommon] -> ShowS)
-> Show StructCommon
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StructCommon -> ShowS
showsPrec :: Int -> StructCommon -> ShowS
$cshow :: StructCommon -> String
show :: StructCommon -> String
$cshowList :: [StructCommon] -> ShowS
showList :: [StructCommon] -> ShowS
Show

instance Peek StructCommon where
	peek' :: Ptr StructCommon -> IO StructCommon
peek' Ptr StructCommon
p = StructCommon -> StructCommon
structCommonFromCore (StructCommon -> StructCommon)
-> IO StructCommon -> IO StructCommon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr StructCommon -> IO StructCommon
forall a. Storable a => Ptr a -> IO a
peek (Ptr StructCommon -> Ptr StructCommon
forall a b. Ptr a -> Ptr b
castPtr Ptr StructCommon
p)

structCommonFromCore :: C.StructCommon -> StructCommon
structCommonFromCore :: StructCommon -> StructCommon
structCommonFromCore C.StructCommon {
	structCommonSType :: StructCommon -> Word32
C.structCommonSType = Word32
stp,
	structCommonPNext :: StructCommon -> Ptr ()
C.structCommonPNext = Ptr ()
pn } = StructCommon {
	structCommonSType :: StructureType
structCommonSType = Word32 -> StructureType
StructureType Word32
stp,
	structCommonPNext :: Ptr ()
structCommonPNext = Ptr ()
pn }

instance Poke StructCommon where
	poke' :: Ptr StructCommon -> StructCommon -> IO ()
poke' Ptr StructCommon
p = Ptr StructCommon -> StructCommon -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr StructCommon -> Ptr StructCommon
forall a b. Ptr a -> Ptr b
castPtr Ptr StructCommon
p) (StructCommon -> IO ())
-> (StructCommon -> StructCommon) -> StructCommon -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructCommon -> StructCommon
structCommonToCore

structCommonToCore :: StructCommon -> C.StructCommon
structCommonToCore :: StructCommon -> StructCommon
structCommonToCore StructCommon {
	structCommonSType :: StructCommon -> StructureType
structCommonSType = StructureType Word32
stp,
	structCommonPNext :: StructCommon -> Ptr ()
structCommonPNext = Ptr ()
pn } = C.StructCommon {
	structCommonSType :: Word32
C.structCommonSType = Word32
stp,
	structCommonPNext :: Ptr ()
C.structCommonPNext = Ptr ()
pn }

class Peek n => Nextable n where nextableType :: StructureType

class FindPNextChainAll ns where
	findPNextChainAll :: Ptr () -> IO (HeteroParList.PL Maybe ns)

instance FindPNextChainAll '[] where
	findPNextChainAll :: Ptr () -> IO (PL Maybe '[])
findPNextChainAll Ptr ()
_ = PL Maybe '[] -> IO (PL Maybe '[])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PL Maybe '[]
forall {k} (t :: k -> *). PL t '[]
HeteroParList.Nil

instance (Nextable n, FindPNextChainAll ns) =>
	FindPNextChainAll (n ': ns) where
	findPNextChainAll :: Ptr () -> IO (PL Maybe (n : ns))
findPNextChainAll Ptr ()
p =
		Maybe n -> PL Maybe ns -> PL Maybe (n : ns)
forall {k} (t :: k -> *) (s :: k) (ss1 :: [k]).
t s -> PL t ss1 -> PL t (s : ss1)
(:**) (Maybe n -> PL Maybe ns -> PL Maybe (n : ns))
-> IO (Maybe n) -> IO (PL Maybe ns -> PL Maybe (n : ns))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr () -> IO (Maybe n)
forall n. Nextable n => Ptr () -> IO (Maybe n)
findPNextChain Ptr ()
p IO (PL Maybe ns -> PL Maybe (n : ns))
-> IO (PL Maybe ns) -> IO (PL Maybe (n : ns))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr () -> IO (PL Maybe ns)
forall (ns :: [*]).
FindPNextChainAll ns =>
Ptr () -> IO (PL Maybe ns)
findPNextChainAll Ptr ()
p

findPNextChain :: forall n . Nextable n => Ptr () -> IO (Maybe n)
findPNextChain :: forall n. Nextable n => Ptr () -> IO (Maybe n)
findPNextChain Ptr ()
NullPtr = Maybe n -> IO (Maybe n)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe n
forall a. Maybe a
Nothing
findPNextChain Ptr ()
p = do
	sc <- Ptr StructCommon -> IO StructCommon
forall a. Peek a => Ptr a -> IO a
peek' (Ptr StructCommon -> IO StructCommon)
-> Ptr StructCommon -> IO StructCommon
forall a b. (a -> b) -> a -> b
$ Ptr () -> Ptr StructCommon
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
p
	putStrLn "findPNextChain"
	putStrLn $ "\tthis type    : " ++ show (structCommonSType sc)
	putStrLn $ "\tnextable type: " ++ show (nextableType @n)
	if structCommonSType sc == nextableType @n
	then Just <$> peek' (castPtr p)
	else findPNextChain $ structCommonPNext sc

class ClearedChain (ns :: [Type]) where
	clearedChain :: (Ptr () -> IO a) -> IO a

instance ClearedChain '[] where clearedChain :: forall a. (Ptr () -> IO a) -> IO a
clearedChain = ((Ptr () -> IO a) -> Ptr () -> IO a
forall a b. (a -> b) -> a -> b
$ Ptr ()
forall a. Ptr a
nullPtr)

instance (Sizable n, Nextable n, ClearedChain ns) => ClearedChain (n ': ns) where
	clearedChain :: forall a. (Ptr () -> IO a) -> IO a
clearedChain Ptr () -> IO a
f = forall (ns :: [*]) a. ClearedChain ns => (Ptr () -> IO a) -> IO a
clearedChain @ns \Ptr ()
p -> do
		let	sc :: StructCommon
sc = StructCommon {
				structCommonSType :: StructureType
structCommonSType = forall n. Nextable n => StructureType
nextableType @n,
				structCommonPNext :: Ptr ()
structCommonPNext = Ptr ()
p }
		p' <- Int -> IO (Ptr StructCommon)
forall a. Int -> IO (Ptr a)
callocBytes (forall a. Sizable a => Int
sizeOf' @n)
		poke' p' sc
		rslt <- f $ castPtr p'
		free p'
		pure rslt

class FindPNextChainAll' mn where
	clearedChain' :: (Ptr () -> IO a) -> IO a
	findPNextChainAll' :: Ptr () -> IO (TMaybe.M mn)

instance FindPNextChainAll' 'Nothing where
	clearedChain' :: forall a. (Ptr () -> IO a) -> IO a
clearedChain' = ((Ptr () -> IO a) -> Ptr () -> IO a
forall a b. (a -> b) -> a -> b
$ Ptr ()
forall a. Ptr a
nullPtr)
	findPNextChainAll' :: Ptr () -> IO (M 'Nothing)
findPNextChainAll' Ptr ()
_ = M 'Nothing -> IO (M 'Nothing)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure M 'Nothing
TMaybe.N

instance (Nextable' n, FindPNextChainAll' mn') =>
	FindPNextChainAll' ('Just (n (mn'))) where
	clearedChain' :: forall a. (Ptr () -> IO a) -> IO a
clearedChain' Ptr () -> IO a
f = forall (mn :: Maybe (*)) a.
FindPNextChainAll' mn =>
(Ptr () -> IO a) -> IO a
clearedChain' @mn' \Ptr ()
p -> do
		let	sc :: StructCommon
sc = StructCommon {
				structCommonSType :: StructureType
structCommonSType = forall (n :: Maybe (*) -> *). Nextable' n => StructureType
nextableType' @n,
				structCommonPNext :: Ptr ()
structCommonPNext = Ptr ()
p }
		p' <- Int -> IO (Ptr StructCommon)
forall a. Int -> IO (Ptr a)
callocBytes (forall (n :: Maybe (*) -> *). Nextable' n => Int
nextableSize @n)
		poke' p' sc
		rslt <- f $ castPtr p'
		free p'
		pure rslt
	findPNextChainAll' :: Ptr () -> IO (M ('Just (n mn')))
findPNextChainAll' Ptr ()
p = do
		p' <- forall (n :: Maybe (*) -> *). Nextable' n => Ptr () -> IO (Ptr ())
nextPtr @n Ptr ()
p
		mn' <- findPNextChainAll' p'
		TMaybe.J <$> createNextable p mn'
	
class Nextable' (n :: Maybe Type -> Type) where
	nextableSize :: Int
	nextableType' :: StructureType
	nextPtr :: Ptr () -> IO (Ptr ())
	createNextable :: Ptr () -> TMaybe.M mn' -> IO (n mn')