ParameterizedStatementTests.lhs

Tests for the infrastructure to create type safe access to databases -
the information needed is gathered during typechecking and exposed in
the StatementType annotation, so these are really just a subset of the
type checking tests.

> module Database.HsSqlPpp.Tests.ParameterizedStatementTests (parameterizedStatementTests) where
>
> import Test.HUnit
> import Test.Framework
> import Test.Framework.Providers.HUnit
> --import Debug.Trace
> import Data.Generics
> import Data.Generics.Uniplate.Data
>
>
> import Database.HsSqlPpp.Types
> import Database.HsSqlPpp.Annotation
> import Database.HsSqlPpp.Parser
> import Database.HsSqlPpp.TypeChecker
> import Database.HsSqlPpp.Catalog
>
> data Item = Group String [Item]
>           | Statements [(String, [CatalogUpdate], Maybe ParameterizedStatementType)]
>
> parameterizedStatementTests :: Test.Framework.Test
> parameterizedStatementTests =
>   testGroup "parameterized statement tests" $ itemToTft testData
>
> testData :: Item
> testData =
>   Group "parameterized statement tests" [
>     Group "simple selects" [ Statements [
>        ("select test();"
>        ,[CatCreateFunction FunName "test" [] (Pseudo Void) False]
>        ,Just ([],[]))
>       ,("select adnum,adbin from pg_attrdef;"
>        ,[]
>        ,Just ([],[("adnum", ScalarType "int2")
>                  ,("adbin", ScalarType "pg_node_tree")]))
>       ,("select adnum,adbin from pg_attrdef where adnum= ?;"
>        ,[]
>        ,Just ([ScalarType "int2"],[("adnum", ScalarType "int2")
>                                   ,("adbin", ScalarType "pg_node_tree")]))
>       ,("select count(1) from pg_attrdef;"
>        ,[]
>        ,Just ([],[("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]
>        ,Just ([ScalarType "int4"],[("test",ScalarType "text")]))
>        ]
>     ]
>    ,Group "simple dml" [ Statements [
>        ("insert into testt values (1, 'test');"
>        ,[CatCreateTable "testt" [("c1", typeInt)
>                                 ,("c2", ScalarType "text")] []]
>        ,Just ([],[]))
>       ,("insert into testt (c1,c2) values (?, ?);"
>        ,[CatCreateTable "testt" [("c1", typeInt)
>                                 ,("c2", ScalarType "text")] []]
>        ,Just ([typeInt, ScalarType "text"],[]))
>       ,("insert into testt (c1,c2) values (1, 'test') returning c1;"
>        ,[CatCreateTable "testt" [("c1", typeInt)
>                                 ,("c2", ScalarType "text")] []]
>        ,Just ([],[("c1",typeInt)]))
>       ,("insert into testt (c1,c2) values (?, ?) returning c1 as d1, c2;"
>        ,[CatCreateTable "testt" [("c1", typeInt)
>                                 ,("c2", ScalarType "text")] []]
>        ,Just ([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")] []]
>        ,Just ([typeInt, ScalarType "text", typeInt],[("c2", ScalarType "text")]))
>       ,("update testt set (c1,c2) = (?,?);"
>        ,[CatCreateTable "testt" [("c1", typeInt)
>                                 ,("c2", ScalarType "text")] []]
>        ,Just ([typeInt, ScalarType "text"],[]))
>       ,("delete from blah where c1= ? returning c2;"
>        ,[CatCreateTable "blah" [("c1", typeInt)
>                                 ,("c2", ScalarType "text")] []]
>        ,Just ([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] -> Maybe ParameterizedStatementType -> Test.Framework.Test
> testStatementType src eu st = testCase ("typecheck " ++ src) $
>   let ast = case parseStatements "" src of
>                                         Left e -> error $ show e
>                                         Right l -> l
>   in case typeCheckParameterizedStatement makeCat (head ast) of
>        Left e -> error $ show e
>        Right aast -> --trace (ppShow aast) $
>                      let is = getTopLevelInfo aast
>                          er = getTypeErrors aast
>                      in case is of
>                                 _ | not (null er) -> assertFailure $ show er
>                                 is1 -> assertEqual ("typecheck " ++ src) st is1
>                                 -- _ -> assertFailure ("expected onne statementinfo, got " ++ show is)
>   where
>     getTypeErrors :: Data a => a -> [TypeError]
>     getTypeErrors = universeBi
>     getTopLevelInfo a = stType $ getAnnotation a
>     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]