diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/Language/GLSL.hs b/Language/GLSL.hs
new file mode 100644
--- /dev/null
+++ b/Language/GLSL.hs
@@ -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
+
diff --git a/Language/GLSL/Parser.hs b/Language/GLSL/Parser.hs
new file mode 100644
--- /dev/null
+++ b/Language/GLSL/Parser.hs
@@ -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
+
diff --git a/Language/GLSL/Pretty.hs b/Language/GLSL/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/Language/GLSL/Pretty.hs
@@ -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:"
+
diff --git a/Language/GLSL/Syntax.hs b/Language/GLSL/Syntax.hs
new file mode 100644
--- /dev/null
+++ b/Language/GLSL/Syntax.hs
@@ -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)
+
diff --git a/Language/GLSL/Tests.hs b/Language/GLSL/Tests.hs
new file mode 100644
--- /dev/null
+++ b/Language/GLSL/Tests.hs
@@ -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
+
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/bin/glsl-pprint.hs b/bin/glsl-pprint.hs
new file mode 100644
--- /dev/null
+++ b/bin/glsl-pprint.hs
@@ -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
+
+
diff --git a/language-glsl.cabal b/language-glsl.cabal
new file mode 100644
--- /dev/null
+++ b/language-glsl.cabal
@@ -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
+