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 :: forall env (m :: * -> *) a.
(MonadVulkan env m, HasObjectType a) =>
a -> Text -> m ()
object a
o Text
name = do
  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
  Device -> a -> ByteString -> m ()
forall a (m :: * -> *).
(HasObjectType a, MonadIO m) =>
Device -> a -> ByteString -> m ()
Debug.nameObject Device
device a
o (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$
    Text -> ByteString
encodeUtf8 Text
name

objectOrigin
  :: ( MonadVulkan env m
    , Vk.HasObjectType a
    , HasCallStack
    )
  => a
  -> m ()
objectOrigin :: forall env (m :: * -> *) a.
(MonadVulkan env m, HasObjectType a, HasCallStack) =>
a -> m ()
objectOrigin a
o =
  (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
    a -> Text -> m ()
forall env (m :: * -> *) a.
(MonadVulkan env m, HasObjectType a) =>
a -> Text -> m ()
object a
o (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> ([[Char]] -> [Char]) -> [[Char]] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"|" ([[Char]] -> Text) -> [[Char]] -> Text
forall a b. (a -> b) -> a -> b
$
        (([Char], SrcLoc) -> [Char]) -> [([Char], SrcLoc)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (SrcLoc -> [Char]
srcLocModule (SrcLoc -> [Char])
-> (([Char], SrcLoc) -> SrcLoc) -> ([Char], SrcLoc) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
snd) (CallStack -> [([Char], SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack)