packages feed

language-glsl (empty) → 0.0.0

raw patch · 9 files changed

+2132/−0 lines, 9 filesdep +HUnitdep +basedep +language-glslsetup-changed

Dependencies added: HUnit, base, language-glsl, parsec, pretty, prettyclass

Files

+ LICENSE view
@@ -0,0 +1,28 @@+Copyright: (c) Vo Minh Thu, 2010.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS+BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN+IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Language/GLSL.hs view
@@ -0,0 +1,10 @@+module Language.GLSL (+  module Language.GLSL.Syntax,+  module Language.GLSL.Parser,+  module Language.GLSL.Pretty+  ) where++import Language.GLSL.Syntax+import Language.GLSL.Parser+import Language.GLSL.Pretty+
+ Language/GLSL/Parser.hs view
@@ -0,0 +1,898 @@+module Language.GLSL.Parser where++import Prelude hiding (break, exponent)++import Text.ParserCombinators.Parsec hiding (State, parse)+import Text.ParserCombinators.Parsec.Expr++import Language.GLSL.Syntax++----------------------------------------------------------------------+-- Parser state, hold a symbol table.+----------------------------------------------------------------------++data S = S++type P a = GenParser Char S a++----------------------------------------------------------------------+-- Reserved words+----------------------------------------------------------------------++-- List of keywords.+keywords :: [String]+keywords = concat $ map words $+  [ "attribute const uniform varying"+  , "layout"+  , "centroid flat smooth noperspective"+  , "break continue do for while switch case default"+  , "if else"+  , "in out inout"+  , "float int void bool true false"+  , "invariant"+  , "discard return"+  , "mat2 mat3 mat4"+  , "mat2x2 mat2x3 mat2x4"+  , "mat3x2 mat3x3 mat3x4"+  , "mat4x2 mat4x3 mat4x4"+  , "vec2 vec3 vec4 ivec2 ivec3 ivec4 bvec2 bvec3 bvec4"+  , "uint uvec2 uvec3 uvec4"+  , "lowp mediump highp precision"+  , "sampler1D sampler2D sampler3D samplerCube"+  , "sampler1DShadow sampler2DShadow samplerCubeShadow"+  , "sampler1DArray sampler2DArray"+  , "sampler1DArrayShadow sampler2DArrayShadow"+  , "isampler1D isampler2D isampler3D isamplerCube"+  , "isampler1DArray isampler2DArray"+  , "usampler1D usampler2D usampler3D usamplerCube"+  , "usampler1DArray usampler2DArray"+  , "sampler2DRect sampler2DRectShadow isampler2DRect usampler2DRect"+  , "samplerBuffer isamplerBuffer usamplerBuffer"+  , "sampler2DMS isampler2DMS usampler2DMS"+  , "sampler2DMSArray isampler2DMSArray usampler2DMSArray"+  , "struct"+  ]++-- List of keywords reserved for future use.+reservedWords :: [String]+reservedWords = concat $ map words $+  [ "common partition active"+  , "asm"+  , "class union enum typedef template this packed"+  , "goto"+  , "inline noinline volatile public static extern external interface"+  , "long short double half fixed unsigned superp"+  , "input output"+  , "hvec2 hvec3 hvec4 dvec2 dvec3 dvec4 fvec2 fvec3 fvec4"+  , "sampler3DRect"+  , "filter"+  , "image1D image2D image3D imageCube"+  , "iimage1D iimage2D iimage3D iimageCube"+  , "uimage1D uimage2D uimage3D uimageCube"+  , "image1DArray image2DArray"+  , "iimage1DArray iimage2DArray uimage1DArray uimage2DArray"+  , "image1DShadow image2DShadow"+  , "image1DArrayShadow image2DArrayShadow"+  , "imageBuffer iimageBuffer uimageBuffer"+  , "sizeof cast"+  , "namespace using"+  , "row_major"+  ]++----------------------------------------------------------------------+-- Convenience parsers+----------------------------------------------------------------------++comment :: P ()+comment = do+  _ <- char '/'+  _ <- choice+    [ do _ <- char '*'+         manyTill anyChar (try $ string "*/")+    , do _ <- char '/'+         manyTill anyChar ((newline >> return ()) <|> eof)+    ]+  return ()++blank :: P ()+blank = try comment <|> (space >> return ())++-- Acts like p and discards any following space character.+lexeme :: P a -> P a+lexeme p = do+  x <- p+  skipMany blank+  return x++parse :: [Char] -> Either ParseError TranslationUnit+parse =+  runParser (do {skipMany blank ; r <- translationUnit ; eof ; return r})+    S "GLSL"++----------------------------------------------------------------------+-- Lexical elements (tokens)+----------------------------------------------------------------------++semicolon :: P ()+semicolon = lexeme $ char ';' >> return ()++comma :: P ()+comma = lexeme $ char ',' >> return ()++colon :: P ()+colon = lexeme $ char ':' >> return ()++lbrace :: P ()+lbrace = lexeme $ char '{' >> return ()++rbrace :: P ()+rbrace = lexeme $ char '}' >> return ()++lbracket :: P ()+lbracket = lexeme $ char '[' >> return ()++rbracket :: P ()+rbracket = lexeme $ char ']' >> return ()++lparen :: P ()+lparen = lexeme $ char '(' >> return ()++rparen :: P ()+rparen = lexeme $ char ')' >> return ()++-- Try to parse a given string, making sure it is not a+-- prefix of an identifier.+keyword :: String -> P ()+keyword w = lexeme $ try (string w >> notFollowedBy identifierTail)++-- Parses and returns an identifier.+-- TODO an identifier can't start with "gl_" unless+-- it is to redeclare a predeclared "gl_" identifier.+identifier :: P String+identifier = lexeme $ do+  h <- identifierHead+  t <- many identifierTail+  check (h:t)+  where check i | i `elem` reservedWords = fail $+          i ++ " is reserved"+                | i `elem` keywords = fail $+          i ++ " is a keyword"+                | otherwise = checkUnderscore i i+        checkUnderscore i ('_':'_':_) = fail $+          i ++ " is reserved (two consecutive underscores)"+        checkUnderscore i (_:cs) = checkUnderscore i cs+        checkUnderscore i [] = return i++-- TODO the size of the int should fit its type.+intConstant :: P Expr+intConstant = choice+  [ hexadecimal+  , octal+  , badOctal >> fail "Invalid octal number"+  , decimal+  ]++floatingConstant :: P Expr+floatingConstant = choice+  [ floatExponent+  , floatPoint+  , pointFloat+  ]++-- Try to parse a given string, and allow identifier characters+-- (or anything else) to directly follow.+operator :: String -> P String+operator = lexeme . try . string++----------------------------------------------------------------------+-- Lexical elements helpers+----------------------------------------------------------------------++identifierHead :: P Char+identifierHead = letter <|> char '_'++identifierTail :: P Char+identifierTail = alphaNum <|> char '_'++hexadecimal :: P Expr+hexadecimal = lexeme $ try $ do+  _ <- char '0'+  _ <- oneOf "Xx"+  d <- many1 hexDigit+  m <- optionMaybe $ oneOf "Uu" -- TODO+  return $ IntConstant Hexadecimal $ read ("0x" ++ d)++octal :: P Expr+octal = lexeme $ try $ do+  _ <- char '0'+  d <- many1 octDigit+  m <- optionMaybe $ oneOf "Uu" -- TODO+  return $ IntConstant Octal $ read  ("0o" ++ d)++badOctal :: P ()+badOctal = lexeme $ try  $ char '0' >> many1 hexDigit >> return ()++decimal :: P Expr+decimal = lexeme $ try $ do+  d <- many1 digit+  notFollowedBy (char '.' <|> (exponent >> return ' '))+  m <- optionMaybe $ oneOf "Uu" -- TODO+  return $ IntConstant Decimal $ read d++floatExponent :: P Expr+floatExponent = lexeme $ try $ do+  d <- many1 digit+  e <- exponent+  m <- optionMaybe $ oneOf "Ff" -- TODO+  return $ FloatConstant $ read $ d ++ e++floatPoint :: P Expr+floatPoint = lexeme $ try $ do+  d <- many1 digit+  _ <- char '.'+  d' <- many digit+  let d'' = if null d' then "0" else d'+  e <- optionMaybe exponent+  m <- optionMaybe $ oneOf "Ff" -- TODO+  return $ FloatConstant $ read $ d ++ "." ++ d'' ++ maybe "" id e++pointFloat :: P Expr+pointFloat = lexeme $ try $ do+  _ <- char '.'+  d <- many1 digit+  e <- optionMaybe exponent+  m <- optionMaybe $ oneOf "Ff"+  return $ FloatConstant $ read $ "0." ++ d ++ maybe "" id e++exponent :: P String+exponent = lexeme $ try $ do+  _ <- oneOf "Ee"+  s <- optionMaybe (oneOf "+-")+  d <- many1 digit+  return $ "e" ++ maybe "" (:[]) s ++ d++----------------------------------------------------------------------+-- Tables for buildExpressionParser+----------------------------------------------------------------------++infixLeft :: String -> (a -> a -> a) -> Operator Char S a+infixLeft s r = Infix (lexeme (try $ string s) >> return r) AssocLeft++infixLeft' :: String -> (a -> a -> a) -> Operator Char S a+infixLeft' s r = Infix (lexeme (try $ string s >> notFollowedBy (char '=')) >> return r) AssocLeft++infixRight :: String -> (a -> a -> a) -> Operator Char S a+infixRight s r = Infix (lexeme (try $ string s) >> return r) AssocRight++conditionalTable :: [[Operator Char S Expr]]+conditionalTable =+  [ [infixLeft' "*" Mul, infixLeft' "/" Div, infixLeft' "%" Mod]+  , [infixLeft' "+" Add, infixLeft' "-" Sub]+  , [infixLeft' "<<" LeftShift, infixLeft' ">>" RightShift]+  , [infixLeft' "<" Lt, infixLeft' ">" Gt+    ,infixLeft "<=" Lte, infixLeft ">=" Gte]+  , [infixLeft "==" Equ, infixLeft "!=" Neq]+  , [infixLeft' "&" BitAnd]+  , [infixLeft' "^" BitXor]+  , [infixLeft' "|" BitOr]+  , [infixLeft "&&" And]+  , [infixLeft "||" Or]+  ]++assignmentTable :: [[Operator Char S Expr]]+assignmentTable =+  [ [infixRight "=" Equal]+  , [infixRight "+=" AddAssign]+  , [infixRight "-=" SubAssign]+  , [infixRight "*=" MulAssign]+  , [infixRight "/=" DivAssign]+  , [infixRight "%=" ModAssign]+  , [infixRight "<<=" LeftAssign]+  , [infixRight ">>=" RightAssign]+  , [infixRight "&=" AndAssign]+  , [infixRight "^=" XorAssign]+  , [infixRight "|=" OrAssign]+  ]++expressionTable :: [[Operator Char S Expr]]+expressionTable =+  [ [infixLeft "," Sequence]+  ]++----------------------------------------------------------------------+-- Grammar+----------------------------------------------------------------------++primaryExpression :: P Expr+primaryExpression = choice+  [ Variable `fmap` try identifier+  -- int constant+  , intConstant+  -- uint constant+  -- float constant+  , floatingConstant+  -- bool constant+  , keyword "true" >> return (BoolConstant True)+  , keyword "false" >> return (BoolConstant False)+  -- expression within parentheses+  , between lparen rparen expression+  ]++postfixExpression :: P Expr+postfixExpression = do+  e <- try (functionCallGeneric >>= \(i,p) -> return (FunctionCall i p))+       <|> primaryExpression+  p <- many $ choice+    [ between lbracket rbracket integerExpression >>= return . flip Bracket+    , dotFunctionCallGeneric+    , dotFieldSelection+    , operator "++" >> return PostInc+    , operator "--" >> return PostDec+    ]+  return $ foldl (flip ($)) e p++dotFunctionCallGeneric :: P (Expr -> Expr)+dotFunctionCallGeneric =+  lexeme (try $ string "." >> functionCallGeneric) >>= \(i,p) -> return (\e -> MethodCall e i p)++dotFieldSelection :: P (Expr -> Expr)+dotFieldSelection =+  lexeme (try $ string "." >> identifier) >>= return . flip FieldSelection++integerExpression :: P Expr+integerExpression = expression++-- Those productions are pushed inside postfixExpression.+-- functionCall = functionCallOrMethod+-- functionCallOrMethod = functionCallGeneric <|> postfixExpression DOT functionCallGeneric++functionCallGeneric :: P (FunctionIdentifier, Parameters)+functionCallGeneric = do+  i <- functionCallHeader+  p <- choice+    [ keyword "void" >> return ParamVoid+    , assignmentExpression `sepBy` comma >>= return . Params+    ]+  rparen+  return (i, p)+  +-- Those productions are pushed inside functionCallGeneric.+-- functionCallHeaderNoParameters = undefined+-- functionCallHeaderWithParameters = undefined++functionCallHeader :: P FunctionIdentifier+functionCallHeader = do+  i <- functionIdentifier+  lparen+  return i++functionIdentifier :: P FunctionIdentifier+functionIdentifier = choice+  [ try identifier >>= return . FuncId+  , typeSpecifier >>= return . FuncIdTypeSpec -- TODO if the 'identifier' is declared as a type, should be this case+  -- no need for fieldSelection+  ]++unaryExpression :: P Expr+unaryExpression = do+  p <- many $ choice+    [ operator "++" >> return PreInc+    , operator "--" >> return PreDec+    , operator "+" >> return UnaryPlus+    , operator "-" >> return UnaryNegate+    , operator "!" >> return UnaryNot+    , operator "~" >> return UnaryOneComplement+    ] +  e <- postfixExpression+  return $ foldr ($) e p++-- inside unaryExpression+-- unaryOperator = choice++-- implemented throught buildExpressionParser+-- multiplicativeExpression = undefined+-- additiveExpression = undefined+-- shiftExpression = undefined+-- relationalExpression = undefined+-- equalityExpression = undefined+-- andExpression = undefined+-- exclusiveOrExpression = undefined+-- inclusiveOrExpression = undefined+-- logicalAndExpression = undefined+-- logicalXorExpression = undefined+-- logicalOrExpression = undefined++conditionalExpression :: P Expr+conditionalExpression = do+  loe <- buildExpressionParser conditionalTable unaryExpression+  ter <- optionMaybe $ do+    _ <- lexeme (string "?")+    e <- expression+    _ <- lexeme (string ":")+    a <- assignmentExpression+    return (e, a)+  case ter of+    Nothing -> return loe+    Just (e, a) -> return $ Selection loe e a++assignmentExpression :: P Expr+assignmentExpression = buildExpressionParser assignmentTable conditionalExpression++expression :: P Expr+expression = buildExpressionParser expressionTable assignmentExpression++constantExpression :: P Expr+constantExpression = conditionalExpression++-- The GLSL grammar include here function definition but we don't+-- do this here because they should occur only at top level (page 28).+-- Function definitions are handled in externalDefinition instead.+declaration :: P Declaration+declaration = choice+  [ try $ do+       t <- fullySpecifiedType+       l <- idecl `sepBy` comma+       semicolon+       return $ InitDeclaration (TypeDeclarator t) l+  , do keyword "invariant"+       i <- idecl `sepBy` comma+       semicolon+       return $ InitDeclaration InvariantDeclarator i+  , do keyword "precision"+       q <- precisionQualifier+       s <- typeSpecifierNoPrecision+       semicolon+       return $ Precision q s+  , do q <- typeQualifier+       choice+         [ semicolon >> return (TQ q)+         , do i <- identifier+              lbrace+              s <- structDeclarationList+              rbrace+              m <- optionMaybe $ do+                j <- identifier+                n <- optionMaybe $ between lbracket rbracket $ optionMaybe constantExpression+                return (j,n)+              semicolon+              return $ Block q i s m+         ]+  ]+  where idecl = do+          i <- identifier+          m <- optionMaybe $ between lbracket rbracket $+            optionMaybe constantExpression+          j <- optionMaybe $ lexeme (string "=") >> initializer+          return $ InitDecl i m j++functionPrototype :: P FunctionPrototype+functionPrototype = do+  (t, i, p) <- functionDeclarator+  rparen+  return $ FuncProt t i p++functionDeclarator :: P (FullType, String, [ParameterDeclaration])+functionDeclarator = do+  (t, i) <- functionHeader+  p <- parameterDeclaration `sepBy` comma+  return (t, i, p)++-- inside functionDeclarator+-- functionHeaderWithParameters = undefined++functionHeader :: P (FullType, String)+functionHeader = do+  t <- fullySpecifiedType+  i <- identifier+  lparen+  return (t, i)++-- inside parameterDeclaration+-- parameterDeclarator = undefined++-- expanding parameterDeclarator and parameterTypeSpecifier, the rule is:+-- parameterDeclaration:+--   parameterTypeQualifier [parameterQualifier] typeSpecifier identifier[[e]]+--                          [parameterQualifier] typeSpecifier identifier[[e]]+--   parameterTypeQualifier [parameterQualifier] typeSpecifier+--                          [parameterQualifier] typeSpecifier+-- which is simply+--   [parameterTypeQualifier] [parameterQualifier] typeSpecifier [identifier[[e]]]+parameterDeclaration :: P ParameterDeclaration+parameterDeclaration = do+  tq <- optionMaybe parameterTypeQualifier+  q <- optionMaybe parameterQualifier+  s <- typeSpecifier+  m <- optionMaybe $ do+    i <- identifier+    b <- optionMaybe $ between lbracket rbracket constantExpression -- FIXME can't the bracket be empty, i.e. a[] ?+    return (i,b)+  return $ ParameterDeclaration tq q s m++parameterQualifier :: P ParameterQualifier+parameterQualifier = choice+  -- "empty" case handled in the caller+  [ (try . lexeme . string) "inout" >> return InOutParameter+  , (try . lexeme . string) "in" >> return InParameter+  , (try . lexeme . string) "out" >> return OutParameter+  ]++-- inside parameterDeclaration+-- parameterTypeSpecifier = typeSpecifier++-- FIXME not correct w.r.t. the specs.+-- The specs allow+--   int+--   int, foo+--   invariant foo, bar[]+-- and disallow+--   invariant bar[]++-- It is not used, it is inside declaration.+-- initDeclaratorList = undefined++-- inside initDeclaratorList+-- singleDeclaration = undefined++fullySpecifiedType :: P FullType+fullySpecifiedType = choice+  [ try typeSpecifier >>= return . FullType Nothing+  , do q <- typeQualifier+       s <- typeSpecifier+       return $ FullType (Just q) s+  ]++invariantQualifier :: P InvariantQualifier+invariantQualifier = keyword "invariant" >> return Invariant++interpolationQualifier :: P InterpolationQualifier+interpolationQualifier = choice+  [ keyword "smooth" >> return Smooth+  , keyword "flat" >> return Flat+  , keyword "noperspective" >> return NoPerspective+  ]++layoutQualifier :: P LayoutQualifier+layoutQualifier = do+  keyword "layout"+  lparen+  q <- layoutQualifierId `sepBy` comma+  rparen+  return $ Layout q++-- implemented directly in layoutQualifier+-- layoutQualifierIdList = undefined++layoutQualifierId :: P LayoutQualifierId+layoutQualifierId = do+  i <- identifier+  c <- optionMaybe $ lexeme (string "=") >> intConstant+  return $ LayoutQualId i c++parameterTypeQualifier :: P ParameterTypeQualifier+parameterTypeQualifier = keyword "const" >> return ConstParameter++-- sto+-- lay [sto]+-- int [sto]+-- inv [sto]+-- inv int sto+typeQualifier :: P TypeQualifier+typeQualifier = choice+  [ do s <- storageQualifier+       return $ TypeQualSto s+  , do l <- layoutQualifier+       s <- optionMaybe storageQualifier+       return $ TypeQualLay l s+  , do i <- interpolationQualifier+       s <- optionMaybe storageQualifier+       return $ TypeQualInt i s+  , do i <- invariantQualifier+       choice+         [ do j <- interpolationQualifier+              s <- storageQualifier+              return $ TypeQualInv3 i j s+         , do s <- optionMaybe storageQualifier+              return $ TypeQualInv i s+         ]+  ]++-- TODO see 4.3 for restrictions+storageQualifier :: P StorageQualifier+storageQualifier = choice+  [ keyword "const" >> return Const+  , keyword "attribute" >> return Attribute -- TODO vertex only, is deprecated+  , keyword "varying" >> return Varying -- deprecated+  , keyword "in" >> return In+  , keyword "out" >> return Out+  , keyword "centroid" >> (choice+    [ keyword "varying" >> return CentroidVarying -- deprecated+    , keyword "in" >> return CentroidIn+    , keyword "out" >> return CentroidOut+    ])+  , keyword "uniform" >> return Uniform+  ]++typeSpecifier :: P TypeSpecifier+typeSpecifier = choice+  [ do q <- try precisionQualifier+       s <- typeSpecifierNoPrecision+       return $ TypeSpec (Just q) s+  , typeSpecifierNoPrecision >>= return . TypeSpec Nothing+  ]++typeSpecifierNoPrecision :: P TypeSpecifierNoPrecision+typeSpecifierNoPrecision = do+  s <- typeSpecifierNonArray+  choice+    [ try (lbracket >> rbracket) >> return (TypeSpecNoPrecision s (Just Nothing))+    , lbracket >> constantExpression >>= \c -> rbracket >> return (TypeSpecNoPrecision s (Just $ Just c))+    , return $ TypeSpecNoPrecision s Nothing+    ]++-- Basic types, structs, and user-defined types.+typeSpecifierNonArray :: P TypeSpecifierNonArray+typeSpecifierNonArray = choice+  [ keyword "void" >> return Void+  , keyword "float" >> return Float+  , keyword "int" >> return Int+  , keyword "uint" >> return UInt+  , keyword "bool" >> return Bool+  , keyword "vec2" >> return Vec2+  , keyword "vec3" >> return Vec3+  , keyword "vec4" >> return Vec4+  , keyword "bvec2" >> return BVec2+  , keyword "bvec3" >> return BVec3+  , keyword "bvec4" >> return BVec4+  , keyword "ivec2" >> return IVec2+  , keyword "ivec3" >> return IVec3+  , keyword "ivec4" >> return IVec4+  , keyword "uvec2" >> return UVec2+  , keyword "uvec3" >> return UVec3+  , keyword "uvec4" >> return UVec4+  , keyword "mat2" >> return Mat2+  , keyword "mat3" >> return Mat3+  , keyword "mat4" >> return Mat4+  , keyword "mat2x2" >> return Mat2x2+  , keyword "mat2x3" >> return Mat2x3+  , keyword "mat2x4" >> return Mat2x4+  , keyword "mat3x2" >> return Mat3x2+  , keyword "mat3x3" >> return Mat3x3+  , keyword "mat3x4" >> return Mat3x4+  , keyword "mat4x2" >> return Mat4x2+  , keyword "mat4x3" >> return Mat4x3+  , keyword "mat4x4" >> return Mat4x4+  , keyword "sampler1D" >> return Sampler1D+  , keyword "sampler2D" >> return Sampler2D+  , keyword "sampler3D" >> return Sampler3D+  , keyword "samplerCube" >> return SamplerCube+  , keyword "sampler1DShadow" >> return Sampler1DShadow+  , keyword "sampler2DShadow" >> return Sampler2DShadow+  , keyword "samplerCubeShadow" >> return SamplerCubeShadow+  , keyword "sampler1DArray" >> return Sampler1DArray+  , keyword "sampler2DArray" >> return Sampler2DArray+  , keyword "sampler1DArrayShadow" >> return Sampler1DArrayShadow+  , keyword "sampler2DArrayShadow" >> return Sampler2DArrayShadow+  , keyword "isampler1D" >> return ISampler1D+  , keyword "isampler2D" >> return ISampler2D+  , keyword "isampler3D" >> return ISampler3D+  , keyword "isamplerCube" >> return ISamplerCube+  , keyword "isampler1DArray" >> return ISampler1DArray+  , keyword "isampler2DArray" >> return ISampler2DArray+  , keyword "usampler1D" >> return USampler1D+  , keyword "usampler2D" >> return USampler2D+  , keyword "usampler3D" >> return USampler3D+  , keyword "usamplerCube" >> return USamplerCube+  , keyword "usampler1DArray" >> return USampler1DArray+  , keyword "usampler2DArray" >> return USampler2DArray+  , keyword "sampler2DRect" >> return Sampler2DRect+  , keyword "sampler2DRectShadow" >> return Sampler2DRectShadow+  , keyword "isampler2DRect" >> return ISampler2DRect+  , keyword "usampler2DRect" >> return USampler2DRect+  , keyword "samplerBuffer" >> return SamplerBuffer+  , keyword "isamplerBuffer" >> return ISamplerBuffer+  , keyword "usamplerBuffer" >> return USamplerBuffer+  , keyword "sampler2DMS" >> return Sampler2DMS+  , keyword "isampler2DMS" >> return ISampler2DMS+  , keyword "usampler2DMS" >> return USampler2DMS+  , keyword "sampler2DMSArray" >> return Sampler2DMSArray+  , keyword "isampler2DMSArray" >> return ISampler2DMSArray+  , keyword "usampler2DMSArray" >> return USampler2DMSArray+  , structSpecifier+  , identifier >>= return . TypeName -- verify if it is declared+  ]++precisionQualifier :: P PrecisionQualifier+precisionQualifier = choice+  [ keyword "highp" >> return HighP+  , keyword "mediump" >> return MediumP+  , keyword "lowp" >> return LowP+  ]++structSpecifier :: P TypeSpecifierNonArray+structSpecifier = do+  keyword "struct"+  i <- optionMaybe identifier+  lbrace+  d <- structDeclarationList+  rbrace+  return $ StructSpecifier i d++structDeclarationList :: P [Field]+structDeclarationList = many1 structDeclaration++structDeclaration :: P Field+structDeclaration = do+  q <- optionMaybe typeQualifier+  s <- typeSpecifier+  l <- structDeclaratorList+  semicolon+  return $ Field q s l++structDeclaratorList :: P [StructDeclarator]+structDeclaratorList = structDeclarator `sepBy` comma++structDeclarator :: P StructDeclarator+structDeclarator = do+  i <- identifier+  choice+    [ lbracket >> rbracket >> return (StructDeclarator i (Just Nothing))+    , do lbracket+         e <- constantExpression+         rbracket+         return $ StructDeclarator i (Just $ Just e)+    , return $ StructDeclarator i Nothing+    ]++initializer :: P Expr+initializer = assignmentExpression++declarationStatement :: P Declaration+declarationStatement = declaration++statement :: P Statement+statement = CompoundStatement `fmap` compoundStatement+  <|> simpleStatement++simpleStatement :: P Statement+simpleStatement = choice+  [ declarationStatement >>= return . DeclarationStatement+  , expressionStatement >>= return . ExpressionStatement+  , selectionStatement+  , switchStatement+  , caseLabel >>= return . CaseLabel+  , iterationStatement+  , jumpStatement+  ]++compoundStatement :: P Compound+compoundStatement = choice+  [ try (lbrace >> rbrace) >> return (Compound [])+  , between lbrace rbrace statementList >>= return . Compound+  ]++statementNoNewScope :: P Statement+statementNoNewScope = CompoundStatement `fmap` compoundStatementNoNewScope+  <|> simpleStatement++compoundStatementNoNewScope :: P Compound+compoundStatementNoNewScope = compoundStatement++statementList :: P [Statement]+statementList = many1 statement++expressionStatement :: P (Maybe Expr)+expressionStatement = choice+  [ semicolon >> return Nothing+  , expression >>= \e -> semicolon >> return (Just e)+  ]++selectionStatement :: P Statement+selectionStatement = do+  keyword "if"+  lparen+  c <- expression+  rparen+  t <- statement+  f <- optionMaybe (keyword "else" >> statement)+  return $ SelectionStatement c t f+  +-- inside selectionStatement+-- selectionRestStatement = undefined++condition :: P Condition+condition = choice+  [ expression >>= return . Condition+  , do t <- fullySpecifiedType+       i <- identifier+       _ <- lexeme (string "=")+       j <- initializer+       return $ InitializedCondition t i j+  ]++switchStatement :: P Statement+switchStatement = do+  keyword "switch"+  lparen+  e <- expression+  rparen+  lbrace+  l <- switchStatementList+  rbrace+  return $ SwitchStatement e l++switchStatementList :: P [Statement]+switchStatementList = many statement++caseLabel :: P CaseLabel+caseLabel = choice+  [ keyword "case" >> expression >>= \e -> colon >> return (Case e)+  , keyword "default" >> colon >> return Default+  ]++iterationStatement :: P Statement+iterationStatement = choice+  [ do keyword "while"+       lparen+       c <- condition+       rparen+       s <- statementNoNewScope+       return $ While c s+  , do keyword "do"+       s <- statement+       keyword "while"+       lparen+       e <- expression+       rparen+       semicolon+       return $ DoWhile s e+  , do keyword "for"+       lparen+       i <- forInitStatement+       c <- optionMaybe condition+       semicolon+       e <- optionMaybe expression+       rparen+       s <- statementNoNewScope+       return $ For i c e s+  ]++forInitStatement :: P (Either (Maybe Expr) Declaration)+forInitStatement = (expressionStatement >>= return . Left)+  <|> (declarationStatement >>= return . Right)++-- inside iterationStatement+-- conditionOp = undefined++-- inside iterationStatement+-- forRestStatement = undefined++jumpStatement :: P Statement+jumpStatement = choice+  [ keyword "continue" >> semicolon >> return Continue+  , keyword "break" >> semicolon >> return Break +  , try (keyword "return" >> semicolon) >> return (Return Nothing)+  , keyword "return" >> expression >>= \e -> semicolon >> return (Return $ Just e)+  , keyword "discard" >> semicolon >> return Discard+  ]++translationUnit :: P TranslationUnit+translationUnit = TranslationUnit `fmap` many1 externalDeclaration++externalDeclaration :: P ExternalDeclaration+externalDeclaration = choice+  [ do p <- try functionPrototype+       choice+         [ semicolon >> return (FunctionDeclaration p)+         , compoundStatementNoNewScope >>= return . FunctionDefinition p+         ]+  , Declaration `fmap` declaration+  ]++-- inside externalDeclaration, used only in tests+functionDefinition :: P ExternalDeclaration+functionDefinition = do+  fp <- functionPrototype+  cs <- compoundStatementNoNewScope+  return $ FunctionDefinition fp cs+
+ Language/GLSL/Pretty.hs view
@@ -0,0 +1,335 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Language.GLSL.Pretty where++import Text.PrettyPrint.HughesPJClass+import Text.Printf++import Language.GLSL.Syntax++----------------------------------------------------------------------+-- helpers (TODO clean)+----------------------------------------------------------------------++prettyBinary :: Pretty a =>+  PrettyLevel -> Rational -> Rational -> String -> a -> a -> Doc+prettyBinary l p op o e1 e2 = prettyParen (p > op) $+  pPrintPrec l op e1 <+> text o <+> pPrintPrec l op e2++option :: Pretty a => Maybe a -> Doc+option Nothing = empty+option (Just x) = pPrint x++indexing :: Pretty a => Maybe (Maybe a) -> Doc+indexing Nothing = empty+indexing (Just Nothing) = brackets empty+indexing (Just (Just e)) = brackets $ pPrint e++indexing' :: Pretty a => Maybe (String, Maybe a) -> Doc+indexing' Nothing = empty+indexing' (Just (i, Nothing)) = text i+indexing' (Just (i, Just e)) = text i <> brackets (pPrint e)++initialize :: Pretty a => Maybe a -> Doc+initialize Nothing = empty+initialize (Just e) = char ' ' <> equals <+> pPrint e++ident :: Pretty a => Maybe (String, Maybe (Maybe a)) -> Doc+ident Nothing = empty+ident (Just (i, Nothing)) = text i+ident (Just (i, Just Nothing)) = text i <> brackets empty+ident (Just (i, Just (Just e))) = text i <> brackets (pPrint e)++initialize' :: Pretty a => Maybe (String, Maybe a) -> Doc+initialize' Nothing = empty+initialize' (Just (i, Nothing)) = text i+initialize' (Just (i, Just e)) = text i <+> char '=' <+> pPrint e++----------------------------------------------------------------------+-- Pretty instances+----------------------------------------------------------------------++instance Pretty TranslationUnit where+  pPrint (TranslationUnit ds) = vcat $ map pPrint ds+--  pPrint (Alternative p e) = text "(" <> nest 2 (vcat [pPrint p, pPrint e]) <> text ")"++instance Pretty ExternalDeclaration where+  pPrint (FunctionDeclaration p) = pPrint p <> semi+  pPrint (FunctionDefinition p s) = vcat [pPrint p, pPrint s]+  pPrint (Declaration d) = pPrint d++instance Pretty Declaration where+  pPrint (InitDeclaration it ds) = pPrint it <+> hsep (punctuate comma (map pPrint ds)) <> semi+  pPrint (Precision pq t) = text "precision" <+> pPrint pq <+> pPrint t <> semi+  pPrint (Block tq i ds n) = vcat [pPrint tq <+> text i, lbrace, nest 2 (vcat $ map pPrint ds), rbrace <+> ident n <> semi]+  pPrint (TQ tq) = pPrint tq <> semi++instance Pretty InitDeclarator where+  pPrint (InitDecl i a b) = text i <> indexing a <> initialize b++instance Pretty InvariantOrType where+  pPrint InvariantDeclarator = text "invariant"+  pPrint (TypeDeclarator ft) = pPrint ft++instance Pretty FullType where+  pPrint (FullType tq ts) = option tq <+> pPrint ts++instance Pretty TypeQualifier where+  pPrint (TypeQualSto sq) = pPrint sq+  pPrint (TypeQualLay lq sq) = pPrint lq <+> option sq+  pPrint (TypeQualInt iq sq) = pPrint iq <+> option sq+  pPrint (TypeQualInv iq sq) = pPrint iq <+> option sq+  pPrint (TypeQualInv3 iq iq' sq) = pPrint iq <+> pPrint iq' <+> pPrint sq++instance Pretty StorageQualifier where+  pPrint q = case q of+    Const -> text "const"+    Attribute -> text "attribute"+    Varying -> text "varying"+    CentroidVarying -> text "centroid varying"+    In -> text "in"+    Out -> text "out"+    CentroidIn -> text "centroid in"+    CentroidOut -> text "centroid out"+    Uniform -> text "uniform"++instance Pretty LayoutQualifier where+  pPrint (Layout is) = text "layout" <+> char '(' <>+    (hsep $ punctuate comma $ map pPrint is) <> char ')'++instance Pretty LayoutQualifierId where+  pPrint (LayoutQualId i Nothing) = text i+  pPrint (LayoutQualId i (Just e)) = text i <+> char '=' <+> pPrint e++instance Pretty InterpolationQualifier where+  pPrint q = case q of+    Smooth -> text "smooth"+    Flat -> text "flat"+    NoPerspective -> text "noperspective"++instance Pretty InvariantQualifier where+  pPrint Invariant = text "invariant"++instance Pretty TypeSpecifier where+  pPrint (TypeSpec (Just pq) t) = pPrint pq <+> pPrint t+  pPrint (TypeSpec Nothing t) = pPrint t++instance Pretty PrecisionQualifier where+  pPrint HighP = text "highp"+  pPrint MediumP = text "mediump"+  pPrint LowP = text "lowp"++instance Pretty TypeSpecifierNoPrecision where+  pPrint (TypeSpecNoPrecision t a) = pPrint t <+> indexing a++instance Pretty TypeSpecifierNonArray where+  pPrint t = case t of+    Void -> text "void"+    Float -> text "float"+    Int -> text "int"+    UInt -> text "uint"+    Bool -> text "bool"+    Vec2 -> text "vec2"+    Vec3 -> text "vec3"+    Vec4 -> text "vec4"+    BVec2 -> text "bvec2"+    BVec3 -> text "bvec3"+    BVec4 -> text "bvec4"+    IVec2 -> text "ivec2"+    IVec3 -> text "ivec3"+    IVec4 -> text "ivec4"+    UVec2 -> text "uvec2"+    UVec3 -> text "uvec3"+    UVec4 -> text "uvec4"+    Mat2 -> text "mat2"+    Mat3 -> text "mat3"+    Mat4 -> text "mat4"+    Mat2x2 -> text "mat2x2"+    Mat2x3 -> text "mat2x3"+    Mat2x4 -> text "mat2x4"+    Mat3x2 -> text "mat3x2"+    Mat3x3 -> text "mat3x3"+    Mat3x4 -> text "mat3x4"+    Mat4x2 -> text "mat4x2"+    Mat4x3 -> text "mat4x3"+    Mat4x4 -> text "mat4x4"+    Sampler1D -> text "sampler1D"+    Sampler2D -> text "sampler2D"+    Sampler3D -> text "sampler3D"+    SamplerCube -> text "samplerCube"+    Sampler1DShadow -> text "sampler1DShadow"+    Sampler2DShadow -> text "sampler2DShadow"+    SamplerCubeShadow -> text "samplerCubeShadow"+    Sampler1DArray -> text "sampler1DArray"+    Sampler2DArray -> text "sampler2DArray"+    Sampler1DArrayShadow -> text "sampler1DArrayShadow"+    Sampler2DArrayShadow -> text "sampler2DArrayShadow"+    ISampler1D -> text "isampler1D"+    ISampler2D -> text "isampler2D"+    ISampler3D -> text "isampler3D"+    ISamplerCube -> text "isamplerCube"+    ISampler1DArray -> text "isampler1DArray"+    ISampler2DArray -> text "isampler2DArray"+    USampler1D -> text "usampler1D"+    USampler2D -> text "usampler2D"+    USampler3D -> text "usampler3D"+    USamplerCube -> text "usamplerCube"+    USampler1DArray -> text "usampler1DArray"+    USampler2DArray -> text "usampler2DArray"+    Sampler2DRect -> text "sampler2DRect"+    Sampler2DRectShadow -> text "sampler2DRectShadow"+    ISampler2DRect -> text "isampler2DRect"+    USampler2DRect -> text "usampler2DRect"+    SamplerBuffer -> text "samplerBuffer"+    ISamplerBuffer -> text "isamplerBuffer"+    USamplerBuffer -> text "usamplerBuffer"+    Sampler2DMS -> text "sampler2DMS"+    ISampler2DMS -> text "isampler2DMS"+    USampler2DMS -> text "usampler2DMS"+    Sampler2DMSArray -> text "sampler2DMSArray"+    ISampler2DMSArray -> text "isampler2DMSArray"+    USampler2DMSArray -> text "usampler2DMSArray"+    StructSpecifier i ds ->+      vcat [text "struct" <+> i', lbrace, nest 2 (vcat $ map pPrint ds), rbrace]+      where i' = case i of { Nothing -> empty ; Just n -> text n }+    TypeName i -> text i++instance Pretty Field where+  pPrint (Field tq s ds) =+    option tq <+> pPrint s <+> hsep (punctuate comma $ map pPrint ds) <> semi++instance Pretty StructDeclarator where+  pPrint (StructDeclarator i e) = ident (Just (i, e))++instance Pretty Expr where+  pPrintPrec l p e = case e of+  -- primaryExpression+    Variable v -> text v+    IntConstant Decimal i -> text (show i)+    IntConstant Hexadecimal i -> text (printf "0x%x" i)+    IntConstant Octal i -> text (printf "0%o" i)+    FloatConstant f -> text (show f)+    BoolConstant True -> text "true"+    BoolConstant False -> text "false"+  -- postfixExpression+    Bracket e1 e2 -> prettyParen (p > 16) $+      pPrintPrec l 16 e1 <> brackets (pPrint e2)+    FieldSelection e1 f -> prettyParen (p > 16) $+      pPrintPrec l 16 e1 <> char '.' <> text f+    MethodCall e1 i ps -> prettyParen (p > 16) $+      pPrintPrec l 16 e1 <> char '.' <> pPrint i <+> parens (pPrint ps)+    FunctionCall i ps -> prettyParen (p > 16) $+      pPrint i <+> parens (pPrint ps)+    PostInc e1 -> prettyParen (p > 15) $+      pPrintPrec l 15 e1 <+> text "++"+    PostDec e1 -> prettyParen (p > 15) $+      pPrintPrec l 15 e1 <+> text "--"+    PreInc e1 -> prettyParen (p > 15) $+      text "++" <+> pPrintPrec l 15 e1+    PreDec e1 -> prettyParen (p > 15) $+      text "--" <+> pPrintPrec l 15 e1+  -- unary expression+    UnaryPlus e1 -> prettyParen (p > 15) $+      text "+" <> pPrintPrec l 15 e1+    UnaryNegate e1 -> prettyParen (p > 15) $+      text "-" <> pPrintPrec l 15 e1+    UnaryNot e1 -> prettyParen (p > 15) $+      text "!" <> pPrintPrec l 15 e1+    UnaryOneComplement e1 -> prettyParen (p > 15) $+      text "~" <> pPrintPrec l 15 e1+  -- binary expression+    Mul e1 e2 -> prettyBinary l p 14 "*" e1 e2+    Div e1 e2 -> prettyBinary l p 14 "/" e1 e2+    Mod e1 e2 -> prettyBinary l p 14 "%" e1 e2+    Add e1 e2 -> prettyBinary l p 13 "+" e1 e2+    Sub e1 e2 -> prettyBinary l p 13 "-" e1 e2+    LeftShift e1 e2 -> prettyBinary l p 12 "<<" e1 e2+    RightShift e1 e2 -> prettyBinary l p 12 ">>" e1 e2+    Lt e1 e2 -> prettyBinary l p 11 "<" e1 e2+    Gt e1 e2 -> prettyBinary l p 11 ">" e1 e2+    Lte e1 e2 -> prettyBinary l p 11 "<=" e1 e2+    Gte e1 e2 -> prettyBinary l p 11 ">=" e1 e2+    Equ e1 e2 -> prettyBinary l p 10 "==" e1 e2+    Neq e1 e2 -> prettyBinary l p 10 "!=" e1 e2+    BitAnd e1 e2 -> prettyBinary l p 9 "&" e1 e2+    BitXor e1 e2 -> prettyBinary l p 8 "^" e1 e2+    BitOr e1 e2 -> prettyBinary l p 7 "|" e1 e2+    And e1 e2 -> prettyBinary l p 6 "&&" e1 e2+-- TODO Xor 5 "^^"+    Or e1 e2 -> prettyBinary l p 4 "||" e1 e2+    Selection e1 e2 e3 -> prettyParen (p > 3) $+      pPrintPrec l 3 e1 <+> char '?' <+> pPrintPrec l 3 e2+      <+> char ':' <+> pPrintPrec l 3 e3+  -- assignment, the left Expr should be unary expression+    Equal e1 e2 -> prettyBinary l p 2 "=" e1 e2+    MulAssign e1 e2 -> prettyBinary l p 2 "*=" e1 e2+    DivAssign e1 e2 -> prettyBinary l p 2 "/=" e1 e2+    ModAssign e1 e2 -> prettyBinary l p 2 "%=" e1 e2+    AddAssign e1 e2 -> prettyBinary l p 2 "+=" e1 e2+    SubAssign e1 e2 -> prettyBinary l p 2 "-=" e1 e2+    LeftAssign e1 e2 -> prettyBinary l p 2 "<<=" e1 e2+    RightAssign e1 e2 -> prettyBinary l p 2 ">>=" e1 e2+    AndAssign e1 e2 -> prettyBinary l p 2 "&=" e1 e2+    XorAssign e1 e2 -> prettyBinary l p 2 "^=" e1 e2+    OrAssign e1 e2 -> prettyBinary l p 2 "|=" e1 e2+  -- sequence+    Sequence e1 e2 -> prettyParen (p > 1) $+      pPrintPrec l 1 e1 <> char ',' <+> pPrintPrec l 1 e2++instance Pretty FunctionIdentifier where+  pPrint (FuncIdTypeSpec t) = pPrint t+  pPrint (FuncId i) = text i++instance Pretty Parameters where+  pPrint ParamVoid = empty+  pPrint (Params es) = hsep $ punctuate comma $ map pPrint es++instance Pretty FunctionPrototype where+  pPrint (FuncProt t i ps) = pPrint t <+> text i <+> char '(' <> hsep (punctuate comma $ map pPrint ps) <> text ")"++instance Pretty ParameterDeclaration where+  pPrint (ParameterDeclaration tq q s i) =+    option tq <+> option q <+> pPrint s <+> indexing' i++instance Pretty ParameterTypeQualifier  where+  pPrint ConstParameter = text "const"++instance Pretty ParameterQualifier where+  pPrint InParameter = text "in"+  pPrint OutParameter = text "out"+  pPrint InOutParameter = text "inout"++instance Pretty Statement where+  pPrint s = case s of+  -- declaration statement+    DeclarationStatement d -> pPrint d+  -- jump statement+    Continue -> text "continue" <> semi+    Break -> text "break" <> semi+    Return e -> text "return" <+> option e <> semi+    Discard -> text "discard" <> semi+  -- compound statement+    CompoundStatement c -> pPrint c+  -- expression statement+    ExpressionStatement e -> option e <> semi+  -- selection statement+    SelectionStatement e s1 s2 -> vcat [text "if" <+> parens (pPrint e), nest 2 $ pPrint s1, option s2]+  -- switch statement+    SwitchStatement e s1 -> vcat [text "switch" <+> parens (pPrint e), lbrace, nest 2 $ vcat $ map pPrint s1, rbrace]+    CaseLabel l -> pPrint l+  -- iteration statement+    While c s1 -> vcat [text "while" <+> parens (pPrint c), pPrint s1]+    DoWhile s1 e -> vcat [text "do", pPrint s1, text "while" <+> parens (pPrint e)]+    For (Left e1) c e2 s1 -> vcat [text "for", parens (option e1 <+> semi <+> option c <+> semi <+> option e2), pPrint s1]+    For (Right d) c e2 s1 -> vcat [text "for", parens (pPrint d <+> semi <+> option c <+> semi <+> option e2), pPrint s1]++instance Pretty Compound where+  pPrint (Compound s) = vcat [lbrace, nest 2 $ vcat $ map pPrint s, rbrace]++instance Pretty Condition where+  pPrint (Condition e) = pPrint e+  pPrint (InitializedCondition t i e) = pPrint t <+> pPrint i <+> pPrint e++instance Pretty CaseLabel where+  pPrint  (Case e) = text "case" <+> pPrint e <> colon+  pPrint Default = text "default:"+
+ Language/GLSL/Syntax.hs view
@@ -0,0 +1,313 @@+module Language.GLSL.Syntax where++-- TODO:+-- - add support for 'array of strings' ?+-- - add support for macro preprocessing+-- - add support for optional macro #include+-- - applicative style (see http://github.com/markusle/husky)?+-- - type checking+-- - check for constant expression where expected+-- - error reporting+-- - pretty-printing+-- - basic queries (inputs and outputs of the shader)+-- - support GLSL 1.40?+-- - proper testing (HUnit and QuickCheck)+-- - use hpc with the tests+-- - scoping+-- - clean module import/export+-- - order of Syntax data types and Pretty instances should be the same+-- - build with no warning+-- - use hlint+-- - push to github+-- - push to hackage+-- - use parsec 3+-- - handle all possible newlines (\n, \r, \r\n, \n\r)+-- - 80-columns clean++-- - lot of restriction of Samplers use (section 4.1.7),+-- well in fact, for plenty of things.++----------------------------------------------------------------------+-- Abstract syntax tree+----------------------------------------------------------------------++data TranslationUnit = TranslationUnit [ExternalDeclaration] -- at least one+  deriving (Show, Eq)++data ExternalDeclaration =+    -- function declarations should be at top level (page 28)+    FunctionDeclaration FunctionPrototype+  | FunctionDefinition FunctionPrototype Compound+  | Declaration Declaration+  deriving (Show, Eq)++-- TODO clean+data Declaration =+-- e.g. layout (origin_upper_left) in vec4 gl_FragCoord;+--      struct name { ... };+--      struct name { ... } name;+    InitDeclaration InvariantOrType [InitDeclarator]+  | Precision PrecisionQualifier TypeSpecifierNoPrecision+  | Block TypeQualifier String [Field] (Maybe (String, Maybe (Maybe Expr))) -- constant expression+-- e.g. layout (origin_upper_left) in; TODO check if it is only used for default layout.+  | TQ TypeQualifier+  deriving (Show, Eq)++-- TODO regroup String (Maybe (Maybe Expr)) as Declarator and use it for+-- StructDeclarator.+data InitDeclarator = InitDecl String (Maybe (Maybe Expr)) (Maybe Expr) -- constant expression; assignment expression+  deriving (Show, Eq)++data InvariantOrType = InvariantDeclarator | TypeDeclarator FullType+  deriving (Show, Eq)++data FunctionPrototype = FuncProt FullType String [ParameterDeclaration]+  deriving (Show, Eq)++data ParameterDeclaration =+  ParameterDeclaration (Maybe ParameterTypeQualifier)+                       (Maybe ParameterQualifier)+                       TypeSpecifier+                       (Maybe (String, Maybe Expr)) -- constant expression+  deriving (Show, Eq)++data FullType = FullType (Maybe TypeQualifier) TypeSpecifier+  deriving (Show, Eq)++-- sto+-- lay [sto]+-- int [sto]+-- inv [sto]+-- inv int sto+data TypeQualifier =+    TypeQualSto StorageQualifier+  | TypeQualLay LayoutQualifier (Maybe StorageQualifier)+  | TypeQualInt InterpolationQualifier (Maybe StorageQualifier)+  | TypeQualInv InvariantQualifier (Maybe StorageQualifier)+  | TypeQualInv3 InvariantQualifier InterpolationQualifier StorageQualifier+  deriving (Show, Eq)++data TypeSpecifier = TypeSpec (Maybe PrecisionQualifier) TypeSpecifierNoPrecision+  deriving (Show, Eq)++data InvariantQualifier = Invariant+  deriving (Show, Eq)++data InterpolationQualifier =+    Smooth+  | Flat+  | NoPerspective+  deriving (Show, Eq)++data LayoutQualifier = Layout [LayoutQualifierId]+  deriving (Show, Eq)++data LayoutQualifierId = LayoutQualId String (Maybe Expr) -- TODO Expr should be IntConstant+  deriving (Show, Eq)++data Statement =+  -- declaration statement+    DeclarationStatement Declaration+  -- jump statement+  | Continue+  | Break+  | Return (Maybe Expr)+  | Discard -- fragment shader only+  -- compound statement+  | CompoundStatement Compound+  -- expression statement+  | ExpressionStatement (Maybe Expr)+  -- selection statement+  | SelectionStatement Expr Statement (Maybe Statement)+  -- switch statement+  | SwitchStatement Expr [Statement]+  | CaseLabel CaseLabel+  -- iteration statement+  | While Condition Statement -- no new scope+  | DoWhile Statement Expr+  | For (Either (Maybe Expr) Declaration) (Maybe Condition) (Maybe Expr) Statement+    -- 1st stmt: expression or declaration, 2nd: no new scope+  deriving (Show, Eq)++data Compound = Compound [Statement]+  deriving (Show, Eq)++data Condition =+    Condition Expr+  | InitializedCondition FullType String Expr -- assignment expression+  deriving (Show, Eq)++data CaseLabel = Case Expr | Default+  deriving (Show, Eq)++data StorageQualifier =+    Const+  | Attribute -- vertex only+  | Varying+  | CentroidVarying+  | In+  | Out+  | CentroidIn+  | CentroidOut+  | Uniform+  deriving (Show, Eq)++data TypeSpecifierNoPrecision = TypeSpecNoPrecision TypeSpecifierNonArray (Maybe (Maybe Expr)) -- constant expression+  deriving (Show, Eq)++data TypeSpecifierNonArray =+    Void+  | Float+  | Int+  | UInt+  | Bool+  | Vec2+  | Vec3+  | Vec4+  | BVec2+  | BVec3+  | BVec4+  | IVec2+  | IVec3+  | IVec4+  | UVec2+  | UVec3+  | UVec4+  | Mat2+  | Mat3+  | Mat4+  | Mat2x2+  | Mat2x3+  | Mat2x4+  | Mat3x2+  | Mat3x3+  | Mat3x4+  | Mat4x2+  | Mat4x3+  | Mat4x4+  | Sampler1D+  | Sampler2D+  | Sampler3D+  | SamplerCube+  | Sampler1DShadow+  | Sampler2DShadow+  | SamplerCubeShadow+  | Sampler1DArray+  | Sampler2DArray+  | Sampler1DArrayShadow+  | Sampler2DArrayShadow+  | ISampler1D+  | ISampler2D+  | ISampler3D+  | ISamplerCube+  | ISampler1DArray+  | ISampler2DArray+  | USampler1D+  | USampler2D+  | USampler3D+  | USamplerCube+  | USampler1DArray+  | USampler2DArray+  | Sampler2DRect+  | Sampler2DRectShadow+  | ISampler2DRect+  | USampler2DRect+  | SamplerBuffer+  | ISamplerBuffer+  | USamplerBuffer+  | Sampler2DMS+  | ISampler2DMS+  | USampler2DMS+  | Sampler2DMSArray+  | ISampler2DMSArray+  | USampler2DMSArray+  | StructSpecifier (Maybe String) [Field]+  | TypeName String -- TODO user-defined type, should verify if it is declared+  deriving (Show, Eq)++data PrecisionQualifier = HighP | MediumP | LowP+  deriving (Show, Eq)++-- TODO The type qualifier can be present only when there is one or more declarators.+-- There other restrictions, see 4.1.8.+data Field = Field (Maybe TypeQualifier) TypeSpecifier [StructDeclarator]+  deriving (Show, Eq)++data StructDeclarator = StructDeclarator String (Maybe (Maybe Expr)) -- constant expression+  deriving (Show, Eq)++data Expr =+  -- primaryExpression+    Variable String+  | IntConstant IntConstantKind Integer+  | FloatConstant Float+  | BoolConstant Bool+  -- postfixExpression+  | Bracket Expr Expr+  | FieldSelection Expr String+  | MethodCall Expr FunctionIdentifier Parameters+  | FunctionCall FunctionIdentifier Parameters+  | PostInc Expr+  | PostDec Expr+  | PreInc Expr+  | PreDec Expr+  -- unary expression+  | UnaryPlus Expr+  | UnaryNegate Expr+  | UnaryNot Expr+  | UnaryOneComplement Expr+  -- binary expression+  | Mul Expr Expr+  | Div Expr Expr+  | Mod Expr Expr+  | Add Expr Expr+  | Sub Expr Expr+  | LeftShift Expr Expr+  | RightShift Expr Expr+  | Lt Expr Expr+  | Gt Expr Expr+  | Lte Expr Expr+  | Gte Expr Expr+  | Equ Expr Expr+  | Neq Expr Expr+  | BitAnd Expr Expr+  | BitXor Expr Expr+  | BitOr Expr Expr+  | And Expr Expr+  | Or Expr Expr+  | Selection Expr Expr Expr -- ternary _ ? _ : _ operator+  -- assignment, the left Expr should be unary expression+  | Equal Expr Expr+  | MulAssign Expr Expr+  | DivAssign Expr Expr+  | ModAssign Expr Expr+  | AddAssign Expr Expr+  | SubAssign Expr Expr+  | LeftAssign Expr Expr+  | RightAssign Expr Expr+  | AndAssign Expr Expr+  | XorAssign Expr Expr+  | OrAssign Expr Expr+  -- sequence+  | Sequence Expr Expr+  deriving (Show, Eq)++data IntConstantKind = Hexadecimal | Octal | Decimal+  deriving (Show, Eq)++data Parameters = ParamVoid | Params [Expr]+  deriving (Show, Eq)++data ParameterQualifier = InParameter | OutParameter | InOutParameter+  deriving (Show, Eq)++data ParameterTypeQualifier = ConstParameter+  deriving (Show, Eq)++data FunctionIdentifier =+    -- TODO could be refine (I think a precision qualifier is not permitted,+    -- nor a complete struct definition)+    FuncIdTypeSpec TypeSpecifier+  | FuncId String+  deriving (Show, Eq)+
+ Language/GLSL/Tests.hs view
@@ -0,0 +1,459 @@+module Language.GLSL.Tests where++import Text.ParserCombinators.Parsec hiding (State, parse) -- TODO clean+import Text.PrettyPrint.HughesPJClass (prettyShow, Pretty)+import Test.HUnit++import Language.GLSL.Syntax+import Language.GLSL.Parser+import Language.GLSL.Pretty ()++----------------------------------------------------------------------+-- exported tests+----------------------------------------------------------------------++tests :: IO ()+tests = do+  mapM_ runTestTT parsingTests+  return ()++parsingTests :: [Test]+parsingTests =+  [ legalExpressionsTests+  , illegalExpressionsTests+  , legalDeclarationsTests+  , illegalDeclarationsTests+  , legalFunctionDefinitionsTests++  , legalCommentsTests+  , illegalCommentsTests++  , TestLabel "expressions id" $ TestList $+    map expressionsId testExpressionsTrue+  , TestLabel "declarations id" $ TestList $+    map declarationsId testDeclarationsTrue+  , TestLabel "function definitions id" $ TestList $+    map functionDefinitionsId testFunctionDefinitionsTrue+  ]++----------------------------------------------------------------------+-- For QuickCheck testing+----------------------------------------------------------------------++-- Given an AST ast, pretty-print it and parse it back. The result be+-- equal to the original ast, i.e. (parse . pretty) == id+-- TODO refactor the common parts+-- TODO Befor it is possible to use QC, the AST should enforce more+-- constraints, and some sanity check funtions should be provided+-- (to build only legal ASTs).++parsePrettyId :: TranslationUnit -> Bool+parsePrettyId e = case pass translationUnit (prettyShow e) of+  Left _ -> False+  Right e' -> e == e'++parsePrettyIdExpr :: Expr -> Bool+parsePrettyIdExpr e = case pass expression (prettyShow e) of+  Left _ -> False+  Right e' -> e == e'++parsePrettyIdDecl :: Declaration -> Bool+parsePrettyIdDecl e = case pass declaration (prettyShow e) of+  Left _ -> False+  Right e' -> e == e'++check :: Pretty a => P a -> String -> IO ()+check p str = case pass p str of+  Left err -> print err+  Right ast -> putStrLn $ prettyShow ast++parsePrettyIdFunc :: ExternalDeclaration -> Bool+parsePrettyIdFunc e = case pass functionDefinition (prettyShow e) of+  Left _ -> False+  Right e' -> e == e'++expressionsId :: String -> Test+expressionsId str = TestCase . assertBool ("expressionsId: " ++ str) . parsePrettyIdExpr $ ast+  where ast = case pass expression str of+          Left _ -> error "does not even parse the original string"+          Right a -> a++declarationsId :: String -> Test+declarationsId str = TestCase . assertBool ("declarationsId: " ++ str) . parsePrettyIdDecl $ ast+  where ast = case pass declaration str of+          Left _ -> error "does not even parse the original string"+          Right a -> a++functionDefinitionsId :: String -> Test+functionDefinitionsId str = TestCase . assertBool ("functionDefinitionsId: " ++ str) . parsePrettyIdFunc $ ast+  where ast = case pass functionDefinition str of+          Left _ -> error "does not even parse the original string"+          Right a -> a++----------------------------------------------------------------------+-- helpers+----------------------------------------------------------------------++-- Just check if the parser passes of fails+pass :: P a -> String -> Either ParseError a+pass p = runParser (do {skipMany blank ; r <- p ; eof ; return r}) S "pass"++isRight :: Either a b -> Bool+isRight (Right _) = True+isRight (Left _) = False++isLeft :: Either a b -> Bool+isLeft = not . isRight++doesParse :: P a -> String -> Test+doesParse p str =+  TestCase . assertBool ("doesParse: " ++ str) . isRight . pass p $ str++doesNotParse :: P a -> String -> Test+doesNotParse p str =+  TestCase . assertBool ("doesNotParse: " ++ str) . isLeft . pass p $ str++----------------------------------------------------------------------+-- expressions+----------------------------------------------------------------------++legalExpressionsTests :: Test+legalExpressionsTests = TestLabel "legal expressions" $+  TestList $ map (doesParse expression) testExpressionsTrue++illegalExpressionsTests :: Test+illegalExpressionsTests = TestLabel "illegal expressions" $+  TestList $ map (doesNotParse expression) testExpressionsFalse++testExpressionsTrue :: [String]+testExpressionsTrue =+  [ "a"+  , "avoid"+  , "filters"+  , "0"+  , "1"+  , ".1"+  , "0x01"+  , "0xF"+  , "07"+  , "a++"+  , "a--"+  , "a++--"+  , "a--++"+  , "a++++"+  , "a----"+  , "++a"+  , "--a"+  , "++--a"+  , "--++a"+  , "++++a"+  , "----a"+  , "a ++"+  , "+a"+  , "+ a"+  , "a + b"+  , "a + b++"+  , "a + ++b"+  , "a + + b"+  , "a ++ +b"+  , "a()"+  , "float()"+  , "a ()"+  , "a( )"+  , "a ( )"+  , "a.a"+  , "a.a()"+  , "a.length()"+  , "a[1]"+  , "a[1].x"+  , "a[1].x()"+  , "a().b"+  , "a().b[1]"+  , "a().b()"+  , "a.b.c"+  ]++testExpressionsFalse :: [String]+testExpressionsFalse =+  [ "void"+  , "filter"+  , ".A"+  , "08"+  , "0A"+  , "+"+  , "++"+  , "a+"+  , "a +"+  , "a . a" -- TODO should it be allowed ?+  , "a[]"+--  , "a[1][2]" -- TODO it is illegal to declare an array of arrays+  ]++----------------------------------------------------------------------+-- declarations+----------------------------------------------------------------------++legalDeclarationsTests :: Test+legalDeclarationsTests = TestLabel "legal declarations" $+  TestList $ map (doesParse declaration) testDeclarationsTrue++illegalDeclarationsTests :: Test+illegalDeclarationsTests = TestLabel "illegal declarations" $+  TestList $ map (doesNotParse declaration) testDeclarationsFalse++testDeclarationsTrue :: [String]+testDeclarationsTrue =+  [ "int a;"+  , "int a, b, c;"+  , "precision highp float;"+  , "int a = 1;"+  , "struct a { int b; };"+  , "struct a { int b; float c; };"+  , "layout (origin_upper_left) in;"+  , "layout (origin_upper_left) in vec4 gl_FragCoord;"+  , "layout (origin_upper_left, pixel_center_integer) in vec4 gl_FragCoord;"+  , "bool success;"+  , "bool done = false;"+  , "int a = 123;"+  , "int a = 123u;"+  , "int a = 123U;"+  , "int a = 0123;"+  , "int a = 0123u;"+  , "int a = 0123U;"+  , "int a = 0x123;"+  , "int a = 0x123u;"+  , "int a = 0x123U;"+  , "int a = 0x12ABu;"+  , "int a = 0x12ABU;"+  , "int a = 0X123;"+  , "int a = 0X123u;"+  , "int a = 0X123U;"+  , "int a = 0X12ABu;"+  , "int a = 0X12ABU;"+  , "float a = 1.0;"+  , "float a = 1.;"+  , "float a = .0;"+  , "float a = 1e1;"+  , "float a = 1.0e1;"+  , "float a = 1.e1;"+  , "float a = 1.0e-1;"+  , "float a = 1.0e+1;"+  , "float a = 1.0e+1f;"+  , "float a = 1.0e+1F;"+  , "vec2 texcoord1, texcoord2;"+  , "mat3x2 m;"+  , "struct light { float intensity; vec3 position; } lightVar;"+  , "const struct light { float intensity; vec3 position; } lightVar;"+  , "float frequencies[3];"+  , "uniform vec4 lightPosition[4];"+  , "light lights[];"+  , "const int numLights = 2;"+  , "light lights[numLights];"+  , "float[5] a;"+  , "float a[5];"+  , "float a[5] = float[](3.4, 4.2, 5.0, 5.2, 1.1);"+  , "float a[5] = float[5](3.4, 4.2, 5.0, 5.2, 1.1);"+  , "const int a;"+  , "in int a;"+  , "centroid in int a;"+  , "smooth in int a;"++  , "bool success;"+  , "bool done = false;"+  , "int i;"+  , "int i, j = 42;"+  , "int j = 1;"+  , "uint k = 3u;"+  , "float x = 1.0;"+  , "float a = 1.5, b;"+  , "vec2 texcoord1, texcoord2;"+  , "vec3 position;"+  , "vec4 myRGBA;"+  , "ivec2 textureLookup;"+  , "bvec3 less;"+  , "mat2 mat2D;"+  , "mat3 optMatrix;"+  , "mat4 view;"+  , "mat3x2 m;"+  , "struct light\+    \{\+    \float intensity;\+    \vec3 position;\+    \} lightVar;"+  , "light lightVar3;"+  , "float frequencies[3];"+  , "uniform vec4 lightPosition[4];"+  , "light lights[];"+  , "const int numLights = 2;"+  , "light lights[numLights];"+  , "int a[5];"+  , "const float coef = 2.75;"+  , "const vec3 zAxis = vec3 (0.0, 0.0, 1.0);"+  , "in vec4 position;"+  , "in vec3 normal;"+  , "in vec2 texCoord[4];"+  , "in float foo[];"+  , "centroid out vec2 TexCoord;"+  , "invariant centroid out vec4 Color;"+  , "invariant flat centroid out vec4 Color;"+  , "noperspective out float temperature;"+  , "flat out vec3 myColor;"+  , "noperspective centroid out vec2 myTexCoord;"+  , "out vec4 FragmentColor;"+  , "out uint Luminosity;"+  , "uniform Transform\+    \{\+    \  mat4 ModelViewMatrix;\+    \  mat4 ModelViewProjectionMatrix;\+    \  uniform mat3 NormalMatrix;\+    \  float Deformation;\+    \};"+  , "in Material\+    \{\+    \  smooth in vec4 Color1;\+    \  smooth vec4 Color2;\+    \  vec2 TexCoord;\+    \};"+  , "out Vertex\+    \{\+    \  vec4 Position;\+    \  vec2 Texture;\+    \} Coords;"+  , "uniform Transform {\+    \  mat4 ModelViewMatrix;\+    \  mat4 ModelViewProjectionMatrix;\+    \  float Deformation;\+    \} transforms[4];"+  , "layout (triangles) in;"+  , "layout (origin_upper_left) in vec4 gl_FragCoord;"+  , "layout (pixel_center_integer) in vec4 gl_FragCoord;"+  , "layout (origin_upper_left, pixel_center_integer) in vec4 gl_FragCoord;"+  , "layout (triangle_strip, max_vertices = 60) out;"+  , "layout (triangle_strip) out;"+  , "layout (max_vertices = 60) out;"+  , "layout (shared, column_major) uniform;"+  , "layout (std140) uniform Transform {\+    \  mat4 M1;\+    \  layout (column_major) mat4 M2;\+    \  mat3 N1;\+    \};"+  , "flat out vec4 gl_FrontColor;"+  , "lowp float color;"+  , "out mediump vec2 P;"+  , "highp mat4 m;"+  , "precision highp float;"+  , "precision highp int;"+  , "precision mediump int;"+  , "invariant gl_Position;"+  , "out vec3 Color;"+  , "invariant Color;"+  , "invariant centroid out vec3 Color;"+  , "vec4 color = vec4(0.0, 1.0, 0.0, 1.0);"+  , "int i = 1 - 5 * 4 + 3;"+  , "int i = 1 - (5 * 4) + 3;"+  , "int i = (1 - 5) * 4 + 3;"+  , "int i = (1 - 5) * (4 + 3);"+  , "bool b = 1 < 2;"++  ]++testDeclarationsFalse :: [String]+testDeclarationsFalse =+  [ "int a"+  , "int a, b c;"+  , "precision high float;"+  , "precision float f();"+  , "int float;"+  , "struct a { };"+  , "struct a { int b, float c; };"+  , "int a = 0128;"+  , "int a = 0xu;"+  , "float a = .e1;"+  , "float a = 1.0e+1G;"+{- TODO embeded structs are not possible.+  , "struct light {\+    \  struct { float intensity; };\+    \  vec3 position;\+    \} lightVar;"+-}+  , "int f();" -- function declaration should be at top level -- TODO put these in legalTranslationUnitsTests+  , "int f(void);"+  , "int f ( void ) ;"+  , "lowp ivec2 foo(lowp mat3);"+  , "float[5] foo();"+  , "void foo (float[5]);"+  , "void foo (float a[5]);"+  , "float[] foo();"+  , "float[5] foo();"+  , "float[5] foo(int[4]);"+  , "int f ();"+-- TODO qualifier only possible where declarators.+--  , "const struct light { float intensity; vec3 position; };"+  , "float a[5][3];"+-- interpolation qualifier may only preced [centroid]in/out.+--  , "smooth const int a;"+  ]++----------------------------------------------------------------------+-- function definitions+----------------------------------------------------------------------++legalFunctionDefinitionsTests :: Test+legalFunctionDefinitionsTests = TestLabel "legal function definition" $+  TestList $ map (doesParse functionDefinition) testFunctionDefinitionsTrue++testFunctionDefinitionsTrue :: [String]+testFunctionDefinitionsTrue =+  [ "void main ()\n\+    \{\n\+    \}"+  , "void main ()\n\+    \{\n\+    \  if (intensity < 0.0)\n\+    \    return;\n\+    \}"+  ]++----------------------------------------------------------------------+-- comments (inside simple declarations)+----------------------------------------------------------------------++legalCommentsTests :: Test+legalCommentsTests = TestLabel "legal comments" $+  TestList $ map (doesParse declaration) testCommentsTrue++illegalCommentsTests :: Test+illegalCommentsTests = TestLabel "illegal comments" $+  TestList $ map (doesNotParse declaration) testCommentsFalse++testCommentsTrue :: [String]+testCommentsTrue =+  [ "int a; // a comment"+  , "int a; /* another comment */"+  , "int a; // a comment\n"+  , "int a; /* another comment */\n"+  , "int a; /* another comment\non multiple\nlines.*/"+  , "int a; /* another comment\non multiple\nlines.*/\n"+  , "int a; /* another comment\non multiple\nlines.\n*/"+  , "/* before */ int a;"+  , "// before\nint a;"+  , "int /* middle */ a;"+  , "int/* middle */a;"+  , "int a/* middle */;"+  , "int a; /* not a // nested comment */"+  ]++testCommentsFalse :: [String]+testCommentsFalse =+  [ "int a; /* no /* nested */  comment */"+  ]++----------------------------------------------------------------------+-- translation unit+----------------------------------------------------------------------++legalTranslationUnitsTests :: Test+legalTranslationUnitsTests = TestLabel "legal translation unit" $+  TestList $ map (doesParse translationUnit) $+  testDeclarationsTrue ++ testFunctionDefinitionsTrue+
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ bin/glsl-pprint.hs view
@@ -0,0 +1,41 @@+module Main where++import System.Environment (getArgs)+import Text.PrettyPrint.HughesPJClass++import Language.GLSL+import Language.GLSL.Tests (parsePrettyId, tests)++info :: [String]+info = +  [ "This is glsl-pprint."+  ]++usage :: [String]+usage = info +++  ["usage:\n  glsl-pprint [-p] filename\n  glsl-pprint --run-tests"]++main :: IO ()+main = do+  args <- getArgs+  case args of+    ["--run-tests"] -> tests+    [fn] -> do+      content <- readFile fn+      putStrLn . show . parse $ content+    ["--check", fn] -> do+      content <- readFile fn+      case parse content of+        Left err -> putStrLn $ "parse error:\n" ++ show err+        Right ast ->+          if parsePrettyId ast+            then putStrLn "parse . pretty == id"+            else putStrLn "parse . pretty /= id"+    ["-p", fn] -> do+      content <- readFile fn+      case parse content of+        Left err -> putStrLn $ "parse error:\n" ++ show err+        Right ast -> print . pPrint $ ast+    _ -> putStrLn $ unlines usage++
+ language-glsl.cabal view
@@ -0,0 +1,45 @@+name:                language-glsl+version:             0.0.0+Cabal-Version:       >= 1.8+synopsis:            GLSL abstract syntax tree, parser, and pretty-printer+description:+  The package language-glsl is a Haskell library for the+  representation, the parsing, and the pretty-printing of+  GLSL 1.50 code.++category:            Language, Graphics+license:             BSD3+license-file:        LICENSE+author:              Vo Minh Thu+maintainer:          thu@hypered.be+homepage:            https://github.com/noteed/language-glsl+bug-reports:         https://github.com/noteed/language-glsl/issues+build-type:          Simple++source-repository head+  type: git+  location: https://github.com/noteed/language-glsl++library+  build-depends:       base >= 4 && < 5,+                       HUnit,+                       parsec,+                       prettyclass+  ghc-options:         -Wall+  exposed-modules:     Language.GLSL,+                       Language.GLSL.Parser,+                       Language.GLSL.Pretty,+                       Language.GLSL.Syntax,+                       Language.GLSL.Tests++executable glsl-pprint+  main-is:             glsl-pprint.hs+  hs-source-dirs:      bin/+  build-depends:       base >= 4 && < 5,+                       HUnit,+                       language-glsl,+                       parsec,+                       pretty,+                       prettyclass+  ghc-options:         -Wall+