module Vulkan.Utils.ShaderQQ.GLSL
( glsl
, insertLineDirective
) where
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Vulkan.Utils.Internal ( badQQ )
import Vulkan.Utils.ShaderQQ.Interpolate
import Data.Char
import Data.List.Extra
glsl :: QuasiQuoter
glsl :: QuasiQuoter
glsl = (String -> QuasiQuoter
badQQ String
"glsl")
{ quoteExp :: String -> Q Exp
quoteExp = \String
s -> do
Loc
loc <- Q Loc
location
let codeWithLineDirective :: String
codeWithLineDirective = String -> Loc -> String
insertLineDirective String
s Loc
loc
String -> Q Exp
interpExp String
codeWithLineDirective
}
insertLineDirective :: String -> Loc -> String
insertLineDirective :: String -> Loc -> String
insertLineDirective String
code Loc {String
CharPos
loc_end :: Loc -> CharPos
loc_filename :: Loc -> String
loc_module :: Loc -> String
loc_package :: Loc -> String
loc_start :: Loc -> CharPos
loc_end :: CharPos
loc_start :: CharPos
loc_module :: String
loc_package :: String
loc_filename :: String
..} =
let isVersionDirective :: String -> Bool
isVersionDirective = (String
"#version" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
codeLines :: [String]
codeLines = String -> [String]
lines String
code
([String]
beforeVersion, [String]
afterVersion) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break String -> Bool
isVersionDirective [String]
codeLines
lineDirective :: [String]
lineDirective =
[ String
"#extension GL_GOOGLE_cpp_style_line_directive : enable"
, String
"#line "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall a b. (a, b) -> a
fst CharPos
loc_start forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
beforeVersion forall a. Num a => a -> a -> a
+ Int
1)
forall a. Semigroup a => a -> a -> a
<> String
" \""
forall a. Semigroup a => a -> a -> a
<> String
loc_filename
forall a. Semigroup a => a -> a -> a
<> String
"\""
]
in case [String]
afterVersion of
[] -> String
code
String
v : [String]
xs -> [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ [String]
beforeVersion forall a. Semigroup a => a -> a -> a
<> [String
v] forall a. Semigroup a => a -> a -> a
<> [String]
lineDirective forall a. Semigroup a => a -> a -> a
<> [String]
xs