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 {k} {k} (dsl :: [*]) (vertices :: k) (instances :: k).
Pipeline dsl vertices instances -> Pipeline
pipeline     :: Vk.Pipeline
  , forall {k} {k} (dsl :: [*]) (vertices :: k) (instances :: k).
Pipeline dsl vertices instances -> Tagged dsl PipelineLayout
pLayout      :: Tagged dsl Vk.PipelineLayout
  , forall {k} {k} (dsl :: [*]) (vertices :: k) (instances :: k).
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 {k} {k} env (m :: * -> *) (dsl :: [*]) (vertices :: k)
       (instances :: k).
(MonadVulkan env m, MonadResource m) =>
m (Pipeline dsl vertices instances)
-> m (ReleaseKey, Pipeline dsl vertices instances)
allocateWith m (Pipeline dsl vertices instances)
action = (HasCallStack => m (ReleaseKey, Pipeline dsl vertices instances))
-> m (ReleaseKey, Pipeline dsl vertices instances)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack do
  Pipeline dsl vertices instances
res <- m (Pipeline dsl vertices instances)
action
  Device
device <- (env -> Device) -> m Device
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> Device
forall a. HasVulkan a => a -> Device
getDevice
  ReleaseKey
key <- IO () -> m ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register (IO () -> m ReleaseKey) -> IO () -> m ReleaseKey
forall a b. (a -> b) -> a -> b
$
    Device -> Pipeline dsl vertices instances -> IO ()
forall {k} {k} (io :: * -> *) (dsl :: [*]) (vertices :: k)
       (instances :: k).
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 {k} {k} (io :: * -> *) (dsl :: [*]) (vertices :: k)
       (instances :: k).
MonadIO io =>
Device -> Pipeline dsl vertices instances -> io ()
destroy Device
device Pipeline{Tagged dsl DsLayouts
Tagged dsl PipelineLayout
Pipeline
$sel:pipeline:Pipeline :: forall {k} {k} (dsl :: [*]) (vertices :: k) (instances :: k).
Pipeline dsl vertices instances -> Pipeline
$sel:pLayout:Pipeline :: forall {k} {k} (dsl :: [*]) (vertices :: k) (instances :: k).
Pipeline dsl vertices instances -> Tagged dsl PipelineLayout
$sel:pDescLayouts:Pipeline :: forall {k} {k} (dsl :: [*]) (vertices :: k) (instances :: k).
Pipeline dsl vertices instances -> Tagged dsl DsLayouts
pipeline :: Pipeline
pLayout :: Tagged dsl PipelineLayout
pDescLayouts :: Tagged dsl DsLayouts
..} = do
  -- FIXME: leave layout alone
  DsLayouts -> (DescriptorSetLayout -> io ()) -> io ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
Vector.forM_ (Tagged dsl DsLayouts -> DsLayouts
forall {k} (s :: k) b. Tagged s b -> b
unTagged Tagged dsl DsLayouts
pDescLayouts) \DescriptorSetLayout
dsLayout ->
    Device
-> DescriptorSetLayout
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> DescriptorSetLayout
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
Vk.destroyDescriptorSetLayout Device
device DescriptorSetLayout
dsLayout "allocator" ::: Maybe AllocationCallbacks
forall a. Maybe a
Nothing
  Device
-> Pipeline -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> Pipeline -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
Vk.destroyPipeline Device
device Pipeline
pipeline "allocator" ::: Maybe AllocationCallbacks
forall a. Maybe a
Nothing
  Device
-> PipelineLayout
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> PipelineLayout
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
Vk.destroyPipelineLayout Device
device (Tagged dsl PipelineLayout -> PipelineLayout
forall {k} (s :: k) b. Tagged s b -> b
unTagged Tagged dsl PipelineLayout
pLayout) "allocator" ::: Maybe AllocationCallbacks
forall a. Maybe a
Nothing

type family Specialization pipeline