hssqlppp-0.2.0: Database/HsSqlPpp/Tests/ParameterizedStatementTests.lhs
Copyright 2010 Jake Wheat
Tests for the infrastructure to create type safe access to databases -
the information needed is gathered during typechecking and exposed
in the StatementType annotation.
> module Database.HsSqlPpp.Tests.ParameterizedStatementTests (parameterizedStatementTests) where
> import Test.HUnit
> import Test.Framework
> import Test.Framework.Providers.HUnit
> --import Text.Show.Pretty
> --import Debug.Trace
> import Database.HsSqlPpp.Ast.SqlTypes
> import Database.HsSqlPpp.Ast.Annotation
> import Database.HsSqlPpp.Parsing.Parser
> import Database.HsSqlPpp.Ast.TypeChecker
> import Database.HsSqlPpp.Ast.Catalog
> data Item = Group String [Item]
> | Statements [(String, [CatalogUpdate], StatementType)]
> parameterizedStatementTests :: [Test.Framework.Test]
> parameterizedStatementTests = itemToTft testData
> testData :: Item
> testData =
> Group "parameterized statement tests" [
> Group "simple selects" [ Statements [
> ("select test();"
> ,[CatCreateFunction FunName "test" [] (Pseudo Void) False]
> ,StatementType [] [])
> ,("select adnum,adbin from pg_attrdef;"
> ,[]
> ,StatementType [] [("adnum", ScalarType "int2")
> ,("adbin", ScalarType "text")])
> ,("select adnum,adbin from pg_attrdef where oid= ?;"
> ,[]
> ,StatementType [ScalarType "oid"] [("adnum", ScalarType "int2")
> ,("adbin", ScalarType "text")])
> ,("select count(1) from pg_attrdef;"
> ,[]
> ,StatementType [] [("count", ScalarType "int8")])
> {-,("select test($1);"
> ,[CatCreateFunction FunName "test" [ScalarType "int4"] (ScalarType "text") False]
> ,StatementType [ScalarType "int4"] [("test",ScalarType "text")])
> ,-}
> ,("select test(?);"
> ,[CatCreateFunction FunName "test" [ScalarType "int4"] (ScalarType "text") False]
> ,StatementType [ScalarType "int4"] [("test",ScalarType "text")])
> ]
> ]
> ,Group "simple dml" [ Statements [
> ("insert into testt values (1, 'test');"
> ,[CatCreateTable "testt" [("c1", typeInt)
> ,("c2", ScalarType "text")] []]
> ,StatementType [] [])
> ,("insert into testt (c1,c2) values (?, ?);"
> ,[CatCreateTable "testt" [("c1", typeInt)
> ,("c2", ScalarType "text")] []]
> ,StatementType [typeInt, ScalarType "text"] [])
> ,("insert into testt (c1,c2) values (1, 'test') returning c1;"
> ,[CatCreateTable "testt" [("c1", typeInt)
> ,("c2", ScalarType "text")] []]
> ,StatementType [] [("c1",typeInt)])
> ,("insert into testt (c1,c2) values (?, ?) returning c1 as d1, c2;"
> ,[CatCreateTable "testt" [("c1", typeInt)
> ,("c2", ScalarType "text")] []]
> ,StatementType [typeInt, ScalarType "text"] [("d1", typeInt)
> ,("c2", ScalarType "text")])
> {-,("insert into testt (c1,c2) values (?, ?) returning *;"
> ,[CatCreateTable "testt" [("c1", typeInt)
> ,("c2", ScalarType "text")] []]
> ,StatementType [typeInt, ScalarType "text"] [("c1", typeInt)
> ,("c2", ScalarType "text")])-}
> ,("update testt set c1= ?,c2= ? where c1= ? returning c2;"
> ,[CatCreateTable "testt" [("c1", typeInt)
> ,("c2", ScalarType "text")] []]
> ,StatementType [typeInt, ScalarType "text", typeInt] [("c2", ScalarType "text")])
> ,("update testt set (c1,c2) = (?,?);"
> ,[CatCreateTable "testt" [("c1", typeInt)
> ,("c2", ScalarType "text")] []]
> ,StatementType [typeInt, ScalarType "text"] [])
> ,("delete from blah where c1= ? returning c2;"
> ,[CatCreateTable "blah" [("c1", typeInt)
> ,("c2", ScalarType "text")] []]
> ,StatementType [typeInt] [("c2", ScalarType "text")])
> ]
> ]
> ]
select a,b from c where d=e group by f having g=h orderby i limit j offset k;
select function(a,b);
insert into a (b,c) values (d,e) returning f,g
update a set b=c,d=e where f=g returning h,i
delete from t where a=b returning c,d
rough list of grammar elements to possibly add inference support to:
where top level - >maybeboolexpr
having
limit, offset
values for table literal or insert
set clause
rowsetclause
onexpr, joinon?
windowfn
liftoperator
selectitem?
castexpression
caseexpression
funcall
inpredicate
TODO: add support in each of these places for position args only when
doing typecheckPS
do typecheck error if come across ? when not doing typecheckPS
make sure ? fails type check if not in a valid place in the ast
================================================================================
> testStatementType :: String -> [CatalogUpdate] -> StatementType -> Test.Framework.Test
> testStatementType src eu st = testCase ("typecheck " ++ src) $
> let ast = case parseSql "" src of
> Left e -> error $ show e
> Right l -> l
> in case typeCheckPS makeCat (head ast) of
> Left e -> error $ show e
> Right aast -> --trace (ppShow aast) $
> let is = getTopLevelInfos [aast]
> er = concatMap snd $ getTypeErrors [aast]
> in case is of
> _ | not (null er) -> assertFailure $ show er
> [Just is1] -> assertEqual ("typecheck " ++ src) st is1
> _ -> assertFailure ("expected onne statementinfo, got " ++ show is)
> where
> makeCat = case updateCatalog defaultTemplate1Catalog eu of
> Left x -> error $ show x
> Right e -> e
> itemToTft :: Item -> [Test.Framework.Test]
> itemToTft (Statements es) = map (\(a,b,c) -> testStatementType a b c) es
> itemToTft (Group s is) = [testGroup s $ concatMap itemToTft is]