{-# 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.PNext.Middle.Internal (

	-- * STRUCT COMMON

	StructCommon(..), structCommonFromCore,

	-- * SET AND READ CHAIN

	Typeable(..), FindChainAll(..), ReadChain(..), Nextable(..)

	) 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 HPList

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

import Data.TypeLevel.Maybe qualified as TMaybe

-- STRUCT COMMON

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)

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

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 }

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 }

-- TYPEABLE

class Peek n => Typeable n where structureType :: StructureType

-- FIND PNEXT CHAIN ALL

class FindChainAll ns where findChainAll :: Ptr () -> IO (HPList.PL Maybe ns)

instance FindChainAll '[] where findChainAll :: Ptr () -> IO (PL Maybe '[])
findChainAll 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 '[]
HPList.Nil

instance (Typeable n, FindChainAll ns) => FindChainAll (n ': ns) where
	findChainAll :: Ptr () -> IO (PL Maybe (n : ns))
findChainAll 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. Typeable n => Ptr () -> IO (Maybe n)
findChain 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 :: [*]). FindChainAll ns => Ptr () -> IO (PL Maybe ns)
findChainAll Ptr ()
p

findChain :: forall n . Typeable n => Ptr () -> IO (Maybe n)
findChain :: forall n. Typeable n => Ptr () -> IO (Maybe n)
findChain 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
findChain Ptr ()
p = Ptr StructCommon -> IO StructCommon
forall a. Peek a => Ptr a -> IO a
peek' (Ptr () -> Ptr StructCommon
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
p) IO StructCommon -> (StructCommon -> IO (Maybe n)) -> IO (Maybe n)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \StructCommon
sc ->
	if StructCommon -> StructureType
structCommonSType StructCommon
sc StructureType -> StructureType -> Bool
forall a. Eq a => a -> a -> Bool
== forall n. Typeable n => StructureType
structureType @n
		then n -> Maybe n
forall a. a -> Maybe a
Just (n -> Maybe n) -> IO n -> IO (Maybe n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr n -> IO n
forall a. Peek a => Ptr a -> IO a
peek' (Ptr () -> Ptr n
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
p)
		else Ptr () -> IO (Maybe n)
forall n. Typeable n => Ptr () -> IO (Maybe n)
findChain (Ptr () -> IO (Maybe n)) -> Ptr () -> IO (Maybe n)
forall a b. (a -> b) -> a -> b
$ StructCommon -> Ptr ()
structCommonPNext StructCommon
sc

-- READ CHAIN

class ReadChain mn where
	clearedChain :: (Ptr () -> IO a) -> IO a
	readChain :: Ptr () -> IO (TMaybe.M mn)

instance ReadChain '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); readChain :: Ptr () -> IO (M 'Nothing)
readChain 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, ReadChain mnn) => ReadChain ('Just (n (mnn))) where
	clearedChain :: forall a. (Ptr () -> IO a) -> IO a
clearedChain Ptr () -> IO a
f = forall (mn :: Maybe (*)) a.
ReadChain mn =>
(Ptr () -> IO a) -> IO a
clearedChain @mnn \Ptr ()
np -> do
		p <- Int -> IO (Ptr StructCommon)
forall a. Int -> IO (Ptr a)
callocBytes (Int -> IO (Ptr StructCommon)) -> Int -> IO (Ptr StructCommon)
forall a b. (a -> b) -> a -> b
$ forall (n :: Maybe (*) -> *). Nextable n => Int
nextableSize @n
		poke' p StructCommon {
			structCommonSType = nextableType @n,
			structCommonPNext = np }
		f (castPtr p) <* free p
	readChain :: Ptr () -> IO (M ('Just (n mnn)))
readChain Ptr ()
p =
		n mnn -> M ('Just (n mnn))
forall a. a -> M ('Just a)
TMaybe.J (n mnn -> M ('Just (n mnn)))
-> IO (n mnn) -> IO (M ('Just (n mnn)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr () -> M mnn -> IO (n mnn)
forall (mn' :: Maybe (*)). Ptr () -> M mn' -> IO (n mn')
forall (n :: Maybe (*) -> *) (mn' :: Maybe (*)).
Nextable n =>
Ptr () -> M mn' -> IO (n mn')
createNextable Ptr ()
p (M mnn -> IO (n mnn)) -> IO (M mnn) -> IO (n mnn)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr () -> IO (M mnn)
forall (mn :: Maybe (*)). ReadChain mn => Ptr () -> IO (M mn)
readChain (Ptr () -> IO (M mnn)) -> IO (Ptr ()) -> IO (M mnn)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (n :: Maybe (*) -> *). Nextable n => Ptr () -> IO (Ptr ())
nextPtr @n Ptr ()
p)
	
class Nextable (n :: Maybe Type -> Type) where
	nextableSize :: Int
	nextableType :: StructureType; nextPtr :: Ptr () -> IO (Ptr ())
	createNextable :: Ptr () -> TMaybe.M mn' -> IO (n mn')