@@ -1,5 +1,9 @@
1−{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
1+{-# OPTIONS_GHC -Wall #-}
2−module Parse.Literal (literal, shader) where
2+module Parse.Shader
4import qualified Data.List as List
8import qualified Data.List as List
5import qualified Data.Map as Map
9import qualified Data.Map as Map
@@ -10,26 +14,11 @@ import qualified Text.Parsec as Parsec
10import qualified Text.Parsec.Error as Parsec
14import qualified Text.Parsec.Error as Parsec
12import qualified AST.Expression.Source as Src
16import qualified AST.Expression.Source as Src
13−import qualified AST.Literal as L
17+import qualified AST.Shader as Shader
14import qualified Reporting.Annotation as A
18import qualified Reporting.Annotation as A
15import qualified Reporting.Region as R
19import qualified Reporting.Region as R
16−import Parse.Primitives (Parser, getPosition, oneOf)
20+import Parse.Primitives (Parser, getPosition)
17−import qualified Parse.Primitives.Number as Number
18import qualified Parse.Primitives.Shader as Shader
21import qualified Parse.Primitives.Shader as Shader
19−import qualified Parse.Primitives.Utf8 as Utf8
26−literal :: Parser L.Literal
29− [ L.Str <$> Utf8.string
30− , L.Chr <$> Utf8.character
@@ -42,10 +31,10 @@ shader start@(R.Position row col) =
42 shdr <- parseSource row col (Text.unpack src)
31 shdr <- parseSource row col (Text.unpack src)
43 end@(R.Position row2 col2) <- getPosition
32 end@(R.Position row2 col2) <- getPosition
44 let uid = List.intercalate ":" (map show [row, col, row2, col2])
33 let uid = List.intercalate ":" (map show [row, col, row2, col2])
45− return (A.at start end (Src.GLShader (Text.pack uid) src shdr))
34+ return (A.at start end (Src.Shader (Text.pack uid) src shdr))
48−parseSource :: Int -> Int -> String -> Parser L.Shader
37+parseSource :: Int -> Int -> String -> Parser Shader.Shader
49parseSource startRow startCol src =
38parseSource startRow startCol src =
50 case GLP.parse src of
39 case GLP.parse src of
51 Right (GLS.TranslationUnit decls) ->
40 Right (GLS.TranslationUnit decls) ->
@@ -71,27 +60,27 @@ parseSource startRow startCol src =
71 Shader.failure (startRow + row - 1) col (Text.pack msg)
60 Shader.failure (startRow + row - 1) col (Text.pack msg)
74−emptyShader :: L.Shader
63+emptyShader :: Shader.Shader
75emptyShader =
64emptyShader =
76− L.Shader Map.empty Map.empty Map.empty
65+ Shader.Shader Map.empty Map.empty Map.empty
79−addInput :: (GLS.StorageQualifier, L.GLType, Text.Text) -> L.Shader -> L.Shader
68+addInput :: (GLS.StorageQualifier, Shader.Type, Text.Text) -> Shader.Shader -> Shader.Shader
80addInput ( qual, tipe, name ) glDecls =
69addInput ( qual, tipe, name ) glDecls =
81 case qual of
70 case qual of
82 GLS.Attribute ->
71 GLS.Attribute ->
83− glDecls { L.attribute = Map.insert name tipe (L.attribute glDecls) }
72+ glDecls { Shader._attribute = Map.insert name tipe (Shader._attribute glDecls) }
85 GLS.Uniform ->
74 GLS.Uniform ->
86− glDecls { L.uniform = Map.insert name tipe (L.uniform glDecls) }
75+ glDecls { Shader._uniform = Map.insert name tipe (Shader._uniform glDecls) }
88 GLS.Varying ->
77 GLS.Varying ->
89− glDecls { L.varying = Map.insert name tipe (L.varying glDecls) }
78+ glDecls { Shader._varying = Map.insert name tipe (Shader._varying glDecls) }
91 _ -> error "Should never happen due to below filter"
80 _ -> error "Should never happen due to below filter"
94−extractInputs :: GLS.ExternalDeclaration -> [(GLS.StorageQualifier, L.GLType, Text.Text)]
83+extractInputs :: GLS.ExternalDeclaration -> [(GLS.StorageQualifier, Shader.Type, Text.Text)]
95extractInputs decl =
84extractInputs decl =
96 case decl of
85 case decl of
97 GLS.Declaration
86 GLS.Declaration
@@ -106,12 +95,12 @@ extractInputs decl =
106 False -> []
95 False -> []
108 case tipe of
97 case tipe of
109− GLS.Vec2 -> [(qual, L.V2, Text.pack name)]
98+ GLS.Vec2 -> [(qual, Shader.V2, Text.pack name)]
110− GLS.Vec3 -> [(qual, L.V3, Text.pack name)]
99+ GLS.Vec3 -> [(qual, Shader.V3, Text.pack name)]
111− GLS.Vec4 -> [(qual, L.V4, Text.pack name)]
100+ GLS.Vec4 -> [(qual, Shader.V4, Text.pack name)]
112− GLS.Mat4 -> [(qual, L.M4, Text.pack name)]
101+ GLS.Mat4 -> [(qual, Shader.M4, Text.pack name)]
113− GLS.Int -> [(qual, L.Int, Text.pack name)]
102+ GLS.Int -> [(qual, Shader.Int, Text.pack name)]
114− GLS.Float -> [(qual, L.Float, Text.pack name)]
103+ GLS.Float -> [(qual, Shader.Float, Text.pack name)]
115− GLS.Sampler2D -> [(qual, L.Texture, Text.pack name)]
104+ GLS.Sampler2D -> [(qual, Shader.Texture, Text.pack name)]