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

-- $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 @\\$@
--
-- 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 72 \"<interactive>\"\n"
--
-- Note that line number will be thrown off if any of the interpolated
-- variables contain newlines.
glsl :: QuasiQuoter
glsl :: QuasiQuoter
glsl = (String -> QuasiQuoter
badQQ "glsl")
  { quoteExp :: String -> Q Exp
quoteExp = \s :: String
s -> do
                 Loc
loc <- Q Loc
location
                 -- Insert the directive here, `compileShaderQ` will insert
                 -- another one, but it's before this one, so who cares.
                 let codeWithLineDirective :: String
codeWithLineDirective = String -> Loc -> String
insertLineDirective String
s Loc
loc
                 String -> Q Exp
interpExp String
codeWithLineDirective
  }

-- If possible, insert a #line directive after the #version directive (as well
-- as the extension which allows filenames in line directives.
insertLineDirective :: String -> Loc -> String
insertLineDirective :: String -> Loc -> String
insertLineDirective code :: String
code Loc {..} =
  let isVersionDirective :: String -> Bool
isVersionDirective = ("#version" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
      codeLines :: [String]
codeLines = String -> [String]
lines String
code
      (beforeVersion :: [String]
beforeVersion, afterVersion :: [String]
afterVersion) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break String -> Bool
isVersionDirective [String]
codeLines
      lineDirective :: [String]
lineDirective =
        [ "#extension GL_GOOGLE_cpp_style_line_directive : enable"
        , "#line "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (CharPos -> Int
forall a b. (a, b) -> a
fst CharPos
loc_start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
beforeVersion Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> " \""
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
loc_filename
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "\""
        ]
  in  case [String]
afterVersion of
        []     -> String
code
        v :: String
v : xs :: [String]
xs -> [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
beforeVersion [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
v] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
lineDirective [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
xs