module Vulkan.Utils.ShaderQQ.HLSL.Glslang ( hlsl , comp , frag , geom , tesc , tese , vert , rgen , rint , rahit , rchit , rmiss , rcall , task , mesh , compileShaderQ , compileShader ) where import Control.Monad.IO.Class import Data.ByteString ( ByteString ) import Language.Haskell.TH import Language.Haskell.TH.Quote import Vulkan.Utils.Internal ( badQQ ) import Vulkan.Utils.ShaderQQ.ShaderType import Vulkan.Utils.ShaderQQ.Backend.Glslang ( GlslangError, GlslangWarning ) import qualified Vulkan.Utils.ShaderQQ.Backend.Glslang.Internal as Glslang import qualified Vulkan.Utils.ShaderQQ.HLSL as HLSL -- | 'hlsl' is a QuasiQuoter which produces HLSL source code with a @#line@ -- directive inserted so that error locations point to the correct location in -- the Haskell source file. It also permits basic string interpolation. -- -- - Interpolated variables are prefixed with @$@ -- - They can optionally be surrounded with braces like @${foo}@ -- - Interpolated variables are converted to strings with 'show' -- - To escape a @$@ use @\\$@ -- -- It is intended to be used in concert with 'compileShaderQ' like so -- -- @ -- myConstant = 3.141 -- Note that this will have to be in a different module -- myFragmentShader = $(compileShaderQ Nothing "frag" (Just "main") [hlsl| -- static const float myConstant = ${myConstant}; -- float main (){ -- return myConstant; -- } -- |]) -- @ -- -- An explicit example (@<interactive>@ is from doctest): -- -- >>> let foo = 450 :: Int in [hlsl|const float foo = $foo|] -- "#line 37 \"<interactive>\"\nconst float foo = 450" -- -- Note that line number will be thrown off if any of the interpolated -- variables contain newlines. hlsl :: QuasiQuoter hlsl :: QuasiQuoter hlsl = QuasiQuoter HLSL.hlsl -- | QuasiQuoter for creating a compute shader. -- -- Equivalent to calling @$(compileShaderQ Nothing "comp" (Just "main") [hlsl|...|])@ without -- interpolation support. comp :: QuasiQuoter comp :: QuasiQuoter comp = String -> QuasiQuoter shaderQQ "comp" -- | QuasiQuoter for creating a fragment shader. -- -- Equivalent to calling @$(compileShaderQ Nothing "frag" (Just "main") [hlsl|...|])@ without -- interpolation support. frag :: QuasiQuoter frag :: QuasiQuoter frag = String -> QuasiQuoter shaderQQ "frag" -- | QuasiQuoter for creating a geometry shader. -- -- Equivalent to calling @$(compileShaderQ Nothing "geom" (Just "main") [hlsl|...|])@ without -- interpolation support. geom :: QuasiQuoter geom :: QuasiQuoter geom = String -> QuasiQuoter shaderQQ "geom" -- | QuasiQuoter for creating a tessellation control shader. -- -- Equivalent to calling @$(compileShaderQ Nothing "tesc" (Just "main") [hlsl|...|])@ without -- interpolation support. tesc :: QuasiQuoter tesc :: QuasiQuoter tesc = String -> QuasiQuoter shaderQQ "tesc" -- | QuasiQuoter for creating a tessellation evaluation shader. -- -- Equivalent to calling @$(compileShaderQ Nothing "tese" (Just "main") [hlsl|...|])@ without -- interpolation support. tese :: QuasiQuoter tese :: QuasiQuoter tese = String -> QuasiQuoter shaderQQ "tese" -- | QuasiQuoter for creating a vertex shader. -- -- Equivalent to calling @$(compileShaderQ Nothing "vert" (Just "main") [hlsl|...|])@ without -- interpolation support. vert :: QuasiQuoter vert :: QuasiQuoter vert = String -> QuasiQuoter shaderQQ "vert" -- | QuasiQuoter for creating a ray generation shader. -- -- Equivalent to calling @$(compileShaderQ (Just "spirv1.4") "rgen" (Just "main") [hlsl|...|])@ without -- interpolation support. rgen :: QuasiQuoter rgen :: QuasiQuoter rgen = String -> QuasiQuoter rayShaderQQ "rgen" -- | QuasiQuoter for creating an intersection shader. -- -- Equivalent to calling @$(compileShaderQ (Just "spirv1.4") "rint" (Just "main") [hlsl|...|])@ without -- interpolation support. rint :: QuasiQuoter rint :: QuasiQuoter rint = String -> QuasiQuoter rayShaderQQ "rint" -- | QuasiQuoter for creating an any-hit shader. -- -- Equivalent to calling @$(compileShaderQ (Just "spirv1.4") "rahit" (Just "main") [hlsl|...|])@ without -- interpolation support. rahit :: QuasiQuoter rahit :: QuasiQuoter rahit = String -> QuasiQuoter rayShaderQQ "rahit" -- | QuasiQuoter for creating a closest hit shader. -- -- Equivalent to calling @$(compileShaderQ (Just "spirv1.4") "rchit" (Just "main") [hlsl|...|])@ without -- interpolation support. rchit :: QuasiQuoter rchit :: QuasiQuoter rchit = String -> QuasiQuoter rayShaderQQ "rchit" -- | QuasiQuoter for creating a miss shader. -- -- Equivalent to calling @$(compileShaderQ (Just "spirv1.4") "rmiss" (Just "main") [hlsl|...|])@ without -- interpolation support. rmiss :: QuasiQuoter rmiss :: QuasiQuoter rmiss = String -> QuasiQuoter rayShaderQQ "rmiss" -- | QuasiQuoter for creating a callable shader. -- -- Equivalent to calling @$(compileShaderQ (Just "spirv1.4") "rcall" (Just "main") [hlsl|...|])@ without -- interpolation support. rcall :: QuasiQuoter rcall :: QuasiQuoter rcall = String -> QuasiQuoter rayShaderQQ "rcall" -- | QuasiQuoter for creating a task shader. -- -- Equivalent to calling @$(compileShaderQ Nothing "task" (Just "main") [hlsl|...|])@ without -- interpolation support. task :: QuasiQuoter task :: QuasiQuoter task = String -> QuasiQuoter shaderQQ "task" -- | QuasiQuoter for creating a mesh shader. -- -- Equivalent to calling @$(compileShaderQ Nothing "mesh" (Just "main") [hlsl|...|])@ without -- interpolation support. mesh :: QuasiQuoter mesh :: QuasiQuoter mesh = String -> QuasiQuoter shaderQQ "mesh" shaderQQ :: String -> QuasiQuoter shaderQQ :: String -> QuasiQuoter shaderQQ stage :: String stage = (String -> QuasiQuoter badQQ String stage) { quoteExp :: String -> Q Exp quoteExp = Maybe String -> String -> Maybe String -> String -> Q Exp compileShaderQ Maybe String forall a. Maybe a Nothing String stage (String -> Maybe String forall a. a -> Maybe a Just "main") } rayShaderQQ :: String -> QuasiQuoter rayShaderQQ :: String -> QuasiQuoter rayShaderQQ stage :: String stage = (String -> QuasiQuoter badQQ String stage) { quoteExp :: String -> Q Exp quoteExp = Maybe String -> String -> Maybe String -> String -> Q Exp compileShaderQ (String -> Maybe String forall a. a -> Maybe a Just "spirv1.4") String stage (String -> Maybe String forall a. a -> Maybe a Just "main") } -- * Utilities -- | Compile a HLSL shader to spir-v using glslangValidator. -- -- Messages are converted to GHC warnings or errors depending on compilation success. compileShaderQ :: Maybe String -- ^ Argument to pass to `--target-env` -> String -- ^ stage -> Maybe String -- ^ Argument name to pass to `-e name` to specify entry-point function name -> String -- ^ hlsl shader code -> Q Exp -- ^ Spir-V bytecode compileShaderQ :: Maybe String -> String -> Maybe String -> String -> Q Exp compileShaderQ targetEnv :: Maybe String targetEnv = Maybe String -> ShaderType -> String -> Maybe String -> String -> Q Exp Glslang.compileShaderQ Maybe String targetEnv ShaderType HLSL -- | Compile a HLSL shader to spir-v using glslangValidator. compileShader :: MonadIO m => Maybe Loc -- ^ Source location -> Maybe String -- ^ Argument to pass to `--target-env` -> String -- ^ stage -> Maybe String -- ^ Argument name to pass to `-e name` to specify entry-point function name -> String -- ^ hlsl shader code -> m ([GlslangWarning], Either [GlslangError] ByteString) -- ^ Spir-V bytecode with warnings or errors compileShader :: Maybe Loc -> Maybe String -> String -> Maybe String -> String -> m ([String], Either [String] ByteString) compileShader loc :: Maybe Loc loc targetEnv :: Maybe String targetEnv = Maybe Loc -> Maybe String -> ShaderType -> String -> Maybe String -> String -> m ([String], Either [String] ByteString) forall (m :: * -> *). MonadIO m => Maybe Loc -> Maybe String -> ShaderType -> String -> Maybe String -> String -> m ([String], Either [String] ByteString) Glslang.compileShader Maybe Loc loc Maybe String targetEnv ShaderType HLSL