{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE GADTs, TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
module Gpu.Vulkan.Pipeline.ShaderStage.Internal (
CreateInfo(..),
CreateInfoListToMiddle(..), createInfoToMiddle,
DestroyShaderModuleList(..), destroyShaderModule,
allocationCallbacksListFromCreateInfoList
) where
import Foreign.Storable.PeekPoke
import Data.Kind
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.TypeLevel.Tuple.Uncurry
import Data.TypeLevel.Tuple.MapIndex qualified as TMapIndex
import qualified Data.HeteroParList as HeteroParList
import Data.HeteroParList (pattern (:**))
import Data.HeteroParList.Tuple qualified as HeteroParList
import Language.SpirV.ShaderKind
import qualified Data.ByteString as BS
import Gpu.Vulkan.Enum
import Gpu.Vulkan.AllocationCallbacks.Type qualified as AllocationCallbacks
import Gpu.Vulkan.Pipeline.ShaderStage.Enum
import qualified Gpu.Vulkan.Device.Type as Device
import qualified Gpu.Vulkan.ShaderModule.Internal as ShaderModule
import qualified Gpu.Vulkan.Pipeline.ShaderStage.Middle as M
data CreateInfo mn mnsm sknd mac vs = CreateInfo {
forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs -> M mn
createInfoNext :: TMaybe.M mn,
forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs -> CreateFlags
createInfoFlags :: CreateFlags,
forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs -> ShaderStageFlagBits
createInfoStage :: ShaderStageFlagBits,
forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs
-> (CreateInfo mnsm sknd, M (U2 A) mac)
createInfoModule :: (
ShaderModule.CreateInfo mnsm sknd, TPMaybe.M (U2 AllocationCallbacks.A) mac ),
forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs -> ByteString
createInfoName :: BS.ByteString,
forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs -> L vs
createInfoSpecializationInfo :: HeteroParList.L vs }
allocationCallbacksFromCreateInfo ::
CreateInfo mn mnsm sknd mac vs ->
TPMaybe.M (U2 AllocationCallbacks.A) mac
allocationCallbacksFromCreateInfo :: forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs -> M (U2 A) mac
allocationCallbacksFromCreateInfo CreateInfo { createInfoModule :: forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs
-> (CreateInfo mnsm sknd, M (U2 A) mac)
createInfoModule = (CreateInfo mnsm sknd
_, M (U2 A) mac
mac) } =
M (U2 A) mac
mac
allocationCallbacksListFromCreateInfoList :: HeteroParList.Map3_5 cias =>
HeteroParList.PL (U5 CreateInfo) cias ->
HeteroParList.PL
(TPMaybe.M (U2 AllocationCallbacks.A)) (TMapIndex.M3_5 cias)
allocationCallbacksListFromCreateInfoList :: forall (cias :: [(Maybe (*), Maybe (*), ShaderKind, Maybe (*, *),
[*])]).
Map3_5 cias =>
PL (U5 CreateInfo) cias -> PL (M (U2 A)) (M3_5 cias)
allocationCallbacksListFromCreateInfoList =
(forall (a :: Maybe (*)) (b :: Maybe (*)) (c :: ShaderKind)
(d :: Maybe (*, *)) (e :: [*]).
U5 CreateInfo '(a, b, c, d, e) -> M (U2 A) d)
-> PL (U5 CreateInfo) cias -> PL (M (U2 A)) (M3_5 cias)
forall k0 k1 k2 k3 k4 (ss :: [(k0, k1, k2, k3, k4)])
(t :: (k0, k1, k2, k3, k4) -> *) (t' :: k3 -> *).
Map3_5 ss =>
(forall (a :: k0) (b :: k1) (c :: k2) (d :: k3) (e :: k4).
t '(a, b, c, d, e) -> t' d)
-> PL t ss -> PL t' (M3_5 ss)
forall (t :: (Maybe (*), Maybe (*), ShaderKind, Maybe (*, *), [*])
-> *)
(t' :: Maybe (*, *) -> *).
(forall (a :: Maybe (*)) (b :: Maybe (*)) (c :: ShaderKind)
(d :: Maybe (*, *)) (e :: [*]).
t '(a, b, c, d, e) -> t' d)
-> PL t cias -> PL t' (M3_5 cias)
HeteroParList.map3_5 (CreateInfo a b c d e -> M (U2 A) d
forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs -> M (U2 A) mac
allocationCallbacksFromCreateInfo (CreateInfo a b c d e -> M (U2 A) d)
-> (U5 CreateInfo '(a, b, c, d, e) -> CreateInfo a b c d e)
-> U5 CreateInfo '(a, b, c, d, e)
-> M (U2 A) d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U5 CreateInfo '(a, b, c, d, e) -> CreateInfo a b c d e
forall {k1} {k2} {k3} {k4} {k5}
(t :: k1 -> k2 -> k3 -> k4 -> k5 -> *) (s1 :: k1) (s2 :: k2)
(s3 :: k3) (s4 :: k4) (s5 :: k5).
U5 t '(s1, s2, s3, s4, s5) -> t s1 s2 s3 s4 s5
unU5)
createInfoToMiddle ::
(WithPoked (TMaybe.M mnsm), AllocationCallbacks.ToMiddle mac) =>
Device.D ds -> CreateInfo n mnsm sknd mac vs ->
IO (M.CreateInfo n sknd vs)
createInfoToMiddle :: forall (mnsm :: Maybe (*)) (mac :: Maybe (*, *)) ds
(n :: Maybe (*)) (sknd :: ShaderKind) (vs :: [*]).
(WithPoked (M mnsm), ToMiddle mac) =>
D ds -> CreateInfo n mnsm sknd mac vs -> IO (CreateInfo n sknd vs)
createInfoToMiddle D ds
dvc CreateInfo {
createInfoNext :: forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs -> M mn
createInfoNext = M n
mnxt,
createInfoFlags :: forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs -> CreateFlags
createInfoFlags = CreateFlags
flgs,
createInfoStage :: forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs -> ShaderStageFlagBits
createInfoStage = ShaderStageFlagBits
stg,
createInfoModule :: forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs
-> (CreateInfo mnsm sknd, M (U2 A) mac)
createInfoModule = (CreateInfo mnsm sknd
mdl, M (U2 A) mac
mac),
createInfoName :: forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs -> ByteString
createInfoName = ByteString
nm,
createInfoSpecializationInfo :: forall (mn :: Maybe (*)) (mnsm :: Maybe (*)) (sknd :: ShaderKind)
(mac :: Maybe (*, *)) (vs :: [*]).
CreateInfo mn mnsm sknd mac vs -> L vs
createInfoSpecializationInfo = L vs
spi
} = do
mdl' <- D ds -> CreateInfo mnsm sknd -> M (U2 A) mac -> IO (S sknd)
forall (mn :: Maybe (*)) (mscc :: Maybe (*, *)) sd
(sknd :: ShaderKind).
(WithPoked (M mn), ToMiddle mscc) =>
D sd -> CreateInfo mn sknd -> M (U2 A) mscc -> IO (S sknd)
ShaderModule.create D ds
dvc CreateInfo mnsm sknd
mdl M (U2 A) mac
mac
pure M.CreateInfo {
M.createInfoNext = mnxt,
M.createInfoFlags = flgs,
M.createInfoStage = stg,
M.createInfoModule = mdl',
M.createInfoName = nm,
M.createInfoSpecializationInfo = spi }
class DestroyShaderModuleList (MiddleArgs cias) (TMapIndex.M3_5 cias) =>
CreateInfoListToMiddle cias where
type MiddleArgs cias :: [(Maybe Type, ShaderKind, [Type])]
createInfoListToMiddle ::
Device.D ds ->
HeteroParList.PL (U5 CreateInfo) cias ->
IO (HeteroParList.PL (U3 M.CreateInfo) (MiddleArgs cias))
instance CreateInfoListToMiddle '[] where
type MiddleArgs '[] = '[]
createInfoListToMiddle :: forall ds.
D ds
-> PL (U5 CreateInfo) '[]
-> IO (PL (U3 CreateInfo) (MiddleArgs '[]))
createInfoListToMiddle D ds
_ PL (U5 CreateInfo) '[]
HeteroParList.Nil = PL (U3 CreateInfo) '[] -> IO (PL (U3 CreateInfo) '[])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PL (U3 CreateInfo) '[]
forall {k} (t :: k -> *). PL t '[]
HeteroParList.Nil
instance (
WithPoked (TMaybe.M mnsm), AllocationCallbacks.ToMiddle mac,
CreateInfoListToMiddle cias ) =>
CreateInfoListToMiddle ('(n, mnsm, sknd, mac, vs) ': cias) where
type MiddleArgs ('(n, mnsm, sknd, mac, vs) ': cias) =
'(n, sknd, vs) ': MiddleArgs cias
createInfoListToMiddle :: forall ds.
D ds
-> PL (U5 CreateInfo) ('(n, mnsm, sknd, mac, vs) : cias)
-> IO
(PL
(U3 CreateInfo) (MiddleArgs ('(n, mnsm, sknd, mac, vs) : cias)))
createInfoListToMiddle D ds
dvc (U5 CreateInfo s1 s2 s3 s4 s5
ci :** PL (U5 CreateInfo) ss1
cis) = U3 CreateInfo '(s1, s3, s5)
-> PL (U3 CreateInfo) (MiddleArgs cias)
-> PL (U3 CreateInfo) ('(s1, s3, s5) : MiddleArgs cias)
forall {k} (t :: k -> *) (s :: k) (ss1 :: [k]).
t s -> PL t ss1 -> PL t (s : ss1)
(:**)
(U3 CreateInfo '(s1, s3, s5)
-> PL (U3 CreateInfo) (MiddleArgs cias)
-> PL (U3 CreateInfo) ('(s1, s3, s5) : MiddleArgs cias))
-> IO (U3 CreateInfo '(s1, s3, s5))
-> IO
(PL (U3 CreateInfo) (MiddleArgs cias)
-> PL (U3 CreateInfo) ('(s1, s3, s5) : MiddleArgs cias))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CreateInfo s1 s3 s5 -> U3 CreateInfo '(s1, s3, s5)
forall {k} {k1} {k2} (t :: k -> k1 -> k2 -> *) (s1 :: k) (s2 :: k1)
(s3 :: k2).
t s1 s2 s3 -> U3 t '(s1, s2, s3)
U3 (CreateInfo s1 s3 s5 -> U3 CreateInfo '(s1, s3, s5))
-> IO (CreateInfo s1 s3 s5) -> IO (U3 CreateInfo '(s1, s3, s5))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D ds -> CreateInfo s1 s2 s3 s4 s5 -> IO (CreateInfo s1 s3 s5)
forall (mnsm :: Maybe (*)) (mac :: Maybe (*, *)) ds
(n :: Maybe (*)) (sknd :: ShaderKind) (vs :: [*]).
(WithPoked (M mnsm), ToMiddle mac) =>
D ds -> CreateInfo n mnsm sknd mac vs -> IO (CreateInfo n sknd vs)
createInfoToMiddle D ds
dvc CreateInfo s1 s2 s3 s4 s5
ci)
IO
(PL (U3 CreateInfo) (MiddleArgs cias)
-> PL (U3 CreateInfo) ('(s1, s3, s5) : MiddleArgs cias))
-> IO (PL (U3 CreateInfo) (MiddleArgs cias))
-> IO (PL (U3 CreateInfo) ('(s1, s3, s5) : MiddleArgs cias))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D ds
-> PL (U5 CreateInfo) ss1
-> IO (PL (U3 CreateInfo) (MiddleArgs ss1))
forall (cias :: [(Maybe (*), Maybe (*), ShaderKind, Maybe (*, *),
[*])])
ds.
CreateInfoListToMiddle cias =>
D ds
-> PL (U5 CreateInfo) cias
-> IO (PL (U3 CreateInfo) (MiddleArgs cias))
forall ds.
D ds
-> PL (U5 CreateInfo) ss1
-> IO (PL (U3 CreateInfo) (MiddleArgs ss1))
createInfoListToMiddle D ds
dvc PL (U5 CreateInfo) ss1
cis
class DestroyShaderModuleList cias macs where
destroyShaderModuleList ::
Device.D sd -> HeteroParList.PL (U3 M.CreateInfo) cias ->
HeteroParList.PL (TPMaybe.M (U2 AllocationCallbacks.A)) macs ->
IO ()
instance DestroyShaderModuleList '[] '[] where
destroyShaderModuleList :: forall sd.
D sd -> PL (U3 CreateInfo) '[] -> PL (M (U2 A)) '[] -> IO ()
destroyShaderModuleList D sd
_ PL (U3 CreateInfo) '[]
HeteroParList.Nil PL (M (U2 A)) '[]
HeteroParList.Nil = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance (
AllocationCallbacks.ToMiddle mac,
DestroyShaderModuleList cias macs ) =>
DestroyShaderModuleList (cia ': cias) (mac ': macs) where
destroyShaderModuleList :: forall sd.
D sd
-> PL (U3 CreateInfo) (cia : cias)
-> PL (M (U2 A)) (mac : macs)
-> IO ()
destroyShaderModuleList D sd
dvc (U3 CreateInfo s1 s2 s3
cim :** PL (U3 CreateInfo) ss1
cims) (M (U2 A) s
mac :** PL (M (U2 A)) ss1
macs) =
D sd -> CreateInfo s1 s2 s3 -> M (U2 A) s -> IO ()
forall (mac :: Maybe (*, *)) sd (n :: Maybe (*))
(sknd :: ShaderKind) (vs :: [*]).
ToMiddle mac =>
D sd -> CreateInfo n sknd vs -> M (U2 A) mac -> IO ()
destroyShaderModule D sd
dvc CreateInfo s1 s2 s3
cim M (U2 A) s
mac IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
D sd -> PL (U3 CreateInfo) ss1 -> PL (M (U2 A)) ss1 -> IO ()
forall (cias :: [(Maybe (*), ShaderKind, [*])])
(macs :: [Maybe (*, *)]) sd.
DestroyShaderModuleList cias macs =>
D sd -> PL (U3 CreateInfo) cias -> PL (M (U2 A)) macs -> IO ()
forall sd.
D sd -> PL (U3 CreateInfo) ss1 -> PL (M (U2 A)) ss1 -> IO ()
destroyShaderModuleList D sd
dvc PL (U3 CreateInfo) ss1
cims PL (M (U2 A)) ss1
macs
destroyShaderModule :: AllocationCallbacks.ToMiddle mac =>
Device.D sd -> M.CreateInfo n sknd vs ->
TPMaybe.M (U2 AllocationCallbacks.A) mac -> IO ()
destroyShaderModule :: forall (mac :: Maybe (*, *)) sd (n :: Maybe (*))
(sknd :: ShaderKind) (vs :: [*]).
ToMiddle mac =>
D sd -> CreateInfo n sknd vs -> M (U2 A) mac -> IO ()
destroyShaderModule D sd
dvc M.CreateInfo { createInfoModule :: forall (mn :: Maybe (*)) (sknd :: ShaderKind) (sivs :: [*]).
CreateInfo mn sknd sivs -> S sknd
M.createInfoModule = S sknd
mmdl } M (U2 A) mac
mac =
D sd -> S sknd -> M (U2 A) mac -> IO ()
forall (mscc :: Maybe (*, *)) sd (sknd :: ShaderKind).
ToMiddle mscc =>
D sd -> S sknd -> M (U2 A) mscc -> IO ()
ShaderModule.destroy D sd
dvc S sknd
mmdl M (U2 A) mac
mac