module Engine.Vulkan.Pipeline
  ( Pipeline(..)
  , allocateWith
  , Specialization
  ) where

import RIO

import Data.Kind (Type)
import Data.Tagged (Tagged(..))
import Data.Vector qualified as Vector
import GHC.Stack (withFrozenCallStack)
import UnliftIO.Resource qualified as Resource
import Vulkan.Core10 qualified as Vk

import Engine.Vulkan.Types (DsLayouts, MonadVulkan, getDevice)

data Pipeline (dsl :: [Type]) vertices instances = Pipeline
  { forall (dsl :: [*]) vertices instances.
Pipeline dsl vertices instances -> Pipeline
pipeline     :: Vk.Pipeline
  , forall (dsl :: [*]) vertices instances.
Pipeline dsl vertices instances -> Tagged dsl PipelineLayout
pLayout      :: Tagged dsl Vk.PipelineLayout
  , forall (dsl :: [*]) vertices instances.
Pipeline dsl vertices instances -> Tagged dsl DsLayouts
pDescLayouts :: Tagged dsl DsLayouts
  }

allocateWith
  :: ( MonadVulkan env m
     , Resource.MonadResource m
     )
  => m (Pipeline dsl vertices instances)
  -> m (Resource.ReleaseKey, Pipeline dsl vertices instances)
allocateWith :: forall env (m :: * -> *) (dsl :: [*]) vertices instances.
(MonadVulkan env m, MonadResource m) =>
m (Pipeline dsl vertices instances)
-> m (ReleaseKey, Pipeline dsl vertices instances)
allocateWith m (Pipeline dsl vertices instances)
action = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack do
  Pipeline dsl vertices instances
res <- m (Pipeline dsl vertices instances)
action
  Device
device <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a. HasVulkan a => a -> Device
getDevice
  ReleaseKey
key <- forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register forall a b. (a -> b) -> a -> b
$
    forall (io :: * -> *) (dsl :: [*]) vertices instances.
MonadIO io =>
Device -> Pipeline dsl vertices instances -> io ()
destroy Device
device Pipeline dsl vertices instances
res
  pure (ReleaseKey
key, Pipeline dsl vertices instances
res)

destroy
  :: MonadIO io
  => Vk.Device
  -> Pipeline dsl vertices instances
  -> io ()
destroy :: forall (io :: * -> *) (dsl :: [*]) vertices instances.
MonadIO io =>
Device -> Pipeline dsl vertices instances -> io ()
destroy Device
device Pipeline{Tagged dsl DsLayouts
Tagged dsl PipelineLayout
Pipeline
pDescLayouts :: Tagged dsl DsLayouts
pLayout :: Tagged dsl PipelineLayout
pipeline :: Pipeline
$sel:pDescLayouts:Pipeline :: forall (dsl :: [*]) vertices instances.
Pipeline dsl vertices instances -> Tagged dsl DsLayouts
$sel:pLayout:Pipeline :: forall (dsl :: [*]) vertices instances.
Pipeline dsl vertices instances -> Tagged dsl PipelineLayout
$sel:pipeline:Pipeline :: forall (dsl :: [*]) vertices instances.
Pipeline dsl vertices instances -> Pipeline
..} = do
  -- FIXME: leave layout alone
  forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
Vector.forM_ (forall {k} (s :: k) b. Tagged s b -> b
unTagged Tagged dsl DsLayouts
pDescLayouts) \DescriptorSetLayout
dsLayout ->
    forall (io :: * -> *).
MonadIO io =>
Device
-> DescriptorSetLayout
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
Vk.destroyDescriptorSetLayout Device
device DescriptorSetLayout
dsLayout forall a. Maybe a
Nothing
  forall (io :: * -> *).
MonadIO io =>
Device
-> Pipeline -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
Vk.destroyPipeline Device
device Pipeline
pipeline forall a. Maybe a
Nothing
  forall (io :: * -> *).
MonadIO io =>
Device
-> PipelineLayout
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
Vk.destroyPipelineLayout Device
device (forall {k} (s :: k) b. Tagged s b -> b
unTagged Tagged dsl PipelineLayout
pLayout) forall a. Maybe a
Nothing

type family Specialization pipeline