module Vulkan.Utils.ShaderQQ.GLSL.Glslang
  ( glsl
  , 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.Backend.Glslang (GlslangError, GlslangWarning)
import qualified Vulkan.Utils.ShaderQQ.Backend.Glslang.Internal as Glslang
import qualified Vulkan.Utils.ShaderQQ.GLSL as GLSL
import Vulkan.Utils.ShaderQQ.ShaderType

{- $setup
>>> :set -XQuasiQuotes
-}

{- | 'glsl' is a QuasiQuoter which produces GLSL source code with @#line@
directives 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" Nothing [glsl|
  #version 450
  const float myConstant = ${myConstant};
  main (){
  }
|])
@

An explicit example (@<interactive>@ is from doctest):

>>> let version = 450 :: Int in [glsl|#version $version|]
"#version 450\n#extension GL_GOOGLE_cpp_style_line_directive : enable\n#line ... \"<interactive>\"\n"

Note that line number will be thrown off if any of the interpolated
variables contain newlines.
-}
glsl :: QuasiQuoter
glsl :: QuasiQuoter
glsl = QuasiQuoter
GLSL.glsl

{- | QuasiQuoter for creating a compute shader.

Equivalent to calling @$(compileShaderQ Nothing "comp" Nothing [glsl|...|])@ without
interpolation support.
-}
comp :: QuasiQuoter
comp :: QuasiQuoter
comp = String -> QuasiQuoter
shaderQQ String
"comp"

{- | QuasiQuoter for creating a fragment shader.

Equivalent to calling @$(compileShaderQ Nothing "frag" Nothing [glsl|...|])@ without
interpolation support.
-}
frag :: QuasiQuoter
frag :: QuasiQuoter
frag = String -> QuasiQuoter
shaderQQ String
"frag"

{- | QuasiQuoter for creating a geometry shader.

Equivalent to calling @$(compileShaderQ Nothing "geom" Nothing [glsl|...|])@ without
interpolation support.
-}
geom :: QuasiQuoter
geom :: QuasiQuoter
geom = String -> QuasiQuoter
shaderQQ String
"geom"

{- | QuasiQuoter for creating a tessellation control shader.

Equivalent to calling @$(compileShaderQ Nothing "tesc" Nothing [glsl|...|])@ without
interpolation support.
-}
tesc :: QuasiQuoter
tesc :: QuasiQuoter
tesc = String -> QuasiQuoter
shaderQQ String
"tesc"

{- | QuasiQuoter for creating a tessellation evaluation shader.

Equivalent to calling @$(compileShaderQ Nothing "tese" Nothing [glsl|...|])@ without
interpolation support.
-}
tese :: QuasiQuoter
tese :: QuasiQuoter
tese = String -> QuasiQuoter
shaderQQ String
"tese"

{- | QuasiQuoter for creating a vertex shader.

Equivalent to calling @$(compileShaderQ Nothing "vert" Nothing [glsl|...|])@ without
interpolation support.
-}
vert :: QuasiQuoter
vert :: QuasiQuoter
vert = String -> QuasiQuoter
shaderQQ String
"vert"

{- | QuasiQuoter for creating a ray generation shader.

Equivalent to calling @$(compileShaderQ (Just "spirv1.4") "rgen" Nothing [glsl|...|])@ without
interpolation support.
-}
rgen :: QuasiQuoter
rgen :: QuasiQuoter
rgen = String -> QuasiQuoter
rayShaderQQ String
"rgen"

{- | QuasiQuoter for creating an intersection shader.

Equivalent to calling @$(compileShaderQ (Just "spirv1.4") "rint" Nothing [glsl|...|])@ without
interpolation support.
-}
rint :: QuasiQuoter
rint :: QuasiQuoter
rint = String -> QuasiQuoter
rayShaderQQ String
"rint"

{- | QuasiQuoter for creating an any-hit shader.

Equivalent to calling @$(compileShaderQ (Just "spirv1.4") "rahit" Nothing [glsl|...|])@ without
interpolation support.
-}
rahit :: QuasiQuoter
rahit :: QuasiQuoter
rahit = String -> QuasiQuoter
rayShaderQQ String
"rahit"

{- | QuasiQuoter for creating a closest hit shader.

Equivalent to calling @$(compileShaderQ (Just "spirv1.4") "rchit" Nothing [glsl|...|])@ without
interpolation support.
-}
rchit :: QuasiQuoter
rchit :: QuasiQuoter
rchit = String -> QuasiQuoter
rayShaderQQ String
"rchit"

{- | QuasiQuoter for creating a miss shader.

Equivalent to calling @$(compileShaderQ (Just "spirv1.4") "rmiss" Nothing [glsl|...|])@ without
interpolation support.
-}
rmiss :: QuasiQuoter
rmiss :: QuasiQuoter
rmiss = String -> QuasiQuoter
rayShaderQQ String
"rmiss"

{- | QuasiQuoter for creating a callable shader.

Equivalent to calling @$(compileShaderQ (Just "spirv1.4") "rcall" Nothing [glsl|...|])@ without
interpolation support.
-}
rcall :: QuasiQuoter
rcall :: QuasiQuoter
rcall = String -> QuasiQuoter
rayShaderQQ String
"rcall"

{- | QuasiQuoter for creating a task shader.

Equivalent to calling @$(compileShaderQ Nothing "task" Nothing [glsl|...|])@ without
interpolation support.
-}
task :: QuasiQuoter
task :: QuasiQuoter
task = String -> QuasiQuoter
shaderQQ String
"task"

{- | QuasiQuoter for creating a mesh shader.

Equivalent to calling @$(compileShaderQ Nothing "mesh" Nothing [glsl|...|])@ without
interpolation support.
-}
mesh :: QuasiQuoter
mesh :: QuasiQuoter
mesh = String -> QuasiQuoter
shaderQQ String
"mesh"

shaderQQ :: String -> QuasiQuoter
shaderQQ :: String -> QuasiQuoter
shaderQQ String
stage = (String -> QuasiQuoter
badQQ String
stage){quoteExp = compileShaderQ Nothing stage Nothing}

rayShaderQQ :: String -> QuasiQuoter
rayShaderQQ :: String -> QuasiQuoter
rayShaderQQ String
stage = (String -> QuasiQuoter
badQQ String
stage){quoteExp = compileShaderQ (Just "spirv1.4") stage Nothing}

-- * Utilities

{- | Compile a GLSL 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 --source-entry-point main` to specify entry-point function name
  -> String
  -- ^ glsl shader code
  -> Q Exp
  -- ^ Spir-V bytecode
compileShaderQ :: Maybe String -> String -> Maybe String -> String -> Q Exp
compileShaderQ Maybe String
targetEnv = Maybe String
-> ShaderType -> String -> Maybe String -> String -> Q Exp
Glslang.compileShaderQ Maybe String
targetEnv ShaderType
GLSL

-- | Compile a GLSL 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 --source-entry-point main` to specify entry-point function name
  -> String
  -- ^ glsl shader code
  -> m ([GlslangWarning], Either [GlslangError] ByteString)
  -- ^ Spir-V bytecode with warnings or errors
compileShader :: forall (m :: * -> *).
MonadIO m =>
Maybe Loc
-> Maybe String
-> String
-> Maybe String
-> String
-> m ([String], Either [String] ByteString)
compileShader Maybe Loc
loc 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
GLSL