{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- Module      : WGPU.Internal.Shader
-- Description : Shader modules.
module WGPU.Internal.Shader
  ( -- * Types
    ShaderModule,
    ShaderModuleDescriptor (..),
    ShaderSource (..),
    SPIRV (..),
    WGSL (..),
    ShaderEntryPoint (..),

    -- * Functions
    createShaderModule,
    createShaderModuleSPIRV,
    createShaderModuleWGSL,
  )
where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import Data.String (IsString)
import Data.Text (Text)
import Data.Word (Word32, Word8)
import Foreign (Ptr, castPtr, sizeOf)
import Foreign.C (CChar)
import WGPU.Internal.ChainedStruct (ChainedStruct (EmptyChain, PtrChain))
import WGPU.Internal.Device (Device, deviceInst, wgpuDevice)
import WGPU.Internal.Instance (wgpuHsInstance)
import WGPU.Internal.Memory
  ( ToRaw,
    ToRawPtr,
    evalContT,
    raw,
    rawPtr,
    showWithPtr,
  )
import qualified WGPU.Raw.Generated.Enum.WGPUSType as WGPUSType
import qualified WGPU.Raw.Generated.Fun as RawFun
import WGPU.Raw.Generated.Struct.WGPUShaderModuleDescriptor (WGPUShaderModuleDescriptor)
import qualified WGPU.Raw.Generated.Struct.WGPUShaderModuleDescriptor as WGPUShaderModuleDescriptor
import WGPU.Raw.Generated.Struct.WGPUShaderModuleSPIRVDescriptor (WGPUShaderModuleSPIRVDescriptor)
import qualified WGPU.Raw.Generated.Struct.WGPUShaderModuleSPIRVDescriptor as WGPUShaderModuleSPIRVDescriptor
import WGPU.Raw.Generated.Struct.WGPUShaderModuleWGSLDescriptor (WGPUShaderModuleWGSLDescriptor)
import qualified WGPU.Raw.Generated.Struct.WGPUShaderModuleWGSLDescriptor as WGPUShaderModuleWGSLDescriptor
import WGPU.Raw.Types (WGPUShaderModule (WGPUShaderModule))

-------------------------------------------------------------------------------

-- | Handle to a compiled shader module.
newtype ShaderModule = ShaderModule {ShaderModule -> WGPUShaderModule
wgpuShaderModule :: WGPUShaderModule}

instance Show ShaderModule where
  show :: ShaderModule -> String
show ShaderModule
m =
    let ShaderModule (WGPUShaderModule Ptr ()
ptr) = ShaderModule
m
     in String -> Ptr () -> String
forall a. String -> Ptr a -> String
showWithPtr String
"ShaderModule" Ptr ()
ptr

instance Eq ShaderModule where
  == :: ShaderModule -> ShaderModule -> Bool
(==) ShaderModule
m1 ShaderModule
m2 =
    let ShaderModule (WGPUShaderModule Ptr ()
m1_ptr) = ShaderModule
m1
        ShaderModule (WGPUShaderModule Ptr ()
m2_ptr) = ShaderModule
m2
     in Ptr ()
m1_ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
m2_ptr

instance ToRaw ShaderModule WGPUShaderModule where
  raw :: ShaderModule -> ContT r IO WGPUShaderModule
raw = WGPUShaderModule -> ContT r IO WGPUShaderModule
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUShaderModule -> ContT r IO WGPUShaderModule)
-> (ShaderModule -> WGPUShaderModule)
-> ShaderModule
-> ContT r IO WGPUShaderModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShaderModule -> WGPUShaderModule
wgpuShaderModule

-------------------------------------------------------------------------------

-- | Create a shader module from either SPIR-V or WGSL source code.
createShaderModule ::
  MonadIO m =>
  -- | Device for the shader.
  Device ->
  -- | Descriptor of the shader module.
  ShaderModuleDescriptor ->
  -- | IO action producing the shader module.
  m ShaderModule
createShaderModule :: Device -> ShaderModuleDescriptor -> m ShaderModule
createShaderModule Device
device ShaderModuleDescriptor
smd = IO ShaderModule -> m ShaderModule
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShaderModule -> m ShaderModule)
-> (ContT ShaderModule IO ShaderModule -> IO ShaderModule)
-> ContT ShaderModule IO ShaderModule
-> m ShaderModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT ShaderModule IO ShaderModule -> IO ShaderModule
forall (m :: * -> *) a. Monad m => ContT a m a -> m a
evalContT (ContT ShaderModule IO ShaderModule -> m ShaderModule)
-> ContT ShaderModule IO ShaderModule -> m ShaderModule
forall a b. (a -> b) -> a -> b
$ do
  let inst :: Instance
inst = Device -> Instance
deviceInst Device
device
  Ptr WGPUShaderModuleDescriptor
shaderModuleDescriptor_ptr <- ShaderModuleDescriptor
-> ContT ShaderModule IO (Ptr WGPUShaderModuleDescriptor)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr ShaderModuleDescriptor
smd
  WGPUShaderModule
rawShaderModule <-
    WGPUHsInstance
-> WGPUDevice
-> Ptr WGPUShaderModuleDescriptor
-> ContT ShaderModule IO WGPUShaderModule
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance
-> WGPUDevice
-> Ptr WGPUShaderModuleDescriptor
-> m WGPUShaderModule
RawFun.wgpuDeviceCreateShaderModule
      (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
      (Device -> WGPUDevice
wgpuDevice Device
device)
      Ptr WGPUShaderModuleDescriptor
shaderModuleDescriptor_ptr
  ShaderModule -> ContT ShaderModule IO ShaderModule
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUShaderModule -> ShaderModule
ShaderModule WGPUShaderModule
rawShaderModule)

-- | Create a shader module from SPIR-V source code.
createShaderModuleSPIRV ::
  MonadIO m =>
  -- | Device for which the shader should be created.
  Device ->
  -- | Debugging label for the shader.
  Text ->
  -- | Shader source code (SPIR-V bytestring).
  SPIRV ->
  -- | IO action creating the shader module.
  m ShaderModule
createShaderModuleSPIRV :: Device -> Text -> SPIRV -> m ShaderModule
createShaderModuleSPIRV Device
device Text
label SPIRV
spirv =
  Device -> ShaderModuleDescriptor -> m ShaderModule
forall (m :: * -> *).
MonadIO m =>
Device -> ShaderModuleDescriptor -> m ShaderModule
createShaderModule Device
device ShaderModuleDescriptor
smd
  where
    smd :: ShaderModuleDescriptor
    smd :: ShaderModuleDescriptor
smd =
      ShaderModuleDescriptor :: Text -> ShaderSource -> ShaderModuleDescriptor
ShaderModuleDescriptor
        { shaderLabel :: Text
shaderLabel = Text
label,
          source :: ShaderSource
source = SPIRV -> ShaderSource
ShaderSourceSPIRV SPIRV
spirv
        }

-- | Create a shader module from WGSL source code.
createShaderModuleWGSL ::
  MonadIO m =>
  -- | Device for which the shader should be created.
  Device ->
  -- | Debugging label for the shader.
  Text ->
  -- | Shader source code (WGSL source string).
  WGSL ->
  -- | IO action creating the shader module.
  m ShaderModule
createShaderModuleWGSL :: Device -> Text -> WGSL -> m ShaderModule
createShaderModuleWGSL Device
device Text
label WGSL
wgsl =
  Device -> ShaderModuleDescriptor -> m ShaderModule
forall (m :: * -> *).
MonadIO m =>
Device -> ShaderModuleDescriptor -> m ShaderModule
createShaderModule Device
device ShaderModuleDescriptor
smd
  where
    smd :: ShaderModuleDescriptor
    smd :: ShaderModuleDescriptor
smd =
      ShaderModuleDescriptor :: Text -> ShaderSource -> ShaderModuleDescriptor
ShaderModuleDescriptor
        { shaderLabel :: Text
shaderLabel = Text
label,
          source :: ShaderSource
source = WGSL -> ShaderSource
ShaderSourceWGSL WGSL
wgsl
        }

-------------------------------------------------------------------------------

-- | Descriptor for a shader module.
data ShaderModuleDescriptor = ShaderModuleDescriptor
  { -- | Debug label of the shader module.
    ShaderModuleDescriptor -> Text
shaderLabel :: !Text,
    -- | Source code for the shader.
    ShaderModuleDescriptor -> ShaderSource
source :: !ShaderSource
  }
  deriving (ShaderModuleDescriptor -> ShaderModuleDescriptor -> Bool
(ShaderModuleDescriptor -> ShaderModuleDescriptor -> Bool)
-> (ShaderModuleDescriptor -> ShaderModuleDescriptor -> Bool)
-> Eq ShaderModuleDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShaderModuleDescriptor -> ShaderModuleDescriptor -> Bool
$c/= :: ShaderModuleDescriptor -> ShaderModuleDescriptor -> Bool
== :: ShaderModuleDescriptor -> ShaderModuleDescriptor -> Bool
$c== :: ShaderModuleDescriptor -> ShaderModuleDescriptor -> Bool
Eq, Int -> ShaderModuleDescriptor -> ShowS
[ShaderModuleDescriptor] -> ShowS
ShaderModuleDescriptor -> String
(Int -> ShaderModuleDescriptor -> ShowS)
-> (ShaderModuleDescriptor -> String)
-> ([ShaderModuleDescriptor] -> ShowS)
-> Show ShaderModuleDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShaderModuleDescriptor] -> ShowS
$cshowList :: [ShaderModuleDescriptor] -> ShowS
show :: ShaderModuleDescriptor -> String
$cshow :: ShaderModuleDescriptor -> String
showsPrec :: Int -> ShaderModuleDescriptor -> ShowS
$cshowsPrec :: Int -> ShaderModuleDescriptor -> ShowS
Show)

instance ToRaw ShaderModuleDescriptor WGPUShaderModuleDescriptor where
  raw :: ShaderModuleDescriptor -> ContT r IO WGPUShaderModuleDescriptor
raw ShaderModuleDescriptor {Text
ShaderSource
source :: ShaderSource
shaderLabel :: Text
source :: ShaderModuleDescriptor -> ShaderSource
shaderLabel :: ShaderModuleDescriptor -> Text
..} = do
    Ptr WGPUChainedStruct
nextInChain_ptr <-
      case ShaderSource
source of
        ShaderSourceSPIRV SPIRV
spirv -> do
          Ptr WGPUShaderModuleSPIRVDescriptor
ptr <- SPIRV -> ContT r IO (Ptr WGPUShaderModuleSPIRVDescriptor)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr SPIRV
spirv
          ChainedStruct WGPUShaderModuleSPIRVDescriptor
-> ContT r IO (Ptr WGPUChainedStruct)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr (WGPUSType
-> Ptr WGPUShaderModuleSPIRVDescriptor
-> ChainedStruct WGPUShaderModuleSPIRVDescriptor
forall a. WGPUSType -> Ptr a -> ChainedStruct a
PtrChain WGPUSType
forall a. (Eq a, Num a) => a
WGPUSType.ShaderModuleSPIRVDescriptor Ptr WGPUShaderModuleSPIRVDescriptor
ptr)
        ShaderSourceWGSL WGSL
wgsl -> do
          Ptr WGPUShaderModuleWGSLDescriptor
ptr <- WGSL -> ContT r IO (Ptr WGPUShaderModuleWGSLDescriptor)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr WGSL
wgsl
          ChainedStruct WGPUShaderModuleWGSLDescriptor
-> ContT r IO (Ptr WGPUChainedStruct)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr (WGPUSType
-> Ptr WGPUShaderModuleWGSLDescriptor
-> ChainedStruct WGPUShaderModuleWGSLDescriptor
forall a. WGPUSType -> Ptr a -> ChainedStruct a
PtrChain WGPUSType
forall a. (Eq a, Num a) => a
WGPUSType.ShaderModuleWGSLDescriptor Ptr WGPUShaderModuleWGSLDescriptor
ptr)
    Ptr CChar
label_ptr <- Text -> ContT r IO (Ptr CChar)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr Text
shaderLabel
    WGPUShaderModuleDescriptor -> ContT r IO WGPUShaderModuleDescriptor
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUShaderModuleDescriptor :: Ptr WGPUChainedStruct -> Ptr CChar -> WGPUShaderModuleDescriptor
WGPUShaderModuleDescriptor.WGPUShaderModuleDescriptor
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
nextInChain_ptr,
          label :: Ptr CChar
label = Ptr CChar
label_ptr
        }

-------------------------------------------------------------------------------

-- | Source for a shader module.
data ShaderSource
  = -- | Use shader source from a SPIRV module (pre-compiled).
    ShaderSourceSPIRV !SPIRV
  | -- | Use shader source from WGSL string.
    ShaderSourceWGSL !WGSL
  deriving (ShaderSource -> ShaderSource -> Bool
(ShaderSource -> ShaderSource -> Bool)
-> (ShaderSource -> ShaderSource -> Bool) -> Eq ShaderSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShaderSource -> ShaderSource -> Bool
$c/= :: ShaderSource -> ShaderSource -> Bool
== :: ShaderSource -> ShaderSource -> Bool
$c== :: ShaderSource -> ShaderSource -> Bool
Eq, Int -> ShaderSource -> ShowS
[ShaderSource] -> ShowS
ShaderSource -> String
(Int -> ShaderSource -> ShowS)
-> (ShaderSource -> String)
-> ([ShaderSource] -> ShowS)
-> Show ShaderSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShaderSource] -> ShowS
$cshowList :: [ShaderSource] -> ShowS
show :: ShaderSource -> String
$cshow :: ShaderSource -> String
showsPrec :: Int -> ShaderSource -> ShowS
$cshowsPrec :: Int -> ShaderSource -> ShowS
Show)

-- | Pre-compiled SPIRV module bytes.
newtype SPIRV = SPIRV ByteString deriving (SPIRV -> SPIRV -> Bool
(SPIRV -> SPIRV -> Bool) -> (SPIRV -> SPIRV -> Bool) -> Eq SPIRV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SPIRV -> SPIRV -> Bool
$c/= :: SPIRV -> SPIRV -> Bool
== :: SPIRV -> SPIRV -> Bool
$c== :: SPIRV -> SPIRV -> Bool
Eq, Int -> SPIRV -> ShowS
[SPIRV] -> ShowS
SPIRV -> String
(Int -> SPIRV -> ShowS)
-> (SPIRV -> String) -> ([SPIRV] -> ShowS) -> Show SPIRV
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SPIRV] -> ShowS
$cshowList :: [SPIRV] -> ShowS
show :: SPIRV -> String
$cshow :: SPIRV -> String
showsPrec :: Int -> SPIRV -> ShowS
$cshowsPrec :: Int -> SPIRV -> ShowS
Show)

instance ToRaw SPIRV WGPUShaderModuleSPIRVDescriptor where
  raw :: SPIRV -> ContT r IO WGPUShaderModuleSPIRVDescriptor
raw (SPIRV ByteString
bs) =
    WGPUChainedStruct
-> Word32 -> Ptr Word32 -> WGPUShaderModuleSPIRVDescriptor
WGPUShaderModuleSPIRVDescriptor.WGPUShaderModuleSPIRVDescriptor
      (WGPUChainedStruct
 -> Word32 -> Ptr Word32 -> WGPUShaderModuleSPIRVDescriptor)
-> ContT r IO WGPUChainedStruct
-> ContT
     r IO (Word32 -> Ptr Word32 -> WGPUShaderModuleSPIRVDescriptor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainedStruct Any -> ContT r IO WGPUChainedStruct
forall a b r. ToRaw a b => a -> ContT r IO b
raw (WGPUSType -> ChainedStruct Any
forall a. WGPUSType -> ChainedStruct a
EmptyChain WGPUSType
forall a. (Eq a, Num a) => a
WGPUSType.ShaderModuleSPIRVDescriptor)
      ContT
  r IO (Word32 -> Ptr Word32 -> WGPUShaderModuleSPIRVDescriptor)
-> ContT r IO Word32
-> ContT r IO (Ptr Word32 -> WGPUShaderModuleSPIRVDescriptor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> ContT r IO Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$
            ByteString -> Int
ByteString.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32)
        )
      ContT r IO (Ptr Word32 -> WGPUShaderModuleSPIRVDescriptor)
-> ContT r IO (Ptr Word32)
-> ContT r IO WGPUShaderModuleSPIRVDescriptor
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Ptr Word8 -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Word8 -> Ptr Word32) (Ptr Word8 -> Ptr Word32)
-> ContT r IO (Ptr Word8) -> ContT r IO (Ptr Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ContT r IO (Ptr Word8)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr ByteString
bs)

-- | WGSL shader source code.
newtype WGSL = WGSL Text deriving (WGSL -> WGSL -> Bool
(WGSL -> WGSL -> Bool) -> (WGSL -> WGSL -> Bool) -> Eq WGSL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WGSL -> WGSL -> Bool
$c/= :: WGSL -> WGSL -> Bool
== :: WGSL -> WGSL -> Bool
$c== :: WGSL -> WGSL -> Bool
Eq, Int -> WGSL -> ShowS
[WGSL] -> ShowS
WGSL -> String
(Int -> WGSL -> ShowS)
-> (WGSL -> String) -> ([WGSL] -> ShowS) -> Show WGSL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WGSL] -> ShowS
$cshowList :: [WGSL] -> ShowS
show :: WGSL -> String
$cshow :: WGSL -> String
showsPrec :: Int -> WGSL -> ShowS
$cshowsPrec :: Int -> WGSL -> ShowS
Show)

instance ToRaw WGSL WGPUShaderModuleWGSLDescriptor where
  raw :: WGSL -> ContT r IO WGPUShaderModuleWGSLDescriptor
raw (WGSL Text
txt) =
    WGPUChainedStruct -> Ptr CChar -> WGPUShaderModuleWGSLDescriptor
WGPUShaderModuleWGSLDescriptor.WGPUShaderModuleWGSLDescriptor
      (WGPUChainedStruct -> Ptr CChar -> WGPUShaderModuleWGSLDescriptor)
-> ContT r IO WGPUChainedStruct
-> ContT r IO (Ptr CChar -> WGPUShaderModuleWGSLDescriptor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainedStruct Any -> ContT r IO WGPUChainedStruct
forall a b r. ToRaw a b => a -> ContT r IO b
raw (WGPUSType -> ChainedStruct Any
forall a. WGPUSType -> ChainedStruct a
EmptyChain WGPUSType
forall a. (Eq a, Num a) => a
WGPUSType.ShaderModuleWGSLDescriptor)
      ContT r IO (Ptr CChar -> WGPUShaderModuleWGSLDescriptor)
-> ContT r IO (Ptr CChar)
-> ContT r IO WGPUShaderModuleWGSLDescriptor
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ContT r IO (Ptr CChar)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr Text
txt

-------------------------------------------------------------------------------

-- | Name of a shader entry point.
newtype ShaderEntryPoint = ShaderEntryPoint {ShaderEntryPoint -> Text
unShaderEntryPoint :: Text}
  deriving (ShaderEntryPoint -> ShaderEntryPoint -> Bool
(ShaderEntryPoint -> ShaderEntryPoint -> Bool)
-> (ShaderEntryPoint -> ShaderEntryPoint -> Bool)
-> Eq ShaderEntryPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShaderEntryPoint -> ShaderEntryPoint -> Bool
$c/= :: ShaderEntryPoint -> ShaderEntryPoint -> Bool
== :: ShaderEntryPoint -> ShaderEntryPoint -> Bool
$c== :: ShaderEntryPoint -> ShaderEntryPoint -> Bool
Eq, Int -> ShaderEntryPoint -> ShowS
[ShaderEntryPoint] -> ShowS
ShaderEntryPoint -> String
(Int -> ShaderEntryPoint -> ShowS)
-> (ShaderEntryPoint -> String)
-> ([ShaderEntryPoint] -> ShowS)
-> Show ShaderEntryPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShaderEntryPoint] -> ShowS
$cshowList :: [ShaderEntryPoint] -> ShowS
show :: ShaderEntryPoint -> String
$cshow :: ShaderEntryPoint -> String
showsPrec :: Int -> ShaderEntryPoint -> ShowS
$cshowsPrec :: Int -> ShaderEntryPoint -> ShowS
Show, String -> ShaderEntryPoint
(String -> ShaderEntryPoint) -> IsString ShaderEntryPoint
forall a. (String -> a) -> IsString a
fromString :: String -> ShaderEntryPoint
$cfromString :: String -> ShaderEntryPoint
IsString)

instance ToRawPtr ShaderEntryPoint CChar where
  rawPtr :: ShaderEntryPoint -> ContT r IO (Ptr CChar)
rawPtr = Text -> ContT r IO (Ptr CChar)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr (Text -> ContT r IO (Ptr CChar))
-> (ShaderEntryPoint -> Text)
-> ShaderEntryPoint
-> ContT r IO (Ptr CChar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShaderEntryPoint -> Text
unShaderEntryPoint