git.iko.soy/elk
on master help sign in
Add in more extensive escaping for GLSL shaders
b522c7fEvan Czaplicki
compiler/src/AST/Utils/Shader.hs+49−4
compare with master
unifiedsplit
@@ -4,22 +4,27 @@ module AST.Utils.Shader
4 ( Source
4 ( Source
5 , Types(..)
5 , Types(..)
6 , Type(..)
6 , Type(..)
7+ , fromChars
8+ , toJsStringBuilder
7 )
9 )
8 where
10 where
9
11
10
12
13+import Control.Monad (liftM)
14+import Data.Binary (Binary, get, put)
15+import qualified Data.ByteString as BS
16+import qualified Data.ByteString.Builder as B
17+import qualified Data.ByteString.UTF8 as BS_UTF8
11import qualified Data.Map as Map
18import qualified Data.Map as Map
12import qualified Data.Name as Name
19import qualified Data.Name as Name
13−import qualified Data.Utf8 as Utf8
14
20
15
21
16
22
17-- SOURCE
23-- SOURCE
18
24
19
25
20−type Source = Utf8.VeryLong SOURCE
26+newtype Source =
21−
27+ Source BS.ByteString
22−data SOURCE
23
28
24
29
25
30
@@ -42,3 +47,43 @@ data Type
42 | V4
47 | V4
43 | M4
48 | M4
44 | Texture
49 | Texture
50+
51+
52+
53+-- TO BUILDER
54+
55+
56+toJsStringBuilder :: Source -> B.Builder
57+toJsStringBuilder (Source src) =
58+ B.byteString src
59+
60+
61+
62+-- FROM CHARS
63+
64+
65+fromChars :: [Char] -> Source
66+fromChars chars =
67+ Source (BS_UTF8.fromString (escape chars))
68+
69+
70+escape :: [Char] -> [Char]
71+escape chars =
72+ case chars of
73+ [] ->
74+ []
75+
76+ c:cs
77+ | c == '\n' -> '\\' : 'n' : escape cs
78+ | c == '\"' -> '\\' : '"' : escape cs
79+ | c == '\'' -> '\\' : '\'' : escape cs
80+ | otherwise -> c : escape cs
81+
82+
83+
84+-- BINARY
85+
86+
87+instance Binary Source where
88+ get = liftM Source get
89+ put (Source a) = put a
compiler/src/Parse/Shader.hs+15−13
@@ -6,12 +6,13 @@ module Parse.Shader
6 where
6 where
7
7
8
8
9−import qualified Data.List as List
9+import qualified Data.ByteString.Internal as B
10+import qualified Data.ByteString.UTF8 as BS_UTF8
10import qualified Data.Map as Map
11import qualified Data.Map as Map
11import qualified Data.Name as Name
12import qualified Data.Name as Name
12−import qualified Data.Utf8 as Utf8
13import Data.Word (Word8)
13import Data.Word (Word8)
14−import Foreign.Ptr (Ptr, plusPtr)
14+import Foreign.Ptr (Ptr, plusPtr, minusPtr)
15+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
15import qualified Language.GLSL.Parser as GLP
16import qualified Language.GLSL.Parser as GLP
16import qualified Language.GLSL.Syntax as GLS
17import qualified Language.GLSL.Syntax as GLS
17import qualified Text.Parsec as Parsec
18import qualified Text.Parsec as Parsec
@@ -32,16 +33,16 @@ import qualified Reporting.Error.Syntax as E
32shader :: A.Position -> Parser E.Expr Src.Expr
33shader :: A.Position -> Parser E.Expr Src.Expr
33shader start@(A.Position row col) =
34shader start@(A.Position row col) =
34 do block <- parseBlock
35 do block <- parseBlock
35− shdr <- parseGlsl row col src
36+ shdr <- parseGlsl row col block
36 end <- P.getPosition
37 end <- P.getPosition
37− return (A.at start end (Src.Shader (Shader.fromChars src) shdr))
38+ return (A.at start end (Src.Shader (Shader.fromChars block) shdr))
38
39
39
40
40
41
41-- BLOCK
42-- BLOCK
42
43
43
44
44−parseBlock :: Parser E.Expr P.Snippet
45+parseBlock :: Parser E.Expr [Char]
45parseBlock =
46parseBlock =
46 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->
47 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->
47 let
48 let
@@ -62,11 +63,12 @@ parseBlock =
62 case status of
63 case status of
63 Good ->
64 Good ->
64 let
65 let
65− !block = Utf8.fromPtr pos6 newPos
66+ !off = minusPtr pos6 (unsafeForeignPtrToPtr src)
66− !source = Utf8.toChars block
67+ !len = minusPtr newPos pos6
68+ !block = BS_UTF8.toString (B.PS src off len)
67 !newState = P.State src (plusPtr newPos 2) end indent newRow (newCol + 2)
69 !newState = P.State src (plusPtr newPos 2) end indent newRow (newCol + 2)
68 in
70 in
69− cok source newState
71+ cok block newState
70
72
71 Unending ->
73 Unending ->
72 cerr row col E.EndlessShader
74 cerr row col E.EndlessShader
@@ -102,7 +104,7 @@ eatShader pos end row col =
102-- GLSL
104-- GLSL
103
105
104
106
105−parseGlsl :: Row -> Col -> String -> Parser E.Expr Shader.Types
107+parseGlsl :: Row -> Col -> [Char] -> Parser E.Expr Shader.Types
106parseGlsl startRow startCol src =
108parseGlsl startRow startCol src =
107 case GLP.parse src of
109 case GLP.parse src of
108 Right (GLS.TranslationUnit decls) ->
110 Right (GLS.TranslationUnit decls) ->
@@ -127,7 +129,7 @@ parseGlsl startRow startCol src =
127 else failure (startRow + row - 1) col msg
129 else failure (startRow + row - 1) col msg
128
130
129
131
130−failure :: Row -> Col -> String -> Parser E.Expr a
132+failure :: Row -> Col -> [Char] -> Parser E.Expr a
131failure row col msg =
133failure row col msg =
132 P.Parser $ \(P.State _ _ _ _ _ _) _ _ cerr _ ->
134 P.Parser $ \(P.State _ _ _ _ _ _) _ _ cerr _ ->
133 cerr row col (E.ShaderProblem msg)
135 cerr row col (E.ShaderProblem msg)
@@ -142,7 +144,7 @@ emptyTypes =
142 Shader.Types Map.empty Map.empty Map.empty
144 Shader.Types Map.empty Map.empty Map.empty
143
145
144
146
145−addInput :: (GLS.StorageQualifier, Shader.Type, String) -> Shader.Types -> Shader.Types
147+addInput :: (GLS.StorageQualifier, Shader.Type, [Char]) -> Shader.Types -> Shader.Types
146addInput (qual, tipe, name) glDecls =
148addInput (qual, tipe, name) glDecls =
147 case qual of
149 case qual of
148 GLS.Attribute -> glDecls { Shader._attribute = Map.insert (Name.fromChars name) tipe (Shader._attribute glDecls) }
150 GLS.Attribute -> glDecls { Shader._attribute = Map.insert (Name.fromChars name) tipe (Shader._attribute glDecls) }
@@ -151,7 +153,7 @@ addInput (qual, tipe, name) glDecls =
151 _ -> error "Should never happen due to `extractInputs` function"
153 _ -> error "Should never happen due to `extractInputs` function"
152
154
153
155
154−extractInputs :: GLS.ExternalDeclaration -> [(GLS.StorageQualifier, Shader.Type, String)]
156+extractInputs :: GLS.ExternalDeclaration -> [(GLS.StorageQualifier, Shader.Type, [Char])]
155extractInputs decl =
157extractInputs decl =
156 case decl of
158 case decl of
157 GLS.Declaration
159 GLS.Declaration