Named.hs

module Resource.Vulkan.Named
  ( object
  , objectOrigin
  ) where

import RIO

import GHC.Stack (callStack, getCallStack, srcLocModule, withFrozenCallStack)
import RIO.List qualified as List
import Vulkan.Core10 qualified as Vk
import Vulkan.Utils.Debug qualified as Debug

import Engine.Vulkan.Types (MonadVulkan, getDevice)

object
  :: ( MonadVulkan env m
    , Vk.HasObjectType a
    )
  => a
  -> Text
  -> m ()
object o name = do
  device <- asks getDevice
  Debug.nameObject device o $
    encodeUtf8 name

objectOrigin
  :: ( MonadVulkan env m
    , Vk.HasObjectType a
    , HasCallStack
    )
  => a
  -> m ()
objectOrigin o =
  withFrozenCallStack $
    object o $
      fromString . List.intercalate "|" $
        map (srcLocModule . snd) (getCallStack callStack)