packages feed

hssqlppp 0.4.1 → 0.4.2

raw patch · 53 files changed

+5733/−15 lines, 53 filesdep +HUnitdep +groomdep +test-frameworkdep ~basedep ~mtldep ~sybPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, groom, test-framework, test-framework-hunit

Dependency ranges changed: base, mtl, syb, transformers

API changes (from Hackage documentation)

Files

hssqlppp.cabal view
@@ -1,13 +1,13 @@ Name:                hssqlppp-Version:             0.4.1+Version:             0.4.2 Synopsis:            SQL parser and type checker License:             BSD3 License-file:        LICENSE Author:              Jake Wheat Maintainer:          jakewheatmail@gmail.com Build-Type:          Simple-Cabal-Version:       >=1.6-copyright:           Copyright 2009-2011 Jake Wheat+Cabal-Version:       >=1.10+copyright:           Copyright 2009-2014 Jake Wheat stability:           pre-alpha homepage:            http://jakewheat.github.com/hssqlppp/ bug-reports:         https://github.com/JakeWheat/hssqlppp/issues@@ -31,15 +31,16 @@  Library   Build-Depends:     base >= 4 && < 5,-                     mtl >= 2.0.1.0 && < 2.2,+                     mtl >= 2.2 && < 2.3,                      containers >= 0.3.0.0 && < 0.6,                      parsec >= 3.1 && < 3.2,                      pretty >= 1.1 && < 1.2,-                     syb >= 0.1.0.2 && < 0.5,+                     syb >= 0.4 && < 0.5,                      uniplate >= 1.6 && < 1.7,-                     transformers >= 0.2.2.0 && < 0.4,+                     transformers >= 0.4 && < 0.5,                      template-haskell +  default-language:  Haskell2010   hs-source-dirs:    src   Exposed-modules:   Database.HsSqlPpp.Ast                      Database.HsSqlPpp.Annotation@@ -68,9 +69,74 @@                      Database.HsSqlPpp.Internals.AstInternal                      Database.HsSqlPpp.Internals.TypeType -  extensions:        TupleSections-                     DeriveDataTypeable,-                     ScopedTypeVariables,-                     PatternGuards,-                     FlexibleContexts,-                     TemplateHaskell+Test-Suite Tests+  type:                exitcode-stdio-1.0+  main-is:             Tests.lhs+  hs-source-dirs:      src,+                       src-extra/tests,+                       src-extra/util+  Build-Depends:       base >=4.6 && <4.8,+                       mtl >= 2.2 && < 2.3,+                       containers >= 0.3.0.0 && < 0.6,+                       parsec >= 3.1 && < 3.2,+                       pretty >= 1.1 && < 1.2,+                       syb >= 0.4 && < 0.5,+                       uniplate >= 1.6 && < 1.7,+                       transformers >= 0.4 && < 0.5,+                       template-haskell,+                       HUnit >= 1.2 && < 1.3,+                       test-framework >= 0.8 && < 0.9,+                       test-framework-hunit >= 0.3 && < 0.4,+                       groom >= 0.1 && < 0.2+  Other-Modules:       Database.HsSqlPpp.Tests.TypeChecking.Insert+                       Database.HsSqlPpp.Tests.TypeChecking.Misc+                       Database.HsSqlPpp.Tests.TypeChecking.Into+                       Database.HsSqlPpp.Tests.TypeChecking.Literals+                       Database.HsSqlPpp.Tests.TypeChecking.RowCtors+                       Database.HsSqlPpp.Tests.TypeChecking.SpecialFunctions+                       Database.HsSqlPpp.Tests.TypeChecking.Plpgsql+                       Database.HsSqlPpp.Tests.TypeChecking.SimpleExpressions+                       Database.HsSqlPpp.Tests.TypeChecking.MiscExpressions+                       Database.HsSqlPpp.Tests.TypeChecking.Joins+                       Database.HsSqlPpp.Tests.TypeChecking.Qualification+                       Database.HsSqlPpp.Tests.TypeChecking.TableRefTests+                       Database.HsSqlPpp.Tests.TypeChecking.Update+                       Database.HsSqlPpp.Tests.TypeChecking.CombineSelects+                       Database.HsSqlPpp.Tests.TypeChecking.MiscSelects+                       Database.HsSqlPpp.Tests.TypeChecking.Drops+                       Database.HsSqlPpp.Tests.TypeChecking.CatalogChaining+                       Database.HsSqlPpp.Tests.TypeChecking.Delete+                       Database.HsSqlPpp.Tests.TypeChecking.SelectFrom+                       Database.HsSqlPpp.Tests.TypeChecking.Creates+                       Database.HsSqlPpp.Tests.TypeChecking.CaseExpressions+                       Database.HsSqlPpp.Tests.TypeChecking.TypeCheckTests+                       Database.HsSqlPpp.Tests.TypeChecking.Utils+                       Database.HsSqlPpp.Tests.TypeChecking.TypeInferenceTests+                       Database.HsSqlPpp.Tests.TypeChecking.SimpleSelects+                       Database.HsSqlPpp.Tests.TypeChecking.TpchTests+                       Database.HsSqlPpp.Tests.TypeChecking.Triggers+                       Database.HsSqlPpp.Tests.FixTree.FixUpIdentifiersTests+                       Database.HsSqlPpp.Tests.FixTree.ExplicitCasts+                       Database.HsSqlPpp.Tests.Tests+                       Database.HsSqlPpp.Tests.TestUtils+                       Database.HsSqlPpp.Tests.QuasiQuoteTests+                       Database.HsSqlPpp.Tests.Parsing.Dml+                       Database.HsSqlPpp.Tests.Parsing.Misc+                       Database.HsSqlPpp.Tests.Parsing.Plpgsql+                       Database.HsSqlPpp.Tests.Parsing.CreateTable+                       Database.HsSqlPpp.Tests.Parsing.FunctionsDdl+                       Database.HsSqlPpp.Tests.Parsing.Selects+                       Database.HsSqlPpp.Tests.Parsing.ParserTests+                       Database.HsSqlPpp.Tests.Parsing.Expressions+                       Database.HsSqlPpp.Tests.Parsing.MiscDdl+                       Database.HsSqlPpp.Tests.Parsing.Utils+                       Database.HsSqlPpp.Tests.ParameterizedStatementTests+                       Database.HsSqlPpp.Tests.TpchData+                       Database.HsSqlPpp.Utils.Here+                       Database.HsSqlPpp.Utils.PgUtils+                       Database.HsSqlPpp.Utils.CatalogReader+++  other-extensions:    TupleSections,DeriveDataTypeable+  default-language:    Haskell2010+  ghc-options:         -Wall
+ src-extra/tests/Database/HsSqlPpp/Tests/FixTree/ExplicitCasts.lhs view
@@ -0,0 +1,85 @@++Tests using the tpch queries. Just tests the result type at the+moment.++> module Database.HsSqlPpp.Tests.FixTree.ExplicitCasts+>     (explicitCastTests) where+>+> import Test.HUnit+> import Test.Framework+> import Test.Framework.Providers.HUnit+> --import Data.List+> import Control.Monad+>+> --import Database.HsSqlPpp.Utils.Here+> import Database.HsSqlPpp.Parser+> import Database.HsSqlPpp.TypeChecker+> --import Database.HsSqlPpp.Annotation+> import Database.HsSqlPpp.Catalog+> import Database.HsSqlPpp.Types+> --import Database.HsSqlPpp.Utils.PPExpr+> --import Database.HsSqlPpp.Tests.TestUtils+> import Database.HsSqlPpp.Pretty+> --import Database.HsSqlPpp.Tests.TpchData+> import Text.Groom+> import Database.HsSqlPpp.Tests.TestUtils+++> --import Data.Data+> --import Data.Generics.Uniplate.Data+> --import Database.HsSqlPpp.Ast++>+> data Item = Group String [Item]+>           | Query String String+>+> explicitCastTests :: Test.Framework.Test+> explicitCastTests = itemToTft explicitCastTestData+>+> explicitCastTestData :: Item+> explicitCastTestData =+>   Group "explicitcasts" [+>     Query "select a+b from t;" "select (a::float8) + (b::float8) from t;"+>    ,Query "select case true when true then 1::int else 1::float4 end;"+>           "select case true when true then (1::int)::float4 else 1::float4 end;"+>    ,Query "select case when true then 1::int else 1::float4 end;"+>           "select case when true then (1::int)::float4 else 1::float4 end;"+>    ,Query "select 3::int between 1::float8 and 4::numeric;"+>           "select (3::int)::float8 between 1::float8 and (4::numeric)::float8;"+>    ,Query "select a from t where c between 1.0 and 1.2"+>           "select a from t where c between 1.0::numeric and 1.2::numeric"+>    ,Query "select a from t where d in ('a', 'bc')"+>           "select a from t where d in ('a'::char, 'bc'::char)"+>   ]++> itemToTft :: Item -> Test.Framework.Test+> itemToTft (Group s is) = testGroup s $ map itemToTft is+> itemToTft (Query sql sql1) = testCase ("ec " ++ sql) $ do+>   --putStrLn $ ppExpr $ ptc sql+>   let ast = {-resetAnnotations $-} addExplicitCasts $ ptc sql+>       ast1 = {-resetAnnotations $-} canonicalizeTypeNames $ ptc sql1+>   when (resetAnnotations ast /= resetAnnotations ast1)+>     $ putStrLn $ printQueryExpr ast+>        ++ "\n" ++ printQueryExpr ast1+>        ++ "\n\n" ++ groom ast+>        ++ "\n\n" ++ groom ast1+>        ++ "\n\n"+>   assertEqual "" (resetAnnotations ast) (resetAnnotations ast1)+>   where+>     ptc s = typeCheckQueryExpr cat+>             $  case parseQueryExpr "" s of+>                  Left e -> error $ show e+>                  Right l -> l++> cat :: Catalog+> cat = case updateCatalog defaultTemplate1Catalog testCatalog of+>         Left x -> error $ show x+>         Right e -> e++++> testCatalog :: [CatalogUpdate]+> testCatalog = [CatCreateTable "t" [("a", typeFloat4)+>                                   ,("b", typeInt)+>                                   ,("c", typeNumeric)+>                                   ,("d", typeChar)] []]
+ src-extra/tests/Database/HsSqlPpp/Tests/FixTree/FixUpIdentifiersTests.lhs view
@@ -0,0 +1,229 @@++cd /home/jake/wd/hssqlppp/trunk/src/lib/Database/HsSqlPpp/Internals && uuagc --genlinepragmas -dcfwsp AstInternal.ag && cd /home/jake/wd/hssqlppp/trunk/ && cabal build++> module Database.HsSqlPpp.Tests.FixTree.FixUpIdentifiersTests+>     (fixUpIdentifiersTests) where+>+> import Test.HUnit+> import Test.Framework+> import Test.Framework.Providers.HUnit+> --import Data.Generics.Uniplate.Data+> import Control.Monad++> import Database.HsSqlPpp.Parser+> import Database.HsSqlPpp.TypeChecker+> import Database.HsSqlPpp.Ast+> --import Database.HsSqlPpp.Annotation+> import Database.HsSqlPpp.Catalog+> import Database.HsSqlPpp.Types+> --import Database.HsSqlPpp.Utils.PPExpr+> --import Database.HsSqlPpp.Tests.TestUtils+> import Database.HsSqlPpp.Pretty+> --import Database.HsSqlPpp.Tests.TpchData+> --import Database.HsSqlPpp.Utils.Here+> import Database.HsSqlPpp.Tests.TestUtils++> data Item = Group String [Item]+>           | Item [CatalogUpdate] String String+>           | SItem [CatalogUpdate] String String+>+> fixUpIdentifiersTests :: Test.Framework.Test+> fixUpIdentifiersTests = itemToTft fixUpIdentifiersTestsData+>+> fixUpIdentifiersTestsData :: Item+> fixUpIdentifiersTestsData = Group "cantests"+>   [Group "select lists"+>     [Item db1 "select a,b from t;" "select t.a as a, t.b as b from t as t(a,b);"+>     ,Item db1 "select * from t;" "select t.a as a, t.b as b from t as t(a,b);"+>     ,Item db1 "select * from (select a from t) t;"+>               "select t.a as a from (select t.a as a from t as t(a,b)) as t(a);"+>     ,Item db1 "select * from generate_series(1,5);"+>               "select generate_series.generate_series as generate_series\n\+>               \from generate_series(1,5) as generate_series(generate_series);"+>     ,Item db1 "select a,c from t,u;"+>               "select t.a as a, u.c as c from t as t(a,b),u as u(c,d);"+>     ,Item db1 "select * from t,u;"+>               "select t.a as a,t.b as b,u.c as c,u.d as d \n\+>               \from t as t(a,b),u as u(c,d);"+>     ,Item db1 "select t.* from t,u;"+>               "select t.a as a, t.b as b from t as t(a,b),u as u(c,d);"+>     ,Item db1 "select u.* from t,u;"+>               "select u.c as c,u.d as d from t as t(a,b),u as u(c,d);"+>     ,Item db1 "select t.*,u.*,* from t,u;"+>               "select t.a as a, t.b as b,\n\+>               \       u.c as c, u.d as d,\n\+>               \       t.a as a, t.b as b, u.c as c, u.d as d\n\+>               \  from t as t(a,b),u as u(c,d);"+>     ,Item db1 "select v from v;" "select v.v as v from v as v(v);"+>     ,Item db1 "select count(*) from t;"+>               "select count(true) as count from t as t(a,b);"+>     ]+>   ,Group "trefs"+>     [Item db1 "select * from generate_series(1,5) g;"+>               "select g.g as g\n\+>               \from generate_series(1,5) as g(g);"+>     ,Item db1 "select a from t as x;"+>               "select x.a as a from t as x(a,b);"+>     ,Item db1 "select * from t as x(f,g);"+>               "select x.f as f ,x.g as g from t as x(f,g);"+>     ]+>   ,Group "where"+>     [Item db1 "select a,b from t where a > b;"+>               "select t.a as a, t.b as b from t as t(a,b) where t.a > t.b;"+>     ,Item db1 "select a,c from t,u where b = d;"+>               "select t.a as a,u.c as c\n\+>               \  from t as t(a,b),u as u(c,d)\n\+>               \  where t.b = u.d;"+>     ]+>   ,Group "groupby"+>     [Item db1 "select a,sum(b) from t group by a;"+>               "select t.a as a,sum(t.b) as sum\n\+>               \from t as t(a,b) group by t.a;"+>     ]+>   ,Group "having"+>     [Item db1 "select a,sum(b) from t group by a having a > b;"+>               "select t.a as a,sum(t.b) as sum from t as t(a,b)\n\+>               \group by t.a having t.a > t.b;"+>     ]+>   ,Group "orderby"+>     [Item db1 "select a from t order by b;"+>               "select t.a as a from t as t(a,b) order by t.b;"+>     ]+>    -- fixme: needs some work before these pass+>   {-,Group "ctes"+>     [Item []   "with ta as (select 1 as a, 2 as b)\n\+>                 \select * from ta;"+>+>                 "with ta(a,b) as (select 1 as a, 2 as b)\n\+>                 \select ta.a as a, ta.b as b from ta as ta(a,b);"+>     ,Item db1   "/*66642*/with ta as (select 1 as a, 2 as b),\n\+>                 \     tb as (select * from t)\n\+>                 \select * from ta\n\+>                 \union select * from tb;"+>+>                 "with ta(a,b) as (select 1 as a, 2 as b),\n\+>                 \     tb(a,b) as (select t.a as a, t.b as b from t as t(a,b))\n\+>                 \select ta.a as a, ta.b as b from ta as ta(a,b)\n\+>                 \union select tb.a as a, tb.b as tb from tb as tb(a,b);"++>     ]-}+>   ,Group "correlated subqueries"+>     [Item db1+>           "select a,b,c,d from t,u where a = c and d =\n\+>           \           (select min(d) from u where a = c);"+>           "select t.a as a,t.b as b,\n\+>           \       u.c as c, u.d as d\n\+>           \   from t as t(a,b),u as u(c,d)\n\+>           \   where t.a = u.c and u.d =\n\+>           \           (select min(u.d) as min from u as u(c,d) where t.a = u.c);"++>     ]+>   ,Group "funtrefs"+>     [Item [] "select * from generate_series(1,7) g\n\+>              \where g not in (select * from generate_series(3,5));"+>              "select g.g as g from generate_series(1,7) g(g)\n\+>              \where g.g not in (select generate_series.generate_series as generate_series\n\+>              \                  from generate_series(3,5) as generate_series(generate_series));"+>     ,Item [] "select g from generate_series(1,7) g\n\+>              \where g not in (select * from generate_series(3,5));"+>              "select g.g as g from generate_series(1,7) g(g)\n\+>              \where g.g not in (select generate_series.generate_series as generate_series\n\+>              \                  from generate_series(3,5) as generate_series(generate_series));"+>     ,Item [] "select g.* from generate_series(1,7) g\n\+>              \where g not in (select * from generate_series(3,5));"+>              "select g.g as g from generate_series(1,7) g(g)\n\+>              \where g.g not in (select generate_series.generate_series as generate_series\n\+>              \                  from generate_series(3,5) as generate_series(generate_series));"++>     ]+>   ,Group "select lists"+>     [Item db1 "select a,b,f(a),a::int,a+b,row_number() over (order by a), a as c from t;"+>               "select t.a as a,t.b as b,f(t.a) as f,t.a::int as \"int\",t.a+t.b as \"?column?\",row_number() over (order by t.a) as row_number, t.a as c from t as t(a,b);"+>     ]+>   ,Group "joins"+>     [Item db1 "select * from t natural inner join t1;"+>               "select t.a as a,t.b as b,t1.c as c \+>               \from t as t(a,b) natural inner join t1 as t1(a,c);"+>     ,Item db1 "select * from t inner join t1 using (a);"+>               "select t.a as a,t.b as b,t1.c as c \+>               \from t as t(a,b) inner join t1 as t1(a,c) using (a);"+>     ,Item db1 "select * from t cross join t1;"+>               "select t.a as a,t.b as b,t1.a as a,t1.c as c \+>               \from t as t(a,b) cross join t1 as t1(a,c);"+>     ,Item db1 "select t.* from t natural inner join t1;"+>               "select t.a as a,t.b as b \+>               \from t as t(a,b) natural inner join t1 as t1(a,c);"+>     ,Item db1 "select t1.* from t natural inner join t1;"+>               "select t1.a as a,t1.c as c \+>               \from t as t(a,b) natural inner join t1 as t1(a,c);"+>     ]+>   ,Group "dml"+>     [SItem db1 "update t set a = b where a = 5;"+>               "update t set a = t.b where t.a = 5;"+>     ,SItem db1 "delete from t where a = 0;"+>               "delete from t where t.a = 0;"]+>   ,Group "returning"+>     [SItem db1 "update t set a = 1 returning a;"+>                "update t set a = 1 returning t.a as a;"+>     ,SItem db1 "insert into t (a,b) values (1,2) returning a,b;"+>                "insert into t (a,b) values (1,2) returning t.a as a,t.b as b;"+>     ,SItem db1 "delete from t returning a;"+>                "delete from t returning t.a as a;"]+>   ]++qualifier and column name the same+++> db1 :: [CatalogUpdate]+> db1 = [CatCreateTable "t" [("a",typeInt)+>                           ,("b", typeInt)] []+>       ,CatCreateTable "u" [("c",typeInt)+>                           ,("d", typeInt)] []+>       ,CatCreateTable "v" [("v",typeInt)] []+>       ,CatCreateTable "t1" [("a",typeInt)+>                            ,("c", typeInt)] []+>       ]+++------------------------++> itemToTft :: Item -> Test.Framework.Test+> itemToTft (Group s is) = testGroup s $ map itemToTft is+> itemToTft (Item eu sql esql) =+>   itemToTft' parseStatement eu sql esql+> --itemToTft (MSItem eu sql esql) = itemToTft' parseSqlServerQueryExpr eu sql esql+> itemToTft (SItem eu sql esql) = itemToTft' parseStatement eu sql esql++> parseStatement :: String -> String -> Either ParseErrorExtra Statement+> parseStatement f s =+>   let p = parseStatements f s+>   in case p of+>        Left e -> Left e+>        Right [a] -> Right a+>        Right _ -> error "wrong number of statements parsed"++> type P = String -> String -> Either ParseErrorExtra Statement++> itemToTft' :: P -> [CatalogUpdate] -> String -> String -> Test.Framework.Test+> itemToTft' p eu sql esql = testCase sql $ do+>   let eAst = [case p "" esql of+>                              Left e -> error $ show e+>                              Right l -> resetAnnotations l]+>       ast = [case p "" sql of+>                            Left e -> error $ show e+>                            Right l -> resetAnnotations l]+>       cAst = fixUpIdentifiers makeCat ast+>       c2Ast = fixUpIdentifiers makeCat cAst+>   --putStrLn $ printStatements cAst ++ "\n" ++ printStatements c2Ast+>   when (eAst /= cAst) $ do+>     putStrLn $ "\nExpected:\n\n" ++ printStatements eAst+>     putStrLn $ "\nGot:\n\n" ++ printStatements cAst ++ "\n\n"+>   when (cAst /= c2Ast) $ do+>     putStrLn $ "\nREDO, Expected:\n\n" ++ printStatements cAst+>     putStrLn $ "\nGot:\n\n" ++ printStatements c2Ast ++ "\n\n"+>   assertEqual "" eAst cAst+>   assertEqual "redo" cAst c2Ast+>   where+>     makeCat = case updateCatalog defaultTemplate1Catalog eu of+>                         Left x -> error $ show x+>                         Right e -> e
+ src-extra/tests/Database/HsSqlPpp/Tests/ParameterizedStatementTests.lhs view
@@ -0,0 +1,153 @@++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]
+ src-extra/tests/Database/HsSqlPpp/Tests/Parsing/CreateTable.lhs view
@@ -0,0 +1,223 @@++> {-# LANGUAGE OverloadedStrings #-}+> module Database.HsSqlPpp.Tests.Parsing.CreateTable (createTableParsingTestData) where+>+> import Database.HsSqlPpp.Ast++> import Database.HsSqlPpp.Tests.Parsing.Utils++> createTableParsingTestData:: Item+> createTableParsingTestData =+>   Group "create table" [+>      Group "simple tables" [+>       s "create table test (\n\+>         \  fielda text,\n\+>         \  fieldb int\n\+>         \);"+>       [CreateTable ea+>        (dqi "test")+>        [att "fielda" "text"+>        ,att "fieldb" "int"+>        ]+>        []]+>      ,s "create table tbl (\n\+>         \  fld boolean default false);"+>       [CreateTable ea (dqi "tbl")+>        [AttributeDef ea (Nmc "fld") (SimpleTypeName ea "boolean")+>                          (Just $ BooleanLit ea False) []][]]+>+>      ,s "create table tbl as select 1;"+>       [CreateTableAs ea (dqi "tbl")+>        (selectE (SelectList ea [SelExp ea (NumberLit ea "1")]))]+>+>      ,s "alter table a alter column b set default 1;"+>       [AlterTable ea (dqi "a") [AlterColumnDefault ea (Nmc "b") (NumberLit ea "1")]]+>+>      ,s "alter table a add constraint unique(b);"+>       [AlterTable ea (dqi "a") [AddConstraint ea (UniqueConstraint ea "" [Nmc "b"])]]+>      ]+>     ,Group "constraints" [+>       Group "nulls" [+>       s "create table t1 (\n\+>         \ a text null\n\+>         \);"+>         [CreateTable ea (dqi "t1") [AttributeDef ea (Nmc "a") (SimpleTypeName ea "text")+>                            Nothing [NullConstraint ea ""]]+>          []]+>      ,s "create table t1 (\n\+>         \ a text not null\n\+>         \);"+>         [CreateTable ea (dqi "t1") [AttributeDef ea (Nmc "a") (SimpleTypeName ea "text")+>                                                  Nothing [NotNullConstraint ea ""]]+>          []]+>      ]+>+>      ,Group "unique" [+>       s "create table t1 (\n\+>         \ x int,\n\+>         \ y int,\n\+>         \ unique (x,y)\n\+>         \);"+>         [CreateTable ea (dqi "t1") [att "x" "int"+>                                    ,att "y" "int"]+>          [UniqueConstraint ea "" [Nmc "x",Nmc "y"]]]++test arbitrary ordering++>      ,s "create table t1 (\n\+>         \ x int,\n\+>         \ unique (x),\n\+>         \ y int\n\+>         \);"+>         [CreateTable ea (dqi "t1") [att "x" "int"+>                           ,att "y" "int"]+>          [UniqueConstraint ea "" [Nmc "x"]]]++unique row++>      ,s "create table t1 (\n\+>         \ x int unique\n\+>         \);"+>         [CreateTable ea (dqi "t1")+>          [AttributeDef ea (Nmc "x") (SimpleTypeName ea "int") Nothing+>           [RowUniqueConstraint ea ""]][]]+>+>      ,s "create table t1 (\n\+>         \ x int unique not null\n\+>         \);"+>         [CreateTable ea (dqi "t1") [AttributeDef ea (Nmc "x") (SimpleTypeName ea "int") Nothing+>                            [RowUniqueConstraint ea ""+>                            ,NotNullConstraint ea ""]][]]++quick sanity check++>      ,s "create table t1 (\n\+>         \ x int not null unique\n\+>         \);"+>         [CreateTable ea (dqi "t1") [AttributeDef ea (Nmc "x") (SimpleTypeName ea "int") Nothing+>                            [NotNullConstraint ea ""+>                            ,RowUniqueConstraint ea ""]][]]+>      ]+>+>      ,Group "primary key" [+>       s "create table t1 (\n\+>         \ x int primary key\n\+>         \);"+>         [CreateTable ea (dqi "t1") [AttributeDef ea (Nmc "x") (SimpleTypeName ea "int") Nothing+>                            [RowPrimaryKeyConstraint ea ""]][]]+>+>      ,s "create table t1 (\n\+>         \ x int,\n\+>         \ y int,\n\+>         \ primary key (x,y)\n\+>         \);"+>         [CreateTable ea (dqi "t1") [att "x" "int"+>                           ,att "y" "int"]+>          [PrimaryKeyConstraint ea "" [Nmc "x", Nmc "y"]]]+>      ]+>+>      ,Group "check" [+>       s "create table t (\n\+>         \f text check (f in('a', 'b'))\n\+>         \);"+>         [CreateTable ea (dqi "t")+>          [AttributeDef ea (Nmc "f") (SimpleTypeName ea "text") Nothing+>           [RowCheckConstraint ea "" (InPredicate ea+>                                   (Identifier ea "f") True+>                                   (InList ea [stringQ "a", stringQ "b"]))]] []]+>+>      ,s "create table t1 (\n\+>         \ x int,\n\+>         \ y int,\n\+>         \ check (x>y)\n\+>         \);"+>         [CreateTable ea (dqi "t1") [att "x" "int"+>                           ,att "y" "int"]+>          [CheckConstraint ea "" (FunCall ea (name ">") [Identifier ea "x", Identifier ea "y"])]]+>      ]+>+>      ,Group "misc" [+>       s "create table t (\n\+>         \f text not null unique check (f in('a', 'b'))\n\+>         \);"+>         [CreateTable ea (dqi "t")+>          [AttributeDef ea (Nmc "f") (SimpleTypeName ea "text") Nothing+>           [NotNullConstraint ea ""+>            ,RowUniqueConstraint ea ""+>            ,RowCheckConstraint ea "" (InPredicate ea+>                                    (Identifier ea "f") True+>                                    (InList ea [stringQ "a"+>                                               ,stringQ "b"]))]] []]+>      ]++>      ,Group "references" [+>       s "create table t1 (\n\+>         \ x int references t2\n\+>         \);"+>         [CreateTable ea (dqi "t1") [AttributeDef ea (Nmc "x") (SimpleTypeName ea "int") Nothing+>                            [RowReferenceConstraint ea "" (dqi "t2") Nothing+>                             Restrict Restrict]][]]+>+>      ,s "create table t1 (\n\+>         \ x int references t2(y)\n\+>         \);"+>         [CreateTable ea (dqi "t1") [AttributeDef ea (Nmc "x") (SimpleTypeName ea "int") Nothing+>                            [RowReferenceConstraint ea "" (dqi "t2") (Just $ Nmc "y")+>                             Restrict Restrict]][]]+>      ,s "create table t1 (\n\+>         \ x int,\n\+>         \ y int,\n\+>         \ foreign key (x,y) references t2\n\+>         \);"+>         [CreateTable ea (dqi "t1") [att "x" "int"+>                                    ,att "y" "int"]+>          [ReferenceConstraint ea "" [Nmc "x", Nmc "y"] (dqi "t2") []+>           Restrict Restrict]]+>+>      ,s "create table t1 (\n\+>         \ x int,\n\+>         \ y int,\n\+>         \ foreign key (x,y) references t2(z,w)\n\+>         \);"+>         [CreateTable ea (dqi "t1") [att "x" "int"+>                           ,att "y" "int"]+>          [ReferenceConstraint ea "" [Nmc "x", Nmc "y"] (dqi "t2") [Nmc "z", Nmc "w"]+>           Restrict Restrict]]+>+>      ,s "create table t1 (\n\+>         \ x int references t2 on delete cascade\n\+>         \);"+>         [CreateTable ea (dqi "t1") [AttributeDef ea (Nmc "x") (SimpleTypeName ea "int") Nothing+>                            [RowReferenceConstraint ea "" (dqi "t2") Nothing+>                             Cascade Restrict]][]]+>+>      ,s "create table t1 (\n\+>         \ x int references t2 on update cascade\n\+>         \);"+>         [CreateTable ea (dqi "t1") [AttributeDef ea (Nmc "x") (SimpleTypeName ea "int") Nothing+>                            [RowReferenceConstraint ea "" (dqi "t2") Nothing+>                             Restrict Cascade]][]]+>+>      ,s "create table t1 (\n\+>         \ x int references t2 on delete cascade on update cascade\n\+>         \);"+>         [CreateTable ea (dqi "t1") [AttributeDef ea (Nmc "x") (SimpleTypeName ea "int") Nothing+>                            [RowReferenceConstraint ea "" (dqi "t2") Nothing+>                             Cascade Cascade]][]]+>+>      ,s "create table t1 (\n\+>         \ x int,\n\+>         \ y int,\n\+>         \ foreign key (x,y) references t2 on update cascade on delete cascade\n\+>         \);"+>         [CreateTable ea (dqi "t1") [att "x" "int"+>                                    ,att "y" "int"]+>          [ReferenceConstraint ea "" [Nmc "x", Nmc "y"] (dqi "t2") []+>           Cascade Cascade]]+>+>      ]+>      ]+>      ]++>  where+>    s = Stmt
+ src-extra/tests/Database/HsSqlPpp/Tests/Parsing/Dml.lhs view
@@ -0,0 +1,126 @@++> {-# LANGUAGE OverloadedStrings #-}+> module Database.HsSqlPpp.Tests.Parsing.Dml (dmlParsingTestData) where+>+> import Database.HsSqlPpp.Ast++> import Database.HsSqlPpp.Tests.Parsing.Utils++TODO:++from in update, using in delete (+ type check these)++> dmlParsingTestData:: Item+> dmlParsingTestData =+>    Group "dml" [+>      Group "insert" [+>       s "insert into testtable\n\+>         \(columna,columnb)\n\+>         \values (1,2);\n"+>        [Insert ea+>         (dqi "testtable")+>         [Nmc "columna", Nmc "columnb"]+>         (Values ea [[NumberLit ea "1", NumberLit ea "2"]])+>         Nothing]++multi row insert, test the stand alone values statement first, maybe+that should be in the select section?++>      ,s "values (1,2), (3,4);"+>      [QueryStatement ea $ Values ea [[NumberLit ea "1", NumberLit ea "2"]+>              ,[NumberLit ea "3", NumberLit ea "4"]]]+>+>      ,s "insert into testtable\n\+>         \(columna,columnb)\n\+>         \values (1,2), (3,4);\n"+>       [Insert ea+>         (dqi "testtable")+>         [Nmc "columna", Nmc "columnb"]+>         (Values ea [[NumberLit ea "1", NumberLit ea "2"]+>                 ,[NumberLit ea "3", NumberLit ea "4"]])+>         Nothing]++insert from select++>      ,s "insert into a\n\+>          \    select b from c;"+>       [Insert ea (dqi "a") []+>        (selectFrom [selI "b"] (Tref ea (i "c") (NoAlias ea)))+>        Nothing]+>+>      ,s "insert into testtable\n\+>         \(columna,columnb)\n\+>         \values (1,2) returning id;\n"+>       [Insert ea+>         (dqi "testtable")+>         [Nmc "columna", Nmc "columnb"]+>         (Values ea [[NumberLit ea "1", NumberLit ea "2"]])+>         (Just $ sl [selI "id"])]+>      ]+>+>     ,Group "update" [+>       s "update tb\n\+>         \  set x = 1, y = 2;"+>       [Update ea (dqi "tb") [SetClause ea (Nmc "x") $ NumberLit ea "1"+>                             ,SetClause ea (Nmc "y") $ NumberLit ea "2"]+>        [] Nothing Nothing]+>      ,s "update tb\n\+>         \  set x = 1, y = 2 where z = true;"+>       [Update ea (dqi "tb") [SetClause ea (Nmc "x") $ NumberLit ea "1"+>                             ,SetClause ea (Nmc "y") $ NumberLit ea "2"]+>        []+>        (Just $ FunCall ea (name "=")+>         [Identifier ea "z", BooleanLit ea True])+>        Nothing]+>      ,s "update tb\n\+>         \  set x = 1, y = 2 returning id;"+>       [Update ea (dqi "tb") [SetClause ea (Nmc "x") $ NumberLit ea "1"+>                             ,SetClause ea (Nmc "y") $ NumberLit ea "2"]+>        [] Nothing (Just $ sl [selI "id"])]+>      ,s "update tb\n\+>         \  set (x,y) = (1,2);"+>       [Update ea (dqi "tb")+>        [MultiSetClause ea [Nmc "x",Nmc "y"]+>         $ FunCall ea (name "!rowctor") [NumberLit ea "1"+>                                        ,NumberLit ea "2"]]+>        []+>        Nothing Nothing]+>      ]++FunCall ea "=" [FunCall ea "!rowctor" [Identifier ea "x",Identifier ea "y"],FunCall ea "!rowctor" [NumberLit ea "1",NumberLit ea "2"]])+++>+>     ,Group "delete" [+>       s "delete from tbl1 where x = true;"+>       [Delete ea (dqi "tbl1") [] (Just $ FunCall ea (name "=")+>                                [Identifier ea "x", BooleanLit ea True])+>        Nothing]+>      ,s "delete from tbl1 where x = true returning id;"+>       [Delete ea (dqi "tbl1") [] (Just $ FunCall ea (name "=")+>                                [Identifier ea "x", BooleanLit ea True])+>        (Just $ sl [selI "id"])]+>      ]+>+>     ,Group "truncate" [+>       s "truncate test;"+>        [Truncate ea [dqi "test"] ContinueIdentity Restrict]+>+>      ,s "truncate table test, test2 restart identity cascade;"+>        [Truncate ea [dqi "test",dqi "test2"] RestartIdentity Cascade]+>      ]++copy, bit crap at the moment++>     ,Group "copy" [+>       s "copy tbl(a,b) from stdin;\n\+>         \bat\tt\n\+>         \bear\tf\n\+>         \\\.\n"+>       [Copy ea (dqi "tbl") [Nmc "a", Nmc "b"] Stdin+>        ,CopyData ea "\+>         \bat\tt\n\+>         \bear\tf\n"]+>      ]]+>  where+>    s = Stmt
+ src-extra/tests/Database/HsSqlPpp/Tests/Parsing/Expressions.lhs view
@@ -0,0 +1,224 @@++> {-# LANGUAGE QuasiQuotes,OverloadedStrings #-}+>+> module Database.HsSqlPpp.Tests.Parsing.Expressions (expressionParsingTestData) where+>+> import Database.HsSqlPpp.Utils.Here+>+> import Database.HsSqlPpp.Ast++> import Database.HsSqlPpp.Tests.Parsing.Utils++> expressionParsingTestData:: Item+> expressionParsingTestData =+>    Group "parse expressions" [+>     Group "numbers" [+>       e "42" (num "42")+>      ,e "3.5" (num "3.5")+>      ,e "4." (num "4.")+>      ,e ".001" (num ".001")+>      ,e "5e2" (num "5e2")+>      ,e "1.925e-3" (num "1.925e-3")++>      ]+>    ,Group "basic expressions" [+>       e "1" (num "1")+>      ,e "-1" (funCall "u-" [num "1"])+>      ,e "1.1" (num "1.1")+>      ,e "-1.1" (funCall "u-" [num "1.1"])+>      ,e " 1 + 1 " (funCall "+" [num "1"+>                                ,num "1"])+>      ,e "1+1+1" (funCall "+" [funCall "+" [num "1"+>                                           ,num "1"]+>                              ,num "1"])+>      ]+>    ,Group "parens" [++check some basic parens use wrt naked values and row constructors+these tests reflect how pg seems to interpret the variants.++>       e "(1)" (num "1")+>      ,e "row ()" (funCall "!rowctor" [])+>      ,e "row (1)" (funCall "!rowctor" [num "1"])+>      ,e "row (1,2)" (funCall "!rowctor" [num "1",num "2"])+>      ,e "(1,2)" (funCall "!rowctor" [num "1",num "2"])+>      ]+>    ,Group "more basic expressions" [++test some more really basic expressions++>       e "'test'" (stringQ "test")+>      ,e "''" (stringQ "")+>      ,e "hello" (ei "hello")+>      ,e "helloTest" (ei "helloTest")+>      ,e "hello_test" (ei "hello_test")+>      ,e "\"this is an identifier\""+>             (Identifier ea (QNmc "this is an identifier"))+>      ,e "hello1234" (ei "hello1234")+>      ,e "true" lTrue+>      ,e "false" lFalse+>      ,e "null" lNull+>      ]+>    ,Group "array ctor and selector" [+>       e "array[1,2]" (funCall "!arrayctor" [num "1", num "2"])+>      ,e "a[1]" (funCall "!arraysub" [ei "a", num "1"])+>      ]+>    ,Group "simple operators" [+>       e "1 + tst1" (funCall "+" [num "1"+>                                 ,ei "tst1"])+>      ,e "tst1 + 1" (funCall "+" [ei "tst1"+>                                 ,num "1"])+>      ,e "tst + tst1" (funCall "+" [ei "tst"+>                                   ,ei "tst1"])+>      ,e "'a' || 'b'" (funCall "||" [stringQ "a"+>                                    ,stringQ "b"])+>      ,e "'stuff'::text"+>       (Cast ea (stringQ "stuff") (SimpleTypeName ea "text"))+>      ,e "245::float(24)" (Cast ea (num "245") (PrecTypeName ea "float" 24))+>      ,e "245.1::numeric(5,3)"+>       (Cast ea (num "245.1") (Prec2TypeName ea "numeric" 5 3))+>      ,e "245::double precision"+>       (Cast ea (num "245") (SimpleTypeName ea "double precision"))+>      ,e "date '1998-12-01'"+>       (TypedStringLit ea (SimpleTypeName ea "date") "1998-12-01")+>      ,e "interval '63' day" (Interval ea "63" IntervalDay Nothing)+>      ,e "interval '63' day (3)" (Interval ea "63" IntervalDay $ Just 3)+>      ,e "extract(year from a)" (Extract ea ExtractYear $ ei "a")+>      ,e "a between 1 and 3"+>         (funCall "!between" [ei "a", num "1", num "3"])+>      ,e "a between 7 - 1 and 7 + 1"+>         (funCall "!between" [ei "a"+>                             ,funCall "-" [num "7"+>                                          ,num "1"]+>                             ,funCall "+" [num "7"+>                                          ,num "1"]])+>      ,e "cast(a as text)"+>         (Cast ea (ei "a") (SimpleTypeName ea "text"))+>      ,e "@ a"+>         (funCall "@" [ei "a"])+>      ,e "substring(a from 0 for 3)"+>         (funCall "!substring" [ei "a", num "0", num "3"])+>      ,e "substring(a from 0 for (5 - 3))"+>         (funCall "!substring" [ei "a"+>                               ,num "0"+>                               ,funCall "-" [num "5",num "3"]])+>      ,e "substring(a,b,c)"+>         (funCall "substring" [ei "a"+>                              ,ei "b"+>                              ,ei "c"])+>      ,e "a like b"+>         (funCall "!like" [ei "a", ei "b"])+>      ,e "a not like b"+>         (funCall "!notlike" [ei "a", ei "b"])+>      , e "a and b and c and d"+>         (funCall "!and"+>          [funCall "!and"+>           [funCall "!and" [ei "a"+>                           ,ei "b"]+>           ,ei "c"]+>          ,ei "d"])+>      ]+>    ,Group "function calls" [+>       e "fn()" (funCall "fn" [])+>      ,e "fn(1)" (funCall "fn" [num "1"])+>      ,e "fn('test')" (funCall "fn" [stringQ "test"])+>      ,e "fn(1,'test')" (funCall "fn" [num "1", stringQ "test"])+>      ,e "fn('test')" (funCall "fn" [stringQ "test"])+>      ]+>    ,Group "simple whitespace sanity checks" [+>       e "fn (1)" (funCall "fn" [num "1"])+>      ,e "fn( 1)" (funCall "fn" [num "1"])+>      ,e "fn(1 )" (funCall "fn" [num "1"])+>      ,e "fn(1) " (funCall "fn" [num "1"])+>      ]+>    ,Group "null stuff" [+>       e "not null" (funCall "!not" [lNull])+>      ,e "a is null" (funCall "!isnull" [ei "a"])+>      ,e "a is not null" (funCall "!isnotnull" [ei "a"])+>      ,e "not not true" (funCall "!not"+>                          [funCall "!not"+>                           [lTrue]])+>      ]++>    ,Group "case expressions" [+>       e [here|+>          case when a,b then 3+>               when c then 4+>               else 5+>          end+>          |]+>         (Case ea [([ei "a", ei "b"], num "3")+>                  ,([ei "c"], num "4")]+>          (Just $ num "5"))+>      ,e  "case 1 when 2 then 3 else 4 end"+>         (CaseSimple ea (num "1")+>          [([num "2"], num "3")]+>          (Just $ num "4"))+>      ]+>    ,Group "positional args" [+>       e "$1" (PositionalArg ea 1)+>      ,e "?" (Placeholder ea)+>      ,e "a = ?" (funCall "=" [ei "a",Placeholder ea])+>      ]+>    ,Group "exists" [+>       e "exists (select 1 from a)"+>       (Exists ea (selectFrom [SelExp ea (num "1")]+>                   (Tref ea (i "a") (NoAlias ea))))+>      ]+>    ,Group "in variants" [+>       e "t in (1,2)"+>       (InPredicate ea (ei "t") True (InList ea [num "1",num "2"]))+>      ,e "t not in (1,2)"+>       (InPredicate ea (ei "t") False (InList ea [num "1",num "2"]))+>      ,e "(t,u) in (1,2)"+>       (InPredicate ea (funCall "!rowctor" [ei "t",ei "u"]) True+>        (InList ea [num "1",num "2"]))+>      ,e "3 = any (array[1,2])"+>       (LiftOperator ea "=" LiftAny [num "3"+>                                    ,funCall "!arrayctor" [num "1"+>                                                          ,num "2"]])+>      ,e "3 = all (array[1,2,4])"+>       (LiftOperator ea "=" LiftAll [num "3"+>                                    ,funCall "!arrayctor" [num "1"+>                                                          ,num "2"+>                                                          ,num "4"]])+>      ]+>    ,Group "comparison operators" [+>       e "a < b"+>       (funCall "<" [ei "a", ei "b"])+>      ,e "a <> b"+>       (funCall "<>" [ei "a", ei "b"])+>      ,e "a != b"+>       (funCall "<>" [ei "a", ei "b"])+>      ]++test some string parsing, want to check single quote behaviour,+and dollar quoting, including nesting.++>    ,Group "string parsing" [+>       e "''" (stringQ "")+>      ,e "''''" (stringQ "'")+>      ,e "'test'''" (stringQ "test'")+>      ,e "'''test'" (stringQ "'test")+>      ,e "'te''st'" (stringQ "te'st")+>      ,e "$$test$$" (StringLit ea "test")+>      ,e "$$te'st$$" (StringLit ea "te'st")+>      ,e "$st$test$st$" (StringLit ea "test")+>      ,e "$outer$te$$yup$$st$outer$" (StringLit ea "te$$yup$$st")+>      ,e "'spl$$it'" (stringQ "spl$$it")+>      ]+>    ,Group "bracketed things" [+>       e "(p).x" (eqi "p" "x")+>      ,e "(select f(((a).x, y)::z))"+>         (ScalarSubQuery ea+>          (selectE (sl+>                    [SelExp ea+>                     (funCall "f" [Cast ea+>                                   (funCall "!rowctor"+>                                    [eqi "a" "x"+>                                    ,ei "y"])+>                                   (SimpleTypeName ea "z")])])))+>      ]+>      ]+>  where+>    e = Expr
+ src-extra/tests/Database/HsSqlPpp/Tests/Parsing/FunctionsDdl.lhs view
@@ -0,0 +1,146 @@+++> {-# LANGUAGE OverloadedStrings #-}+> module Database.HsSqlPpp.Tests.Parsing.FunctionsDdl (functionsDdlParsingTestData) where+>+> import Database.HsSqlPpp.Ast++> import Database.HsSqlPpp.Tests.Parsing.Utils++> functionsDdlParsingTestData:: Item+> functionsDdlParsingTestData =+>    Group "functionsddl" [+>      Group "basics" [+>       s "create function t1(text) returns text as $$\n\+>         \select a from t1 where b = $1;\n\+>         \$$ language sql stable;"+>       [CreateFunction ea (dqi "t1") [ParamDefTp ea $ SimpleTypeName ea "text"]+>        (SimpleTypeName ea "text") NoReplace Sql+>        (SqlFnBody ea+>         [QueryStatement ea $ selectFromWhere [SelExp ea (Identifier ea "a")] (Tref ea (i "t1") (NoAlias ea))+>          (FunCall ea (name "=")+>           [Identifier ea "b", PositionalArg ea 1])])+>        Stable]+>      ,s "create function fn() returns void as $$\n\+>         \declare\n\+>         \  a int;\n\+>         \  b text;\n\+>         \begin\n\+>         \  null;\n\+>         \end;\n\+>         \$$ language plpgsql volatile;"+>       [CreateFunction ea (dqi "fn") [] (SimpleTypeName ea "void") NoReplace Plpgsql+>        (PlpgsqlFnBody ea (Block ea Nothing [VarDef ea (Nmc "a") (SimpleTypeName ea "int") Nothing+>                                            ,VarDef ea (Nmc "b") (SimpleTypeName ea "text") Nothing]+>                           [NullStatement ea]))+>        Volatile]+>      ,s "create function fn() returns void as $$\n\+>         \declare\n\+>         \  a int;\n\+>         \  b text;\n\+>         \begin\n\+>         \  null;\n\+>         \end;\n\+>         \$$ language plpgsql volatile;"+>       [CreateFunction ea (dqi "fn") [] (SimpleTypeName ea "void") NoReplace Plpgsql+>        (PlpgsqlFnBody ea+>         (Block ea Nothing [VarDef ea (Nmc "a") (SimpleTypeName ea "int") Nothing+>                           ,VarDef ea (Nmc "b") (SimpleTypeName ea "text") Nothing]+>         [NullStatement ea]))+>        Volatile]+>      ,s "create function fn(a text[]) returns int[] as $$\n\+>         \declare\n\+>         \  b xtype[] := '{}';\n\+>         \begin\n\+>         \  null;\n\+>         \end;\n\+>         \$$ language plpgsql immutable;"+>       [CreateFunction ea (dqi "fn")+>        [ParamDef ea (Nmc "a") $ ArrayTypeName ea $ SimpleTypeName ea "text"]+>        (ArrayTypeName ea $ SimpleTypeName ea "int") NoReplace Plpgsql+>        (PlpgsqlFnBody ea+>         (Block ea Nothing+>          [VarDef ea (Nmc "b") (ArrayTypeName ea $ SimpleTypeName ea "xtype") (Just $ stringQ "{}")]+>          [NullStatement ea]))+>        Immutable]+>      ,s "create function fn() returns void as '\n\+>         \declare\n\+>         \  a int := 3;\n\+>         \begin\n\+>         \  null;\n\+>         \end;\n\+>         \' language plpgsql stable;"+>       [CreateFunction ea (dqi "fn") [] (SimpleTypeName ea "void") NoReplace Plpgsql+>        (PlpgsqlFnBody ea+>         (Block ea Nothing+>          [VarDef ea (Nmc "a") (SimpleTypeName ea "int") (Just $ NumberLit ea "3")]+>          [NullStatement ea]))+>        Stable]+>      ,s "create function fn(int) returns void as '\n\+>         \declare\n\+>         \  a alias for $1;\n\+>         \begin\n\+>         \  null;\n\+>         \end;\n\+>         \' language plpgsql stable;"+>       [CreateFunction ea (dqi "fn")+>        [ParamDefTp ea $ SimpleTypeName ea "int"]+>        (SimpleTypeName ea "void") NoReplace Plpgsql+>        (PlpgsqlFnBody ea+>         (Block ea Nothing+>          [ParamAlias ea (Nmc "a") 1]+>          [NullStatement ea]))+>        Stable]+>      ,s "create function fn(b int) returns void as '\n\+>         \declare\n\+>         \  a alias for b;\n\+>         \begin\n\+>         \  null;\n\+>         \end;\n\+>         \' language plpgsql stable;"+>       [CreateFunction ea (dqi "fn")+>        [ParamDef ea (Nmc "b") $ SimpleTypeName ea "int"]+>        (SimpleTypeName ea "void") NoReplace Plpgsql+>        (PlpgsqlFnBody ea+>         (Block ea Nothing+>          [VarAlias ea (Nmc "a") (dqi "b")]+>          [NullStatement ea]))+>        Stable]+>      ,s "create function fn() returns setof int as $$\n\+>         \begin\n\+>         \  null;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>       [CreateFunction ea (dqi "fn") []+>        (SetOfTypeName ea $ SimpleTypeName ea "int") NoReplace Plpgsql+>        (PlpgsqlFnBody ea (Block ea Nothing [] [NullStatement ea]))+>        Stable]+>      ,s "create function fn() returns void as $$\n\+>         \begin\n\+>         \  null;\n\+>         \end\n\+>         \$$ language plpgsql stable;"+>       [CreateFunction ea (dqi "fn") []+>        (SimpleTypeName ea "void") NoReplace Plpgsql+>        (PlpgsqlFnBody ea (Block ea Nothing [] [NullStatement ea]))+>        Stable]+>      ,s "create or replace function fn() returns void as $$\n\+>         \begin\n\+>         \  null;\n\+>         \end\n\+>         \$$ language plpgsql stable;"+>       [CreateFunction ea (dqi "fn") []+>        (SimpleTypeName ea "void") Replace Plpgsql+>        (PlpgsqlFnBody ea (Block ea Nothing [] [NullStatement ea]))+>        Stable]+>      ,s "drop function test(text);"+>       [DropFunction ea Require [(dqi "test",[SimpleTypeName ea "text"])] Restrict]+>      ,s "drop function test(int,int);"+>       [DropFunction ea Require [(dqi "test",[SimpleTypeName ea "int"+>                                             ,SimpleTypeName ea "int"])] Restrict]+>      ,s "drop function if exists a(),test(text) cascade;"+>       [DropFunction ea IfExists [(dqi "a",[])+>                                 ,(dqi "test",[SimpleTypeName ea "text"])] Cascade]+>     ]]+>  where+>    s = Stmt
+ src-extra/tests/Database/HsSqlPpp/Tests/Parsing/Misc.lhs view
@@ -0,0 +1,63 @@++The automated tests, uses hunit to check a bunch of text expressions+and sql statements parse to the correct tree, and then checks pretty+printing and then reparsing gives the same tree. The code was mostly+written almost in tdd style, which the order/ coverage of these tests+reflects.++There are no tests for invalid syntax at the moment.++> module Database.HsSqlPpp.Tests.Parsing.Misc (miscParserTestData) where+>+> import Database.HsSqlPpp.Ast++> import Database.HsSqlPpp.Tests.Parsing.Utils+>+> miscParserTestData :: Item+> miscParserTestData =+>   Group "miscParserTests" [++>     Group "multiple statements" [+>       s "select 1;\nselect 2;" [QueryStatement ea $ selectE $ sl [SelExp ea (NumberLit ea "1")]+>                                ,QueryStatement ea $ selectE $ sl [SelExp ea (NumberLit ea "2")]]+>      ]+>    ,Group "comments" [+>       s "" []+>      ,s "-- this is a test" []+>      ,s "/* this is\n\+>         \a test*/" []+>      ,s "select 1;\n\+>         \-- this is a test\n\+>         \select -- this is a test\n\+>         \2;" [QueryStatement ea $ selectE $ sl [SelExp ea (NumberLit ea "1")]+>              ,QueryStatement ea $ selectE $ sl [SelExp ea (NumberLit ea "2")]+>              ]+>      ,s "select 1;\n\+>         \/* this is\n\+>         \a test*/\n\+>         \select /* this is a test*/2;"+>                     [QueryStatement ea $ selectE $ sl [SelExp ea (NumberLit ea "1")]+>                     ,QueryStatement ea $ selectE $ sl [SelExp ea (NumberLit ea "2")]+>                     ]+>      ]++--------------------------------------------------------------------------------++ddl statements+++>    ,Group "misc" [+>       s "SET search_path TO my_schema, public;"+>         [Set ea "search_path" [SetId ea "my_schema"+>                               ,SetId ea "public"]]+>      ,s "SET t1 = 3;"+>         [Set ea "t1" [SetNum ea 3]]+>      ,s "SET t1 = 'stuff';"+>         [Set ea "t1" [SetStr ea "stuff"]]+>      ,s "create language plpgsql;"+>         [CreateLanguage ea "plpgsql"]+>+>     ]+>     ]+>  where+>    s = Stmt
+ src-extra/tests/Database/HsSqlPpp/Tests/Parsing/MiscDdl.lhs view
@@ -0,0 +1,63 @@++> {-# LANGUAGE OverloadedStrings #-}+> module Database.HsSqlPpp.Tests.Parsing.MiscDdl (miscDdlParsingTestData) where+>+> import Database.HsSqlPpp.Ast++> import Database.HsSqlPpp.Tests.Parsing.Utils++> miscDdlParsingTestData:: Item+> miscDdlParsingTestData =+>   Group "misc ddl" [+>     Group "misc create" [+>       s "create view v1 as\n\+>         \select a,b from t;"+>       [CreateView ea+>        (dqi "v1") Nothing+>        (selectFrom [selI "a", selI "b"] (Tref ea (i "t") (NoAlias ea)))]+>      ,s "create view v1(c,d) as\n\+>         \select a,b from t;"+>       [CreateView ea+>        (dqi "v1") (Just [Nmc "c",Nmc "d"])+>        (selectFrom [selI "a", selI "b"] (Tref ea (i "t") (NoAlias ea)))]+>      ,s "create domain td as text check (value in ('t1', 't2'));"+>       [CreateDomain ea (dqi "td") (SimpleTypeName ea "text") ""+>        (Just (InPredicate ea (Identifier ea "value") True+>               (InList ea [stringQ "t1" ,stringQ "t2"])))]+>      ,s "create type tp1 as (\n\+>         \  f1 text,\n\+>         \  f2 text\n\+>         \);"+>       [CreateType ea (dqi "tp1") [TypeAttDef ea (Nmc "f1") (SimpleTypeName ea "text")+>                                  ,TypeAttDef ea (Nmc "f2") (SimpleTypeName ea "text")]]+>+>      ,s "create sequence s start with 5 increment by 4 no maxvalue no minvalue cache 1;"+>         [CreateSequence ea (dqi "s") 4 1 ((2::Integer) ^ (63::Integer) - 1) 5 1]+>+>      ,s "alter sequence s owned by a.b;"+>         [AlterSequence ea (dqi "s") $ qi "a" "b"]+>+>      ,s "create trigger tr\n\+>          \after insert or delete on tb\n\+>          \for each statement\n\+>          \execute procedure fb();"+>         [CreateTrigger ea (Nmc "tr") TriggerAfter [TInsert,TDelete] (dqi "tb") EachStatement (dqi "fb") []]+>      ]+>+>     ,Group "drops" [+>       s "drop domain t;"+>       [DropSomething ea Domain Require [dqi "t"] Restrict]+>      ,s "drop domain if exists t,u cascade;"+>       [DropSomething ea Domain IfExists [dqi "t", dqi "u"] Cascade]+>      ,s "drop domain t restrict;"+>       [DropSomething ea Domain Require [dqi "t"] Restrict]+>+>      ,s "drop type t;"+>       [DropSomething ea Type Require [dqi "t"] Restrict]+>      ,s "drop table t;"+>       [DropSomething ea Table Require [dqi "t"] Restrict]+>      ,s "drop view t;"+>       [DropSomething ea View Require [dqi "t"] Restrict]+>      ]]+>  where+>    s = Stmt
+ src-extra/tests/Database/HsSqlPpp/Tests/Parsing/ParserTests.lhs view
@@ -0,0 +1,112 @@++The automated tests, uses hunit to check a bunch of text expressions+and sql statements parse to the correct tree, and then checks pretty+printing and then reparsing gives the same tree. The code was mostly+written almost in tdd style, which the order/ coverage of these tests+reflects.++There are no tests for invalid syntax at the moment.++> module Database.HsSqlPpp.Tests.Parsing.ParserTests+>     (parserTests+>     ,parserTestData+>     ,Item(..)+>     ) where+>+> import Test.HUnit+> import Test.Framework+> import Test.Framework.Providers.HUnit+> import Data.Generics+>+> import Database.HsSqlPpp.Ast+> --import Database.HsSqlPpp.Annotation+> import Database.HsSqlPpp.Parser+> import Database.HsSqlPpp.Pretty+>++> import Database.HsSqlPpp.Tests.Parsing.Utils+> import Database.HsSqlPpp.Tests.Parsing.Expressions+> import Database.HsSqlPpp.Tests.Parsing.Selects+> import Database.HsSqlPpp.Tests.Parsing.Dml+> import Database.HsSqlPpp.Tests.Parsing.CreateTable+> import Database.HsSqlPpp.Tests.Parsing.MiscDdl+> import Database.HsSqlPpp.Tests.Parsing.FunctionsDdl+> import Database.HsSqlPpp.Tests.Parsing.Plpgsql+> import Database.HsSqlPpp.Tests.Parsing.Misc++> import Database.HsSqlPpp.Tests.TestUtils++> parserTests :: Test.Framework.Test+> parserTests = itemToTft parserTestData+>+> parserTestData :: Item+> parserTestData =+>   Group "parserTests" [+>              expressionParsingTestData+>             ,selectParsingTestData+>             ,dmlParsingTestData+>             ,Group "ddl" [createTableParsingTestData+>                          ,miscDdlParsingTestData+>                          ,functionsDdlParsingTestData]+>             ,pgplsqlParsingTestData+>             ,miscParserTestData+>             ]++--------------------------------------------------------------------------------++Unit test helpers++> itemToTft :: Item -> Test.Framework.Test+> itemToTft (Expr a b) = testParseScalarExpr a b+> itemToTft (PgSqlStmt a b) = testParsePlpgsqlStatements a b+> itemToTft (Stmt a b) = testParseStatements a b+> --itemToTft (MSStmt a b) = testParseStatements a b+> itemToTft (Group s is) = testGroup s $ map itemToTft is+>+> testParseScalarExpr :: String -> ScalarExpr -> Test.Framework.Test+> testParseScalarExpr src ast =+>   parseUtil src ast (parseScalarExpr "") (parseScalarExpr "") printScalarExpr+>+> testParseStatements :: String -> [Statement] -> Test.Framework.Test+> testParseStatements src ast =+>   parseUtil src ast (parseStatements "") (parseStatements "") printStatements+>+> {-testParseMSStatements :: String -> [Statement] -> Test.Framework.Test+> testParseMSStatements src ast =+>   parseUtil src ast parseMsQuery (parseStatements "") printStatements+>   where+>     parseMsQuery :: String -> Either ParseErrorExtra [Statement]+>     parseMsQuery s =+>       (\p' -> [QueryStatement ea p'])+>       `fmap` parseSqlServerQueryExpr "" s-}++>+> testParsePlpgsqlStatements :: String -> [Statement] -> Test.Framework.Test+> testParsePlpgsqlStatements src ast =+>   parseUtil src ast (parsePlpgsql "") (parsePlpgsql "") printStatements+>+> parseUtil :: (Show t, Eq b, Show b, Data b) =>+>              String+>           -> b+>           -> (String -> Either t b)+>           -> (String -> Either t b)+>           -> (b -> String)+>           -> Test.Framework.Test+> parseUtil src ast parser reparser printer = testCase ("parse " ++ src) $+>   case parser src of+>     Left er -> assertFailure $ show er+>     Right ast' -> do+>       assertEqual ("parse " ++ src) ast $ resetAnnotations ast'+>       case reparser (printer ast) of+>         Left er -> assertFailure $ "reparse\n" ++ show er ++ "\n" -- ++ pp ++ "\n"+>         Right ast'' -> assertEqual ("reparse " ++ printer ast) ast $ resetAnnotations ast''++~~~~+TODO+new idea for testing:+parsesql -> ast1+parse, pretty print, parse -> ast2+load into pg, pg_dump, parse -> ast3+parse, pretty print, load into pg, pg_dump, parse -> ast4+check all these asts are the same+~~~~
+ src-extra/tests/Database/HsSqlPpp/Tests/Parsing/Plpgsql.lhs view
@@ -0,0 +1,152 @@+++> {-# LANGUAGE OverloadedStrings #-}+> module Database.HsSqlPpp.Tests.Parsing.Plpgsql (pgplsqlParsingTestData) where+>+> import Database.HsSqlPpp.Ast++> import Database.HsSqlPpp.Tests.Parsing.Utils++> pgplsqlParsingTestData:: Item+> pgplsqlParsingTestData =+>   Group "plpgsql" [+>     Group "simple plpgsql statements" [+>       f "success := true;"+>       [Assignment ea (Name ea ["success"]) (BooleanLit ea True)]+>      ,f "success = true;"+>       [Assignment ea (Name ea ["success"]) (BooleanLit ea True)]+>      ,f "return true;"+>       [Return ea $ Just (BooleanLit ea True)]+>      ,f "return;"+>       [Return ea Nothing]+>      ,f "return next 1;"+>       [ReturnNext ea $ NumberLit ea "1"]+>      ,f "return query select a from b;"+>       [ReturnQuery ea $ selectFrom [selI "a"] (Tref ea (i "b") (NoAlias ea))]+>      ,f "raise notice 'stuff %', 1;"+>       [Raise ea RNotice "stuff %" [NumberLit ea "1"]]+>      ,f "perform test();"+>       [Perform ea $ FunCall ea (name "test") []]+>      ,f "perform test(a,b);"+>       [Perform ea $ FunCall ea (name "test") [Identifier ea "a", Identifier ea "b"]]+>      ,f "perform test(r.relvar_name || '_and_stuff');"+>       [Perform ea $ FunCall ea (name "test") [+>                     FunCall ea (name "||") [eqi "r" "relvar_name"+>                                     ,stringQ "_and_stuff"]]]+>      ,f "select into a,b c,d from e;"+>       [Into ea False [name "a", name "b"]+>        $ QueryStatement ea $ Select ea Dupes (SelectList ea [selI "c", selI "d"])+>              [Tref ea (i "e") (NoAlias ea)] Nothing [] Nothing [] Nothing Nothing]+>      ,f "select c,d into a,b from e;"+>       [Into ea False [name "a", name "b"]+>        $ QueryStatement ea $ Select ea Dupes (SelectList ea [selI "c", selI "d"])+>          [Tref ea (i "e") (NoAlias ea)] Nothing [] Nothing [] Nothing Nothing]+>      ,f "delete from pieces where x = 1 and y = 1 returning tag into r.tag;"+>       [Into ea False [Name ea [Nmc "r",Nmc "tag"]]+>        $ Delete ea (dqi "pieces") []+>          (Just $ funCall "!and" [funCall "=" [ei "x",num "1"]+>                                 ,funCall "=" [ei "y",num "1"]])+>          (Just $ sl [selI "tag"])]+>      ,f "update pieces\n\+>         \set a=b returning tag into r.tag;"+>       [Into ea False [Name ea [Nmc "r",Nmc "tag"]]+>          $ Update ea (dqi "pieces")+>              [SetClause ea (Nmc "a") $ Identifier ea "b"]+>            []+>            Nothing (Just (SelectList ea+>                           [SelExp ea (Identifier ea "tag")]))]+>      ,f "insert into t(a) values (1) returning id into x;"+>       [Into ea False [Name ea [Nmc "x"]]+>        $ Insert ea+>         (dqi "t")+>         [Nmc "a"]+>         (Values ea [[NumberLit ea "1"]])+>         (Just $ sl [selI "id"])]++>      ,f "update t\n\+>         \  set x = 1 returning id into z;"+>       [Into ea False [Name ea [Nmc "z"]]+>       $ Update ea (dqi "t") [SetClause ea (Nmc "x") $ NumberLit ea "1"]+>         [] Nothing (Just $ sl [selI "id"])]++>      ,f "execute s;"+>       [Execute ea (Identifier ea "s")]+>      ,f "execute s into r;"+>       [Into ea False [Name ea [Nmc "r"]] (Execute ea (Identifier ea "s"))]+>     ,f "continue;" [ContinueStatement ea Nothing]+>     ]+>+>     ,Group "other plpgsql statements" [+>       f "for r in select a from tbl loop\n\+>         \null;\n\+>         \end loop;"+>       [ForQueryStatement ea Nothing (Nmc "r") (selectFrom  [selI "a"] (Tref ea (i "tbl") (NoAlias ea)))+>        [NullStatement ea]]+>      ,f "for r in select a from tbl where true loop\n\+>         \null;\n\+>         \end loop;"+>       [ForQueryStatement ea Nothing (Nmc "r")+>        (selectFromWhere [selI "a"] (Tref ea (i "tbl") (NoAlias ea)) (BooleanLit ea True))+>        [NullStatement ea]]+>      ,f "for r in 1 .. 10 loop\n\+>         \null;\n\+>         \end loop;"+>       [ForIntegerStatement ea Nothing (Nmc "r")+>        (NumberLit ea "1") (NumberLit ea "10")+>        [NullStatement ea]]+>       -- catch a bug in lexing where 1..10 is parsed as+>       -- num "1.", num ".10", instead of num 1, symbol "..", num 10+>      ,f "for r in 1..10 loop\n\+>         \null;\n\+>         \end loop;"+>       [ForIntegerStatement ea Nothing (Nmc "r")+>        (NumberLit ea "1") (NumberLit ea "10")+>        [NullStatement ea]]+>+>      ,f "if a=b then\n\+>         \  update c set d = e;\n\+>         \end if;"+>       [If ea [(FunCall ea (name "=") [ei "a", ei "b"]+>               ,[Update ea (dqi "c") [SetClause ea (Nmc "d")+>                                     $ ei "e"] [] Nothing Nothing])]+>        []]+>      ,f "if true then\n\+>         \  null;\n\+>         \else\n\+>         \  null;\n\+>         \end if;"+>       [If ea [(BooleanLit ea True,[NullStatement ea])]+>        [NullStatement ea]]+>      ,f "if true then\n\+>         \  null;\n\+>         \elseif false then\n\+>         \  return;\n\+>         \end if;"+>       [If ea [(BooleanLit ea True, [NullStatement ea])+>              ,(BooleanLit ea False, [Return ea Nothing])]+>        []]+>      ,f "if true then\n\+>         \  null;\n\+>         \elseif false then\n\+>         \  return;\n\+>         \elsif false then\n\+>         \  return;\n\+>         \else\n\+>         \  return;\n\+>         \end if;"+>       [If ea [(BooleanLit ea True, [NullStatement ea])+>              ,(BooleanLit ea False, [Return ea Nothing])+>              ,(BooleanLit ea False, [Return ea Nothing])]+>        [Return ea Nothing]]+>      ,f "case a\n\+>         \  when b then null;\n\+>         \  when c,d then null;\n\+>         \  else null;\n\+>         \end case;"+>      [CaseStatementSimple ea (Identifier ea "a")+>       [([Identifier ea "b"], [NullStatement ea])+>       ,([Identifier ea "c", Identifier ea "d"], [NullStatement ea])]+>       [NullStatement ea]]+>     ]]+>  where+>    f = PgSqlStmt
+ src-extra/tests/Database/HsSqlPpp/Tests/Parsing/Selects.lhs view
@@ -0,0 +1,434 @@++> {-# LANGUAGE QuasiQuotes,OverloadedStrings #-}+>+> module Database.HsSqlPpp.Tests.Parsing.Selects (selectParsingTestData) where+>+> import Database.HsSqlPpp.Utils.Here+>+> import Database.HsSqlPpp.Ast++> import Database.HsSqlPpp.Tests.Parsing.Utils++> selectParsingTestData:: Item+> selectParsingTestData =+>    Group "parse selects" [+>    Group "simple select statements" [+>     Group "select no table" [+>       s "select 1;" [QueryStatement ea $ selectE (SelectList ea [SelExp ea (NumberLit ea "1")])]+>      ]+>    ,Group "select from table" [+>       s "select * from tbl;"+>       [QueryStatement ea $ selectFrom (selEL [Star ea]) (Tref ea (i "tbl") (NoAlias ea))]+>      ,s "select a,b from tbl;"+>       [QueryStatement ea $ selectFrom (selIL ["a", "b"]) (Tref ea (i "tbl") (NoAlias ea))]+>      ,s "select a,b from inf.tbl;"+>       [QueryStatement ea $ selectFrom (selIL ["a", "b"]) (Tref ea (qi "inf" "tbl") (NoAlias ea))]+>      ,s "select distinct * from tbl;"+>       [QueryStatement ea $ Select ea Distinct (SelectList ea (selEL [Star ea])) [Tref ea (i "tbl") (NoAlias ea)]+>        Nothing [] Nothing [] Nothing Nothing]+>      ,s "select a from tbl where b=2;"+>       [QueryStatement ea $ selectFromWhere+>         (selIL ["a"])+>         (Tref ea (i "tbl") (NoAlias ea))+>         (FunCall ea (name "=")+>          [Identifier ea "b", NumberLit ea "2"])]+>      ,s "select a from tbl where b=2 and c=3;"+>       [QueryStatement ea $ selectFromWhere+>         (selIL ["a"])+>         (Tref ea (i "tbl") (NoAlias ea))+>         (FunCall ea (name "!and")+>          [FunCall ea (name "=")  [Identifier ea "b", NumberLit ea "2"]+>          ,FunCall ea (name "=") [Identifier ea "c", NumberLit ea "3"]])]+>      {-,MSStmt "select a from t;\ngo"+>          [QueryStatement ea $ selectFrom (selIL ["a"]) (Tref ea (i "t") (NoAlias ea))]+>      ,MSStmt "select a from t;\nset rowcount -1\ngo"+>          [QueryStatement ea $ selectFrom (selIL ["a"]) (Tref ea (i "t") (NoAlias ea))]+>      ,MSStmt "select a from t;\nset rowcount 10\ngo"+>       [QueryStatement ea $ Select ea Dupes+>        (sl (selIL ["a"]))+>        [Tref ea (i "t") (NoAlias ea)]+>        Nothing [] Nothing [] (Just (NumberLit ea "10")) Nothing]-}+>      ,s "SELECT T.A::INT FROM TABLE AS T;"+>         [QueryStatement ea+>          (Select ea Dupes+>           (SelectList ea+>            [SelExp ea (Cast ea (QIdentifier ea [Nmc "T",Nmc "A"])+>                        (SimpleTypeName ea "int"))])+>           [Tref ea (Name ea [Nmc "TABLE"]) (TableAlias ea (Nmc "T"))]+>           Nothing [] Nothing [] Nothing Nothing)]+>      ]+>++>    ,Group "more select statements" [+>       s "select a from tbl\n\+>         \except\n\+>         \select a from tbl1;"+>       [QueryStatement ea $ CombineQueryExpr ea Except+>        (selectFrom (selIL ["a"]) (Tref ea (i "tbl") (NoAlias ea)))+>        (selectFrom (selIL ["a"]) (Tref ea (i "tbl1") (NoAlias ea)))]+>      ,s "select a from tbl where true\n\+>         \except\n\+>         \select a from tbl1 where true;"+>       [QueryStatement ea $ CombineQueryExpr ea Except+>        (selectFromWhere (selIL ["a"]) (Tref ea (i "tbl") (NoAlias ea)) (BooleanLit ea True))+>        (selectFromWhere (selIL ["a"]) (Tref ea (i "tbl1") (NoAlias ea)) (BooleanLit ea True))]+>      ,s "select a from tbl\n\+>         \union\n\+>         \select a from tbl1;"+>       [QueryStatement ea $ CombineQueryExpr ea Union+>        (selectFrom (selIL ["a"]) (Tref ea (i "tbl") (NoAlias ea)))+>        (selectFrom (selIL ["a"]) (Tref ea (i "tbl1") (NoAlias ea)))]+>      ,s "select a from tbl\n\+>         \union all\n\+>         \select a from tbl1;"+>       [QueryStatement ea $ CombineQueryExpr ea UnionAll+>        (selectFrom (selIL ["a"]) (Tref ea (i "tbl") (NoAlias ea)))+>        (selectFrom (selIL ["a"]) (Tref ea (i "tbl1") (NoAlias ea)))]+>      ,s "(select 1 union select 2) union select 3;"+>       [QueryStatement ea+>        (CombineQueryExpr ea Union+>         (CombineQueryExpr ea Union+>          (selectE (SelectList ea [SelExp ea (NumberLit ea "1")]))+>          (selectE (SelectList ea [SelExp ea (NumberLit ea "2")])))+>         (selectE (SelectList ea [SelExp ea (NumberLit ea "3")])))]+>      ,s "select 1 union (select 2 union select 3);"+>       [QueryStatement ea+>        (CombineQueryExpr ea Union+>         (selectE (SelectList ea [SelExp ea (NumberLit ea "1")]))+>         (CombineQueryExpr ea Union+>          (selectE (SelectList ea [SelExp ea (NumberLit ea "2")]))+>          (selectE (SelectList ea [SelExp ea (NumberLit ea "3")]))))]+>      ,s [here|+>          with a as (select 1 as a1),+>               b as (select * from a)+>               select * from b; |]+>          [QueryStatement ea+>           (WithQueryExpr ea+>            [WithQuery ea (Nmc "a") Nothing (selectE $ SelectList ea+>                                             [SelectItem ea (NumberLit ea "1") (Nmc "a1")])+>            ,WithQuery ea (Nmc "b") Nothing (selectFrom (selEL [Star ea]) (Tref ea (i "a") (NoAlias ea)))]+>            (selectFrom (selEL [Star ea]) (Tref ea (i "b") (NoAlias ea))))]+>      ,s [here|+>          with a as (select 1 as a1),+>               b as (select * from a)+>               select * from a+>               union select * from b; |]+>          [QueryStatement ea+>           (WithQueryExpr ea+>            [WithQuery ea (Nmc "a") Nothing (selectE $ SelectList ea+>                                             [SelectItem ea (NumberLit ea "1") (Nmc "a1")])+>            ,WithQuery ea (Nmc "b") Nothing (selectFrom (selEL [Star ea]) (Tref ea (i "a") (NoAlias ea)))]+>            (CombineQueryExpr ea Union+>              (selectFrom (selEL [Star ea]) (Tref ea (i "a") (NoAlias ea)))+>              (selectFrom (selEL [Star ea]) (Tref ea (i "b") (NoAlias ea)))))]+>      ,s "select a as b from tbl;"+>       [QueryStatement ea $ selectFrom [SelectItem ea (Identifier ea "a") (Nmc "b")] (Tref ea (i "tbl") (NoAlias ea))]+>      ,s "select a + b as b from tbl;"+>       [QueryStatement ea $ selectFrom+>        [SelectItem ea+>         (FunCall ea (name "+")+>          [Identifier ea "a", Identifier ea "b"]) (Nmc "b")]+>        (Tref ea (i "tbl") (NoAlias ea))]+>      ,s "select a.* from tbl a;"+>       [QueryStatement ea $ selectFrom (selEL [QStar ea (Nmc "a")]) (Tref ea (i "tbl") (TableAlias ea (Nmc "a")))]+>      ,s "select a.* from tbl a(b,c);"+>       [QueryStatement ea $ selectFrom (selEL [QStar ea (Nmc "a")]) (Tref ea (i "tbl") (FullAlias ea (Nmc "a") [Nmc "b",Nmc "c"]))]++>      ,s "select * from t1 a, t2 b;"+>             [QueryStatement ea+>              (Select ea Dupes+>               (SelectList ea+>                [SelExp ea (Star ea)])+>               [Tref ea (i "t1") (TableAlias ea (Nmc "a")),Tref ea (i "t2") (TableAlias ea (Nmc "b"))]+>               Nothing [] Nothing [] Nothing Nothing)]+>      ,s "select a from b inner join c on b.a=c.a;"+>       [QueryStatement ea $ selectFrom+>        (selIL ["a"])+>        (JoinTref ea (Tref ea (i "b") (NoAlias ea)) Unnatural Inner (Tref ea (i "c") (NoAlias ea))+>           (Just (JoinOn ea+>            (FunCall ea (name "=") [eqi "b" "a", eqi "c" "a"]))) (NoAlias ea))]+>      ,s "select a from b inner join c as d on b.a=d.a;"+>       [QueryStatement ea $ selectFrom+>        (selIL ["a"])+>        (JoinTref ea (Tref ea (i "b") (NoAlias ea)) Unnatural Inner (Tref ea (i "c") (TableAlias ea (Nmc "d")))+>           (Just (JoinOn ea+>            (FunCall ea (name "=") [eqi "b" "a", eqi "d" "a"]))) (NoAlias ea))]+>      ,s "select a from b inner join c using(d,e);"+>       [QueryStatement ea $ selectFrom+>        (selIL ["a"])+>        (JoinTref ea (Tref ea (i "b") (NoAlias ea)) Unnatural Inner (Tref ea (i "c") (NoAlias ea))+>           (Just (JoinUsing ea [Nmc "d",Nmc "e"])) (NoAlias ea))]+>      ,s "select a from b natural inner join c;"+>       [QueryStatement ea $ selectFrom+>        (selIL ["a"])+>        (JoinTref ea (Tref ea (i "b") (NoAlias ea)) Natural Inner (Tref ea (i "c") (NoAlias ea)) Nothing (NoAlias ea))]+>      ,s "select a from b left outer join c;"+>       [QueryStatement ea $ selectFrom+>        (selIL ["a"])+>        (JoinTref ea (Tref ea (i "b") (NoAlias ea)) Unnatural LeftOuter (Tref ea (i "c") (NoAlias ea)) Nothing (NoAlias ea))]+>      ,s "select a from b full outer join c;"+>       [QueryStatement ea $ selectFrom+>        (selIL ["a"])+>        (JoinTref ea (Tref ea (i "b") (NoAlias ea)) Unnatural FullOuter (Tref ea (i "c") (NoAlias ea)) Nothing (NoAlias ea))]+>      ,s "select a from b right outer join c;"+>       [QueryStatement ea $ selectFrom+>        (selIL ["a"])+>        (JoinTref ea (Tref ea (i "b") (NoAlias ea)) Unnatural RightOuter (Tref ea (i "c") (NoAlias ea)) Nothing (NoAlias ea))]+>      ,s "select a from b cross join c;"+>       [QueryStatement ea $ selectFrom+>        (selIL ["a"])+>        (JoinTref ea (Tref ea (i "b") (NoAlias ea)) Unnatural Cross (Tref ea (i "c") (NoAlias ea)) Nothing (NoAlias ea))]+>      ,s "select a from (b natural join c);"+>       [QueryStatement ea $ selectFrom+>        (selIL ["a"])+>        (JoinTref ea (Tref ea (i "b") (NoAlias ea)) Natural Inner (Tref ea (i "c") (NoAlias ea)) Nothing (NoAlias ea))]+>      ,s "select x from a cross join b cross join c;"+>        [QueryStatement ea+>         (selectFrom (selIL ["x"])+>          (JoinTref ea+>          (JoinTref ea+>           (Tref ea (i "a") (NoAlias ea))+>            Unnatural Cross+>           (Tref ea (i "b") (NoAlias ea))+>           Nothing (NoAlias ea))+>          Unnatural Cross+>          (Tref ea (i "c") (NoAlias ea))+>          Nothing (NoAlias ea)))]+>      ,s "select x from ((a cross join b) cross join c);"+>        [QueryStatement ea+>         (selectFrom (selIL ["x"])+>          (JoinTref ea+>          (JoinTref ea+>           (Tref ea (i "a") (NoAlias ea))+>            Unnatural Cross+>           (Tref ea (i "b") (NoAlias ea))+>           Nothing (NoAlias ea))+>          Unnatural Cross+>          (Tref ea (i "c") (NoAlias ea))+>          Nothing (NoAlias ea)))]+>      ,s "select x from (a cross join (b cross join c));"+>        [QueryStatement ea+>         (selectFrom (selIL ["x"])+>          (JoinTref ea+>           (Tref ea (i "a") (NoAlias ea))+>           Unnatural Cross+>           (JoinTref ea+>            (Tref ea (i "b") (NoAlias ea))+>            Unnatural Cross+>            (Tref ea (i "c") (NoAlias ea))+>            Nothing (NoAlias ea))+>           Nothing (NoAlias ea)))]++>      ,s "select x from ((a cross join b) cross join c);"+>        [QueryStatement ea+>         (selectFrom (selIL ["x"])+>          (JoinTref ea+>          (JoinTref ea+>           (Tref ea (i "a") (NoAlias ea))+>            Unnatural Cross+>           (Tref ea (i "b") (NoAlias ea))+>           Nothing (NoAlias ea))+>          Unnatural Cross+>          (Tref ea (i "c") (NoAlias ea))+>          Nothing (NoAlias ea)))]+>      ,s "select x from (a cross join b) cross join c;"+>        [QueryStatement ea+>         (selectFrom (selIL ["x"])+>          (JoinTref ea+>          (JoinTref ea+>           (Tref ea (i "a") (NoAlias ea))+>            Unnatural Cross+>           (Tref ea (i "b") (NoAlias ea))+>           Nothing (NoAlias ea))+>          Unnatural Cross+>          (Tref ea (i "c") (NoAlias ea))+>          Nothing (NoAlias ea)))]+>      ,s "select x from ((a cross join b) cross join c) cross join d;"+>        [QueryStatement ea+>         (selectFrom (selIL ["x"])+>          (JoinTref ea+>           (JoinTref ea+>            (JoinTref ea+>             (Tref ea (i "a") (NoAlias ea))+>             Unnatural Cross+>             (Tref ea (i "b") (NoAlias ea))+>             Nothing (NoAlias ea))+>            Unnatural Cross+>            (Tref ea (i "c") (NoAlias ea))+>            Nothing (NoAlias ea))+>           Unnatural Cross+>           (Tref ea (i "d") (NoAlias ea))+>           Nothing (NoAlias ea)))]+>      ,s "select a from b\n\+>         \    inner join c\n\+>         \      on true\n\+>         \    inner join d\n\+>         \      on 1=1;"+>       [QueryStatement ea $ selectFrom+>        [SelExp ea (Identifier ea "a")]+>        (JoinTref ea+>         (JoinTref ea (Tref ea (i "b") (NoAlias ea)) Unnatural Inner (Tref ea (i "c") (NoAlias ea))+>          (Just $ JoinOn ea (BooleanLit ea True)) (NoAlias ea))+>         Unnatural Inner (Tref ea (i "d") (NoAlias ea))+>         (Just $ JoinOn ea (FunCall ea (name "=")+>                [NumberLit ea "1", NumberLit ea "1"])) (NoAlias ea))]++>      ,s "select row_number() over(order by a) as place from tbl;"+>       [QueryStatement ea $ selectFrom [SelectItem ea+>                    (WindowFn ea+>                     (FunCall ea (name "row_number") [])+>                     []+>                     [(Identifier ea "a", Asc)] FrameUnboundedPreceding)+>                    (Nmc "place")]+>        (Tref ea (i "tbl") (NoAlias ea))]+>      ,s "select row_number() over(order by a asc) as place from tbl;"+>       [QueryStatement ea $ selectFrom [SelectItem ea+>                    (WindowFn ea+>                     (FunCall ea (name "row_number") [])+>                     []+>                     [(Identifier ea "a",Asc)] FrameUnboundedPreceding)+>                    (Nmc "place")]+>        (Tref ea (i "tbl") (NoAlias ea))]+>      ,s "select row_number() over(order by a desc) as place from tbl;"+>       [QueryStatement ea $ selectFrom [SelectItem ea+>                    (WindowFn ea+>                     (FunCall ea (name "row_number") [])+>                     []+>                     [(Identifier ea "a", Desc)] FrameUnboundedPreceding)+>                    (Nmc "place")]+>        (Tref ea (i "tbl") (NoAlias ea))]+>      ,s "select row_number()\n\+>         \over(partition by (a,b) order by c) as place\n\+>         \from tbl;"+>       [QueryStatement ea $ selectFrom [SelectItem ea+>                    (WindowFn ea+>                     (FunCall ea (name "row_number") [])+>                     [FunCall ea (name "!rowctor") [Identifier ea "a",Identifier ea "b"]]+>                     [(Identifier ea "c", Asc)] FrameUnboundedPreceding)+>                    (Nmc "place")]+>        (Tref ea (i "tbl") (NoAlias ea))]+>      ,s "select * from a natural inner join (select * from b) as a;"+>       [QueryStatement ea $ selectFrom+>        (selEL [Star ea])+>        (JoinTref ea (Tref ea (i "a") (NoAlias ea)) Natural+>         Inner (SubTref ea (selectFrom+>                         (selEL [Star ea])+>                         (Tref ea (i "b") (NoAlias ea))) (TableAlias ea $ Nmc "a"))+>         Nothing (NoAlias ea))]+>      ,s "select * from a order by c;"+>       [QueryStatement ea $ Select ea  Dupes+>        (sl (selEL [Star ea]))+>        [Tref ea (i "a") (NoAlias ea)]+>        Nothing [] Nothing [(Identifier ea "c",Asc)] Nothing Nothing]+>      ,s "select *\n\+>            \from Adventure\n\+>            \order by Clicks desc, AdventureID;"+>       [QueryStatement ea $ Select ea Dupes+>        (sl (selEL [Star ea]))+>        [Tref ea (i "Adventure") (NoAlias ea)]+>        Nothing [] Nothing [(Identifier ea "Clicks",Desc)+>                           ,(Identifier ea "AdventureID",Asc)] Nothing Nothing]+>      ,s "select * from a order by c,d asc;"+>       [QueryStatement ea $ Select ea Dupes+>        (sl (selEL [Star ea]))+>        [Tref ea (i "a") (NoAlias ea)]+>        Nothing [] Nothing [(Identifier ea "c", Asc)+>                           ,(Identifier ea "d", Asc)] Nothing Nothing]+>      ,s "select * from a order by c,d desc;"+>       [QueryStatement ea $ Select ea Dupes+>        (sl (selEL [Star ea]))+>        [Tref ea (i "a") (NoAlias ea)]+>        Nothing [] Nothing [(Identifier ea "c", Asc)+>                           ,(Identifier ea "d", Desc)] Nothing Nothing]+>      ,s "select * from a order by c limit 1;"+>       [QueryStatement ea $ Select ea Dupes+>        (sl (selEL [Star ea]))+>        [Tref ea (i "a") (NoAlias ea)]+>        Nothing [] Nothing [(Identifier ea "c",Asc)] (Just (NumberLit ea "1")) Nothing]+>      ,s "select top 3 * from a order by c;"+>       [QueryStatement ea $ Select ea Dupes+>        (sl (selEL [Star ea]))+>        [Tref ea (i "a") (NoAlias ea)]+>        Nothing [] Nothing [(Identifier ea "c",Asc)] (Just (NumberLit ea "3")) Nothing]+>      ,s "select * from a order by c offset 3;"+>       [QueryStatement ea $ Select ea Dupes+>        (sl (selEL [Star ea]))+>        [Tref ea (i "a") (NoAlias ea)]+>        Nothing [] Nothing [(Identifier ea "c",Asc)] Nothing (Just $ NumberLit ea "3")]+>      ,s "select a from (select b from c) as d;"+>         [QueryStatement ea $ selectFrom+>          (selIL ["a"])+>          (SubTref ea (selectFrom+>                    (selIL ["b"])+>                    (Tref ea (i "c") (NoAlias ea)))+>           (TableAlias ea $ Nmc "d"))]+>      ,s "select * from gen();"+>         [QueryStatement ea $ selectFrom (selEL [Star ea]) (FunTref ea (FunCall ea (name "gen") []) (NoAlias ea))]+>      ,s "select * from gen() as t;"+>       [QueryStatement ea $ selectFrom+>        (selEL [Star ea])+>        (FunTref ea (FunCall ea (name "gen") [])(TableAlias ea $ Nmc "t"))]+>      ,s "select count(distinct b) from c;"+>         [QueryStatement ea $ Select ea Dupes+>          (sl [SelExp ea (AggregateFn ea Distinct+>                          (FunCall ea (name "count") [Identifier ea "b"])+>                          [])])+>          [Tref ea (i "c") (NoAlias ea)] Nothing []+>          Nothing [] Nothing Nothing]+>      ,s "select count(all b) from c;"+>         [QueryStatement ea $ Select ea Dupes+>          (sl [SelExp ea (AggregateFn ea Dupes+>                          (FunCall ea (name "count") [Identifier ea "b"])+>                          [])])+>          [Tref ea (i "c") (NoAlias ea)] Nothing []+>          Nothing [] Nothing Nothing]+>      ,s "select string_agg(distinct relname,',' order by relname1) from pg_class;"+>         [QueryStatement ea $ Select ea Dupes+>          (sl [SelExp ea (AggregateFn ea Distinct+>                          (FunCall ea (name "string_agg") [Identifier ea "relname"+>                                                   ,StringLit ea ","])+>                          [(Identifier ea "relname1", Asc)])])+>          [Tref ea (i "pg_class") (NoAlias ea)] Nothing []+>          Nothing [] Nothing Nothing]+>      ,s "select a, count(b) from c group by a;"+>         [QueryStatement ea $ Select ea Dupes+>          (sl [selI "a", SelExp ea (FunCall ea (name "count") [Identifier ea "b"])])+>          [Tref ea (i "c") (NoAlias ea)] Nothing [Identifier ea "a"]+>          Nothing [] Nothing Nothing]+>      ,s "select a, count(b) as cnt from c group by a having cnt > 4;"+>         [QueryStatement ea $ Select ea Dupes+>          (sl [selI "a", SelectItem ea (FunCall ea (name "count") [Identifier ea "b"]) $ Nmc "cnt"])+>          [Tref ea (i "c") (NoAlias ea)] Nothing [Identifier ea "a"]+>          (Just $ FunCall ea (name ">") [Identifier ea "cnt", NumberLit ea "4"])+>          [] Nothing Nothing]+>      ,s "select a from (select 1 as a, 2 as b) x;"+>         [QueryStatement ea $ selectFrom+>          [selI "a"]+>          (SubTref ea (selectE $ SelectList ea+>                                [SelectItem ea (NumberLit ea "1") $ Nmc "a"+>                                ,SelectItem ea (NumberLit ea "2") $ Nmc "b"])+>                   (TableAlias ea $ Nmc "x"))]+>      ]+>      ]+>    ,Group "some misc stuff" [+>       s "select (p).x, (p).y from pos;"+>         [QueryStatement ea $ selectFrom (selEL [eqi "p" "x"+>                                                ,eqi "p" "y"])+>                                          (Tref ea (i "pos") (NoAlias ea))]+>      ,s "select ($1).x, ($1).y from pos;"+>         [QueryStatement ea $ selectFrom+>          (selEL [member (PositionalArg ea 1) (Identifier ea "x")+>                 ,member (PositionalArg ea 1) (Identifier ea "y")])+>          (Tref ea (i "pos") (NoAlias ea))]+>      ,s "select row_number() over(), x from tb;"+>       [QueryStatement ea $ selectFrom+>        [SelExp ea+>                     (WindowFn ea+>                     (FunCall ea (name "row_number") [])+>                     []+>                     [] FrameUnboundedPreceding)+>        , selI "x"]+>        (Tref ea (i "tb") (NoAlias ea))]+>      ]]+>  where+>    s = Stmt
+ src-extra/tests/Database/HsSqlPpp/Tests/Parsing/Utils.lhs view
@@ -0,0 +1,90 @@++> module Database.HsSqlPpp.Tests.Parsing.Utils where++> import Database.HsSqlPpp.Ast+> import Database.HsSqlPpp.Annotation+> import GHC.Exts (IsString(..))++> data Item = Expr String ScalarExpr+>           | Stmt String [Statement]+>           | PgSqlStmt String [Statement]+>           | Group String [Item]++-------------------------------------------------------------------------------++shortcuts for constructing test data and asts++> stringQ :: String -> ScalarExpr+> stringQ = StringLit ea+>+> selectFrom :: SelectItemList+>            -> TableRef+>            -> QueryExpr+> selectFrom selList frm = Select ea Dupes (SelectList ea selList)+>                            [frm] Nothing [] Nothing [] Nothing Nothing+>+> selectE :: SelectList -> QueryExpr+> selectE selList = Select ea Dupes selList+>                     [] Nothing [] Nothing [] Nothing Nothing+>+> selIL :: [String] -> [SelectItem]+> selIL = map selI+> selEL :: [ScalarExpr] -> [SelectItem]+> selEL = map (SelExp ea)+>+> i :: String -> Name+> i x = Name ea [Nmc x]++> dqi :: String -> Name+> dqi x = Name ea [Nmc x]++> eqi :: String -> String -> ScalarExpr+> eqi c x = QIdentifier ea [Nmc c, Nmc x]++> ei :: String -> ScalarExpr+> ei = Identifier ea . Nmc+>+> qi :: String -> String -> Name+> qi c n = Name ea [Nmc c, Nmc n]+>+> selI :: String -> SelectItem+> selI = SelExp ea . Identifier ea . Nmc+>+> sl :: SelectItemList -> SelectList+> sl = SelectList ea+>+> selectFromWhere :: SelectItemList+>                 -> TableRef+>                 -> ScalarExpr+>                 -> QueryExpr+> selectFromWhere selList frm whr =+>     Select ea Dupes (SelectList ea selList)+>                [frm] (Just whr) [] Nothing [] Nothing Nothing+>+> att :: String -> String -> AttributeDef+> att n t = AttributeDef ea (Nmc n) (SimpleTypeName ea t) Nothing []++> ea :: Annotation+> ea = emptyAnnotation++> name :: String -> Name+> name n = Name ea [Nmc n]++> instance IsString NameComponent where+>     fromString = Nmc++> member :: ScalarExpr -> ScalarExpr -> ScalarExpr+> member a b = FunCall ea (name ".") [a,b]++++> num :: String -> ScalarExpr+> num n = NumberLit ea n++> funCall :: String -> [ScalarExpr] -> ScalarExpr+> funCall n as = FunCall ea (name n) as++> lTrue,lFalse,lNull :: ScalarExpr+> lTrue = BooleanLit ea True+> lFalse = BooleanLit ea False+> lNull = NullLit ea
+ src-extra/tests/Database/HsSqlPpp/Tests/QuasiQuoteTests.lhs view
@@ -0,0 +1,180 @@++Tests mainly for antiquotation, plus examples of where antiquotes work.++> {-# LANGUAGE QuasiQuotes,ScopedTypeVariables #-}+>+> module Database.HsSqlPpp.Tests.QuasiQuoteTests (quasiQuoteTests, quasiQuoteTestData, Item(..)) where+>+> import Test.HUnit+> import Test.Framework+> import Test.Framework.Providers.HUnit+> import Data.Data+>+> import Database.HsSqlPpp.Ast+> import Database.HsSqlPpp.Annotation+> import Database.HsSqlPpp.Pretty+> import Database.HsSqlPpp.Quote+> import Database.HsSqlPpp.Tests.TestUtils+>+> data Item = Expr ScalarExpr ScalarExpr+>           | Stmts [Statement] [Statement]+>           | PgSqlStmts [Statement] [Statement]+>           | Stmt Statement Statement+>           | PgSqlStmt Statement Statement+>           | Group String [Item]+> quasiQuoteTests :: Test.Framework.Test+> quasiQuoteTests = itemToTft quasiQuoteTestData+>+> quasiQuoteTestData :: Item+> quasiQuoteTestData =+>   Group "quasiQuoteTests" [++--------------------------------------------------------------------------------++expressions++>    Group "stuff" [+>      let tablename = "my_table"+>          varname = "my_field"+>          typename = "text"+>      in Stmt [sqlStmt|+>+>      create table $(tablename) (+>        $(varname) $(typename)+>      );+>+>      |]+>      [sqlStmt|+>      create table my_table (+>        my_field text+>      );+>      |]+>+>     ,let fnname = "my_function"+>          tablename = "my_table"+>          typename = "int"+>      in Stmt [sqlStmt|+>+>   create function $(fnname)() returns $(typename) as $a$+>     select * from $(tablename);+>   $a$ language sql stable;+>+>      |]+>      [sqlStmt|+>   create function my_function() returns int as $a$+>     select * from my_table;+>   $a$ language sql stable;+>      |]+>+>     ,let fnname = "my_function"+>      in Stmt [sqlStmt| drop function $(fnname)();|]+>              [sqlStmt| drop function my_function();|]+>+>     ,let expr = StringLit ea "testing"+>      in PgSqlStmt [pgsqlStmt| return $(expr); |]+>                   [pgsqlStmt| return 'testing'; |]+>+>     ,let expr = (FunCall ea (Name ea [Nmc "+"]) [NumberLit ea "3",NumberLit ea "4"])+>      in PgSqlStmt [pgsqlStmt| return $(expr); |]+>                   [pgsqlStmt| return 3 + 4; |]+>+>     ,let errMsg = "this splice is slighty dodgy"+>      in PgSqlStmt [pgsqlStmt|+>      if true then+>        raise exception '$(errMsg)';+>      end if;|]+>      [pgsqlStmt|+>      if true then+>        raise exception 'this splice is slighty dodgy';+>      end if;|]+>+>     ,let triggername = "my_trigger"+>          tablename = "my_table"+>          opname = "my_function"+>      in Stmt [sqlStmt|+>   create trigger $(triggername)+>     after insert or update or delete on $(tablename)+>     for each statement+>     execute procedure $(opname)();+>             |]+>              [sqlStmt|+>   create trigger my_trigger+>     after insert or update or delete on my_table+>     for each statement+>     execute procedure my_function();+>             |]+>     ,let tablename = "lotsastuff"+>      in Expr [sqlExpr|(select count(*) from $(tablename))|]+>              [sqlExpr|(select count(*) from lotsastuff)|]+>+>     ,let trigname = "tbl_trig1"+>          tablename = "tbl"+>          tevent = TUpdate+>          fn = "checkit"+>      in Stmt [sqlStmt|+>      create trigger $(trigname)+>         after $(tevent) on $(tablename)+>         for each row+>         execute procedure $(fn)();+>             |] [sqlStmt|+>      create trigger tbl_trig1+>         after update on tbl+>         for each row+>         execute procedure checkit();+>             |]+>     ,let x = "fnname"+>      in Expr [sqlExpr| $(x)('a') |]+>              [sqlExpr| fnname('a') |]+>     ,let x = "splicedstring"+>      in Expr [sqlExpr| $s(x) |]+>              (StringLit ea "splicedstring")+>     ,let x = "splicedIdentifier"+>      in Expr [sqlExpr| $i(x) |]+>              (Identifier ea $ Nmc "splicedIdentifier")+>     ,let errMsg = "this splice isn't too dodgy"+>      in PgSqlStmt [pgsqlStmt| raise exception $s(errMsg); |]+>                   [pgsqlStmt| raise exception 'this splice isn''t too dodgy'; |]++>     {-,let s1 = [sqlStmts| select * from tbl; |]+>      in Stmts [sqlStmts|+>      select 1;+>      $(s1);+>      select 2;|]+>        [sqlStmts|+>      select 1;+>      select * from tbl;+>      select 2;|]++>     ,let s1 = [sqlStmt| select * from tbl; |]+>          s2 = [s1,s2]+>      in Stmts [sqlStmts|+>      select 1;+>      $(s2);+>      select 2;|]+>        [sqlStmts|+>      select 1;+>      select * from tbl;+>      select * from tbl;+>      select 2;|]-}+++>   ]]+++================================================================================++Unit test helpers++> itemToTft :: Item -> Test.Framework.Test+> itemToTft (Expr a b) = testCase (printScalarExpr b) $ stripEqual a b+> itemToTft (PgSqlStmt a b) = testCase (printStatements [b]) $ stripEqual a b+> itemToTft (Stmt a b) = testCase (printStatements [b]) $  stripEqual a b+> itemToTft (PgSqlStmts a b) = testCase (printStatements b) $ stripEqual a b+> itemToTft (Stmts a b) = testCase (printStatements b) $ stripEqual a b+> itemToTft (Group s is) = testGroup s $ map itemToTft is+> stripEqual :: (Data a, Eq a, Show a) =>+>               a -> a -> Assertion+> stripEqual a b = assertEqual "" (resetAnnotations a) (resetAnnotations b)++> ea :: Annotation+> ea = emptyAnnotation
+ src-extra/tests/Database/HsSqlPpp/Tests/TestUtils.lhs view
@@ -0,0 +1,30 @@++> module Database.HsSqlPpp.Tests.TestUtils+>     (assertTrace,resetAnnotations) where+>+> import Test.HUnit+> --import Test.Framework+> --import Test.Framework.Providers.HUnit+> --import Data.List+> import Data.Generics.Uniplate.Data+> import Data.Data++> import Debug.Trace+> import Control.Monad++> --import Database.HsSqlPpp.Utils.Here+> --import Database.HsSqlPpp.Parser+> --import Database.HsSqlPpp.TypeChecker+> import Database.HsSqlPpp.Annotation+> --import Database.HsSqlPpp.Catalog+> --import Database.HsSqlPpp.SqlTypes+> --import Database.HsSqlPpp.Utils.PPExpr+++> assertTrace :: (Show a,Eq a) => String -> String -> a -> a -> IO ()+> assertTrace nem s a1 a2 = do+>     when (a1 /= a2) $ trace nem $ return ()+>     assertEqual s a1 a2++> resetAnnotations :: Data a => a -> a+> resetAnnotations = transformBi (const emptyAnnotation)
+ src-extra/tests/Database/HsSqlPpp/Tests/Tests.lhs view
@@ -0,0 +1,28 @@++> module Database.HsSqlPpp.Tests.Tests (allTests) where+>+> import Test.Framework+>+> import Database.HsSqlPpp.Tests.Parsing.ParserTests++> import Database.HsSqlPpp.Tests.FixTree.FixUpIdentifiersTests+> import Database.HsSqlPpp.Tests.FixTree.ExplicitCasts++> import Database.HsSqlPpp.Tests.TypeChecking.TypeCheckTests++> import Database.HsSqlPpp.Tests.QuasiQuoteTests++> --import Database.HsSqlPpp.Tests.ExtensionTests+> import Database.HsSqlPpp.Tests.ParameterizedStatementTests+>+> allTests :: [Test]+> allTests =+>     parserTests+>     : fixUpIdentifiersTests+>     : explicitCastTests+>     : quasiQuoteTests+>     : typeCheckTests+>     : parameterizedStatementTests+>     -- : extensionTests+>     : []+
+ src-extra/tests/Database/HsSqlPpp/Tests/TpchData.lhs view
@@ -0,0 +1,974 @@++> {-# LANGUAGE QuasiQuotes #-}+> module Database.HsSqlPpp.Tests.TpchData+>     (tpchQueries+>     ,tpchCatalog) where+>++> import Database.HsSqlPpp.Utils.Here+> import Database.HsSqlPpp.Catalog+> import Database.HsSqlPpp.Types++> tpchQueries :: [(String,String)]+> tpchQueries =+>   [("Q1",[here|+\begin{code}+select+        l_returnflag,+        l_linestatus,+        sum(l_quantity) as sum_qty,+        sum(l_extendedprice) as sum_base_price,+        sum(l_extendedprice * (1 - l_discount)) as sum_disc_price,+        sum(l_extendedprice * (1 - l_discount) * (1 + l_tax)) as sum_charge,+        avg(l_quantity) as avg_qty,+        avg(l_extendedprice) as avg_price,+        avg(l_discount) as avg_disc,+        count(*) as count_order+from+        lineitem+where+        l_shipdate <= date '1998-12-01' - interval '63' day (3)+group by+        l_returnflag,+        l_linestatus+order by+        l_returnflag,+        l_linestatus;+--set rowcount -1+--go+\end{code}+>                                     |])+>   ,("Q2",[here|+\begin{code}++select+        s_acctbal,+        s_name,+        n_name,+        p_partkey,+        p_mfgr,+        s_address,+        s_phone,+        s_comment+from+        part,+        supplier,+        partsupp,+        nation,+        region+where+        p_partkey = ps_partkey+        and s_suppkey = ps_suppkey+        and p_size = 15+        and p_type like '%BRASS'+        and s_nationkey = n_nationkey+        and n_regionkey = r_regionkey+        and r_name = 'EUROPE'+        and ps_supplycost = (+                select+                        min(ps_supplycost)+                from+                        partsupp,+                        supplier,+                        nation,+                        region+                where+                        p_partkey = ps_partkey+                        and s_suppkey = ps_suppkey+                        and s_nationkey = n_nationkey+                        and n_regionkey = r_regionkey+                        and r_name = 'EUROPE'+        )+order by+        s_acctbal desc,+        n_name,+        s_name,+        p_partkey;+--set rowcount 100+--go+\end{code}+>                                     |])+>   ,("Q3",[here|+\begin{code}+select+        l_orderkey,+        sum(l_extendedprice * (1 - l_discount)) as revenue,+        o_orderdate,+        o_shippriority+from+        customer,+        orders,+        lineitem+where+        c_mktsegment = 'MACHINERY'+        and c_custkey = o_custkey+        and l_orderkey = o_orderkey+        and o_orderdate < date '1995-03-21'+        and l_shipdate > date '1995-03-21'+group by+        l_orderkey,+        o_orderdate,+        o_shippriority+order by+        revenue desc,+        o_orderdate;+--set rowcount 10+--go+\end{code}+>                                     |])+>   ,("Q4",[here|+\begin{code}+select+        o_orderpriority,+        count(*) as order_count+from+        orders+where+        o_orderdate >= date '1996-03-01'+        and o_orderdate < date '1996-03-01' + interval '3' month+        and exists (+                select+                        *+                from+                        lineitem+                where+                        l_orderkey = o_orderkey+                        and l_commitdate < l_receiptdate+        )+group by+        o_orderpriority+order by+        o_orderpriority;+--set rowcount -1+--go+\end{code}+>                                     |])+>   ,("Q5",[here|+\begin{code}+select+        n_name,+        sum(l_extendedprice * (1 - l_discount)) as revenue+from+        customer,+        orders,+        lineitem,+        supplier,+        nation,+        region+where+        c_custkey = o_custkey+        and l_orderkey = o_orderkey+        and l_suppkey = s_suppkey+        and c_nationkey = s_nationkey+        and s_nationkey = n_nationkey+        and n_regionkey = r_regionkey+        and r_name = 'EUROPE'+        and o_orderdate >= date '1997-01-01'+        and o_orderdate < date '1997-01-01' + interval '1' year+group by+        n_name+order by+        revenue desc;+--set rowcount -1+--go+\end{code}+>                                     |])+>   ,("Q6",[here|+\begin{code}+select+        sum(l_extendedprice * l_discount) as revenue+from+        lineitem+where+        l_shipdate >= date '1997-01-01'+        and l_shipdate < date '1997-01-01' + interval '1' year+        and l_discount between 0.07 - 0.01 and 0.07 + 0.01+        and l_quantity < 24;+--set rowcount -1+--go+\end{code}+>                                     |])+>   ,("Q7",[here|+\begin{code}+select+        supp_nation,+        cust_nation,+        l_year,+        sum(volume) as revenue+from+        (+                select+                        n1.n_name as supp_nation,+                        n2.n_name as cust_nation,+                        extract(year from l_shipdate) as l_year,+                        l_extendedprice * (1 - l_discount) as volume+                from+                        supplier,+                        lineitem,+                        orders,+                        customer,+                        nation n1,+                        nation n2+                where+                        s_suppkey = l_suppkey+                        and o_orderkey = l_orderkey+                        and c_custkey = o_custkey+                        and s_nationkey = n1.n_nationkey+                        and c_nationkey = n2.n_nationkey+                        and (+                                (n1.n_name = 'PERU' and n2.n_name = 'IRAQ')+                                or (n1.n_name = 'IRAQ' and n2.n_name = 'PERU')+                        )+                        and l_shipdate between date '1995-01-01' and date '1996-12-31'+        ) as shipping+group by+        supp_nation,+        cust_nation,+        l_year+order by+        supp_nation,+        cust_nation,+        l_year;+--set rowcount -1+--go+\end{code}+>                                     |])+>   ,("Q8",[here|+\begin{code}+select+        o_year,+        sum(case+                when nation = 'IRAQ' then volume+                else 0+        end) / sum(volume) as mkt_share+from+        (+                select+                        extract(year from o_orderdate) as o_year,+                        l_extendedprice * (1 - l_discount) as volume,+                        n2.n_name as nation+                from+                        part,+                        supplier,+                        lineitem,+                        orders,+                        customer,+                        nation n1,+                        nation n2,+                        region+                where+                        p_partkey = l_partkey+                        and s_suppkey = l_suppkey+                        and l_orderkey = o_orderkey+                        and o_custkey = c_custkey+                        and c_nationkey = n1.n_nationkey+                        and n1.n_regionkey = r_regionkey+                        and r_name = 'MIDDLE EAST'+                        and s_nationkey = n2.n_nationkey+                        and o_orderdate between date '1995-01-01' and date '1996-12-31'+                        and p_type = 'STANDARD ANODIZED BRASS'+        ) as all_nations+group by+        o_year+order by+        o_year;+--set rowcount -1+--go++\end{code}+>                                     |])+>   ,("Q9",[here|+\begin{code}+++select+        nation,+        o_year,+        sum(amount) as sum_profit+from+        (+                select+                        n_name as nation,+                        extract(year from o_orderdate) as o_year,+                        l_extendedprice * (1 - l_discount) - ps_supplycost * l_quantity as amount+                from+                        part,+                        supplier,+                        lineitem,+                        partsupp,+                        orders,+                        nation+                where+                        s_suppkey = l_suppkey+                        and ps_suppkey = l_suppkey+                        and ps_partkey = l_partkey+                        and p_partkey = l_partkey+                        and o_orderkey = l_orderkey+                        and s_nationkey = n_nationkey+                        and p_name like '%antique%'+        ) as profit+group by+        nation,+        o_year+order by+        nation,+        o_year desc;+--set rowcount -1+--go++\end{code}+>                                     |])+>   ,("Q10",[here|+\begin{code}+++select+        c_custkey,+        c_name,+        sum(l_extendedprice * (1 - l_discount)) as revenue,+        c_acctbal,+        n_name,+        c_address,+        c_phone,+        c_comment+from+        customer,+        orders,+        lineitem,+        nation+where+        c_custkey = o_custkey+        and l_orderkey = o_orderkey+        and o_orderdate >= date '1993-12-01'+        and o_orderdate < date '1993-12-01' + interval '3' month+        and l_returnflag = 'R'+        and c_nationkey = n_nationkey+group by+        c_custkey,+        c_name,+        c_acctbal,+        c_phone,+        n_name,+        c_address,+        c_comment+order by+        revenue desc;+--set rowcount 20+--go++\end{code}+>                                     |])+>   ,("Q11",[here|+\begin{code}+++select+        ps_partkey,+        sum(ps_supplycost * ps_availqty) as value+from+        partsupp,+        supplier,+        nation+where+        ps_suppkey = s_suppkey+        and s_nationkey = n_nationkey+        and n_name = 'CHINA'+group by+        ps_partkey having+                sum(ps_supplycost * ps_availqty) > (+                        select+                                sum(ps_supplycost * ps_availqty) * 0.0001000000+                        from+                                partsupp,+                                supplier,+                                nation+                        where+                                ps_suppkey = s_suppkey+                                and s_nationkey = n_nationkey+                                and n_name = 'CHINA'+                )+order by+        value desc;+--set rowcount -1+--go++\end{code}+>                                     |])+>   ,("Q12",[here|+\begin{code}+++select+        l_shipmode,+        sum(case+                when o_orderpriority = '1-URGENT'+                        or o_orderpriority = '2-HIGH'+                        then 1+                else 0+        end) as high_line_count,+        sum(case+                when o_orderpriority <> '1-URGENT'+                        and o_orderpriority <> '2-HIGH'+                        then 1+                else 0+        end) as low_line_count+from+        orders,+        lineitem+where+        o_orderkey = l_orderkey+        and l_shipmode in ('AIR', 'RAIL')+        and l_commitdate < l_receiptdate+        and l_shipdate < l_commitdate+        and l_receiptdate >= date '1994-01-01'+        and l_receiptdate < date '1994-01-01' + interval '1' year+group by+        l_shipmode+order by+        l_shipmode;+--set rowcount -1+--go++\end{code}+>                                     |])+>   ,("Q13",[here|+\begin{code}+++select+        c_count,+        count(*) as custdist+from+        (+                select+                        c_custkey,+                        count(o_orderkey)+                from+                        customer left outer join orders on+                                c_custkey = o_custkey+                                and o_comment not like '%pending%requests%'+                group by+                        c_custkey+        ) as c_orders (c_custkey, c_count)+group by+        c_count+order by+        custdist desc,+        c_count desc;+--set rowcount -1+--go++\end{code}+>                                     |])+>   ,("Q14",[here|+\begin{code}++select+        100.00 * sum(case+                when p_type like 'PROMO%'+                        then l_extendedprice * (1 - l_discount)+                else 0+        end) / sum(l_extendedprice * (1 - l_discount)) as promo_revenue+from+        lineitem,+        part+where+        l_partkey = p_partkey+        and l_shipdate >= date '1994-12-01'+        and l_shipdate < date '1994-12-01' + interval '1' month;+--set rowcount -1+--go++\end{code}+>                                     |])+>   ,("Q15",[here|+\begin{code}++/*create view revenue0 (supplier_no, total_revenue) as+        select+                l_suppkey,+                sum(l_extendedprice * (1 - l_discount))+        from+                lineitem+        where+                l_shipdate >= date '1995-06-01'+                and l_shipdate < date '1995-06-01' + interval '3' month+        group by+                l_suppkey;*/++with+revenue0 as+        (select+                l_suppkey as supplier_no,+                sum(l_extendedprice * (1 - l_discount)) as total_revenue+        from+                lineitem+        where+                l_shipdate >= date '1995-06-01'+                and l_shipdate < date '1995-06-01' + interval '3' month+        group by+                l_suppkey)+select+        s_suppkey,+        s_name,+        s_address,+        s_phone,+        total_revenue+from+        supplier,+        revenue0+where+        s_suppkey = supplier_no+        and total_revenue = (+                select+                        max(total_revenue)+                from+                        revenue0+        )+order by+        s_suppkey;++--drop view revenue0;+--set rowcount -1+--go++\end{code}+>                                     |])+>   ,("Q16",[here|+\begin{code}+++select+        p_brand,+        p_type,+        p_size,+        count(distinct ps_suppkey) as supplier_cnt+from+        partsupp,+        part+where+        p_partkey = ps_partkey+        and p_brand <> 'Brand#15'+        and p_type not like 'MEDIUM BURNISHED%'+        and p_size in (39, 26, 18, 45, 19, 1, 3, 9)+        and ps_suppkey not in (+                select+                        s_suppkey+                from+                        supplier+                where+                        s_comment like '%Customer%Complaints%'+        )+group by+        p_brand,+        p_type,+        p_size+order by+        supplier_cnt desc,+        p_brand,+        p_type,+        p_size;+--set rowcount -1+--go++\end{code}+>                                     |])+>   ,("Q17",[here|+\begin{code}+++select+        sum(l_extendedprice) / 7.0 as avg_yearly+from+        lineitem,+        part+where+        p_partkey = l_partkey+        and p_brand = 'Brand#52'+        and p_container = 'JUMBO CAN'+        and l_quantity < (+                select+                        0.2 * avg(l_quantity)+                from+                        lineitem+                where+                        l_partkey = p_partkey+        );+--set rowcount -1+--go++\end{code}+>                                     |])+>   ,("Q18",[here|+\begin{code}+++select+        c_name,+        c_custkey,+        o_orderkey,+        o_orderdate,+        o_totalprice,+        sum(l_quantity)+from+        customer,+        orders,+        lineitem+where+        o_orderkey in (+                select+                        l_orderkey+                from+                        lineitem+                group by+                        l_orderkey having+                                sum(l_quantity) > 313+        )+        and c_custkey = o_custkey+        and o_orderkey = l_orderkey+group by+        c_name,+        c_custkey,+        o_orderkey,+        o_orderdate,+        o_totalprice+order by+        o_totalprice desc,+        o_orderdate;+--set rowcount 100+--go++\end{code}+>                                     |])+>   ,("Q19",[here|+\begin{code}+++select+        sum(l_extendedprice* (1 - l_discount)) as revenue+from+        lineitem,+        part+where+        (+                p_partkey = l_partkey+                and p_brand = 'Brand#43'+                and p_container in ('SM CASE', 'SM BOX', 'SM PACK', 'SM PKG')+                and l_quantity >= 3 and l_quantity <= 3 + 10+                and p_size between 1 and 5+                and l_shipmode in ('AIR', 'AIR REG')+                and l_shipinstruct = 'DELIVER IN PERSON'+        )+        or+        (+                p_partkey = l_partkey+                and p_brand = 'Brand#25'+                and p_container in ('MED BAG', 'MED BOX', 'MED PKG', 'MED PACK')+                and l_quantity >= 10 and l_quantity <= 10 + 10+                and p_size between 1 and 10+                and l_shipmode in ('AIR', 'AIR REG')+                and l_shipinstruct = 'DELIVER IN PERSON'+        )+        or+        (+                p_partkey = l_partkey+                and p_brand = 'Brand#24'+                and p_container in ('LG CASE', 'LG BOX', 'LG PACK', 'LG PKG')+                and l_quantity >= 22 and l_quantity <= 22 + 10+                and p_size between 1 and 15+                and l_shipmode in ('AIR', 'AIR REG')+                and l_shipinstruct = 'DELIVER IN PERSON'+        );+--set rowcount -1+--go++\end{code}+>                                     |])+>   ,("Q20",[here|+\begin{code}+++select+        s_name,+        s_address+from+        supplier,+        nation+where+        s_suppkey in (+                select+                        ps_suppkey+                from+                        partsupp+                where+                        ps_partkey in (+                                select+                                        p_partkey+                                from+                                        part+                                where+                                        p_name like 'lime%'+                        )+                        and ps_availqty > (+                                select+                                        0.5 * sum(l_quantity)+                                from+                                        lineitem+                                where+                                        l_partkey = ps_partkey+                                        and l_suppkey = ps_suppkey+                                        and l_shipdate >= date '1994-01-01'+                                        and l_shipdate < date '1994-01-01' + interval '1' year+                        )+        )+        and s_nationkey = n_nationkey+        and n_name = 'VIETNAM'+order by+        s_name;+--set rowcount -1+--go++\end{code}+>                                     |])+>   ,("Q21",[here|+\begin{code}+++select+        s_name,+        count(*) as numwait+from+        supplier,+        lineitem l1,+        orders,+        nation+where+        s_suppkey = l1.l_suppkey+        and o_orderkey = l1.l_orderkey+        and o_orderstatus = 'F'+        and l1.l_receiptdate > l1.l_commitdate+        and exists (+                select+                        *+                from+                        lineitem l2+                where+                        l2.l_orderkey = l1.l_orderkey+                        and l2.l_suppkey <> l1.l_suppkey+        )+        and not exists (+                select+                        *+                from+                        lineitem l3+                where+                        l3.l_orderkey = l1.l_orderkey+                        and l3.l_suppkey <> l1.l_suppkey+                        and l3.l_receiptdate > l3.l_commitdate+        )+        and s_nationkey = n_nationkey+        and n_name = 'INDIA'+group by+        s_name+order by+        numwait desc,+        s_name;+--set rowcount 100+--go++\end{code}+>                                     |])+>   ,("Q22",[here|+\begin{code}+++select+        cntrycode,+        count(*) as numcust,+        sum(c_acctbal) as totacctbal+from+        (+                select+                        substring(c_phone from 1 for 2) as cntrycode,+                        c_acctbal+                from+                        customer+                where+                        substring(c_phone from 1 for 2) in+                                ('41', '28', '39', '21', '24', '29', '44')+                        and c_acctbal > (+                                select+                                        avg(c_acctbal)+                                from+                                        customer+                                where+                                        c_acctbal > 0.00+                                        and substring(c_phone from 1 for 2) in+                                                ('41', '28', '39', '21', '24', '29', '44')+                        )+                        and not exists (+                                select+                                        *+                                from+                                        orders+                                where+                                        o_custkey = c_custkey+                        )+        ) as custsale+group by+        cntrycode+order by+        cntrycode;+--set rowcount -1+--go++\end{code}+>                                     |])+>   ]+++> tpchCatalog :: [CatalogUpdate]+> tpchCatalog =++CREATE TABLE NATION  ( N_NATIONKEY  INTEGER NOT NULL,+                            N_NAME       CHAR(25) NOT NULL,+                            N_REGIONKEY  INTEGER NOT NULL,+                            N_COMMENT    VARCHAR(152));++>   [CatCreateTable "nation" [("n_nationkey", typeInt)+>                            ,("n_name", typeChar)+>                            ,("n_regionkey", typeInt)+>                            ,("n_comment", typeVarChar)] []++CREATE TABLE REGION  ( R_REGIONKEY  INTEGER NOT NULL,+                            R_NAME       CHAR(25) NOT NULL,+                            R_COMMENT    VARCHAR(152));++>   ,CatCreateTable "region" [("r_regionkey", typeInt)+>                           ,("r_name", typeChar)+>                           ,("r_comment", typeVarChar)] []++CREATE TABLE PART  ( P_PARTKEY     INTEGER NOT NULL,+                          P_NAME        VARCHAR(55) NOT NULL,+                          P_MFGR        CHAR(25) NOT NULL,+                          P_BRAND       CHAR(10) NOT NULL,+                          P_TYPE        VARCHAR(25) NOT NULL,+                          P_SIZE        INTEGER NOT NULL,+                          P_CONTAINER   CHAR(10) NOT NULL,+                          P_RETAILPRICE DECIMAL(15,2) NOT NULL,+                          P_COMMENT     VARCHAR(23) NOT NULL );++>   ,CatCreateTable "part" [("p_partkey", typeInt)+>                          ,("p_name", typeVarChar)+>                          ,("p_mfgr", typeChar)+>                          ,("p_brand", typeChar)+>                          ,("p_type", typeVarChar)+>                          ,("p_size", typeInt)+>                          ,("p_container", typeChar)+>                          ,("p_retailprice", typeNumeric)+>                          ,("p_comment", typeVarChar)] []++CREATE TABLE SUPPLIER ( S_SUPPKEY     INTEGER NOT NULL,+                             S_NAME        CHAR(25) NOT NULL,+                             S_ADDRESS     VARCHAR(40) NOT NULL,+                             S_NATIONKEY   INTEGER NOT NULL,+                             S_PHONE       CHAR(15) NOT NULL,+                             S_ACCTBAL     DECIMAL(15,2) NOT NULL,+                             S_COMMENT     VARCHAR(101) NOT NULL);++>   ,CatCreateTable "supplier" [("s_suppkey", typeInt)+>                              ,("s_name", typeChar)+>                              ,("s_address", typeVarChar)+>                              ,("s_nationkey", typeInt)+>                              ,("s_phone", typeChar)+>                              ,("s_acctbal", typeNumeric)+>                              ,("s_comment", typeVarChar)] []+++CREATE TABLE PARTSUPP ( PS_PARTKEY     INTEGER NOT NULL,+                             PS_SUPPKEY     INTEGER NOT NULL,+                             PS_AVAILQTY    INTEGER NOT NULL,+                             PS_SUPPLYCOST  DECIMAL(15,2)  NOT NULL,+                             PS_COMMENT     VARCHAR(199) NOT NULL );++>   ,CatCreateTable "partsupp" [("ps_partkey", typeInt)+>                              ,("ps_suppkey", typeInt)+>                              ,("ps_availqty", typeInt)+>                              ,("ps_supplycost", typeNumeric)+>                              ,("ps_comment", typeVarChar)] []++CREATE TABLE CUSTOMER ( C_CUSTKEY     INTEGER NOT NULL,+                             C_NAME        VARCHAR(25) NOT NULL,+                             C_ADDRESS     VARCHAR(40) NOT NULL,+                             C_NATIONKEY   INTEGER NOT NULL,+                             C_PHONE       CHAR(15) NOT NULL,+                             C_ACCTBAL     DECIMAL(15,2)   NOT NULL,+                             C_MKTSEGMENT  CHAR(10) NOT NULL,+                             C_COMMENT     VARCHAR(117) NOT NULL);++>   ,CatCreateTable "customer" [("c_custkey", typeInt)+>                              ,("c_name", typeChar)+>                              ,("c_address", typeVarChar)+>                              ,("c_nationkey", typeInt)+>                              ,("c_phone", typeChar)+>                              ,("c_acctbal", typeNumeric)+>                              ,("c_mktsegment", typeChar)+>                              ,("c_comment", typeVarChar)] []+++CREATE TABLE ORDERS  ( O_ORDERKEY       INTEGER NOT NULL,+                           O_CUSTKEY        INTEGER NOT NULL,+                           O_ORDERSTATUS    CHAR(1) NOT NULL,+                           O_TOTALPRICE     DECIMAL(15,2) NOT NULL,+                           O_ORDERDATE      DATE NOT NULL,+                           O_ORDERPRIORITY  CHAR(15) NOT NULL,  +                           O_CLERK          CHAR(15) NOT NULL, +                           O_SHIPPRIORITY   INTEGER NOT NULL,+                           O_COMMENT        VARCHAR(79) NOT NULL);++>   ,CatCreateTable "orders" [("o_orderkey", typeInt)+>                            ,("o_custkey", typeInt)+>                            ,("o_orderstatus", typeChar)+>                            ,("o_totalprice", typeNumeric)+>                            ,("o_orderdate", typeDate)+>                            ,("o_orderpriority", typeChar)+>                            ,("o_clerk", typeChar)+>                            ,("o_shippriority", typeInt)+>                            ,("o_comment", typeVarChar)] []+++CREATE TABLE LINEITEM ( L_ORDERKEY    INTEGER NOT NULL,+                             L_PARTKEY     INTEGER NOT NULL,+                             L_SUPPKEY     INTEGER NOT NULL,+                             L_LINENUMBER  INTEGER NOT NULL,+                             L_QUANTITY    DECIMAL(15,2) NOT NULL,+                             L_EXTENDEDPRICE  DECIMAL(15,2) NOT NULL,+                             L_DISCOUNT    DECIMAL(15,2) NOT NULL,+                             L_TAX         DECIMAL(15,2) NOT NULL,+                             L_RETURNFLAG  CHAR(1) NOT NULL,+                             L_LINESTATUS  CHAR(1) NOT NULL,+                             L_SHIPDATE    DATE NOT NULL,+                             L_COMMITDATE  DATE NOT NULL,+                             L_RECEIPTDATE DATE NOT NULL,+                             L_SHIPINSTRUCT CHAR(25) NOT NULL,+                             L_SHIPMODE     CHAR(10) NOT NULL,+                             L_COMMENT      VARCHAR(44) NOT NULL);++>   ,CatCreateTable "lineitem" [("l_orderkey", typeInt)+>                              ,("l_partkey", typeInt)+>                              ,("l_suppkey", typeInt)+>                              ,("l_linenumber", typeInt)+>                              ,("l_quantity", typeNumeric)+>                              ,("l_extendedprice", typeNumeric)+>                              ,("l_discount", typeNumeric)+>                              ,("l_tax", typeNumeric)+>                              ,("l_returnflag", typeChar)+>                              ,("l_linestatus", typeChar)+>                              ,("l_shipdate", typeDate)+>                              ,("l_commitdate", typeDate)+>                              ,("l_receiptdate", typeDate)+>                              ,("l_shipinstruct", typeChar)+>                              ,("l_shipmode", typeChar)+>                              ,("l_comment", typeVarChar)] []++>   ]
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/CaseExpressions.lhs view
@@ -0,0 +1,56 @@++> module Database.HsSqlPpp.Tests.TypeChecking.CaseExpressions+>     (caseExpressionsTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types+>+>+> caseExpressionsTestData :: Item+> caseExpressionsTestData =+>   Group "case expressions" [+>       e "case\n\+>         \ when true then 1\n\+>         \end" $ Right typeInt+>      ,e "case\n\+>         \ when 1=2 then 'stuff'\n\+>         \ when 2=3 then 'blah'\n\+>         \ else 'test'\n\+>         \end" $ Right UnknownType+>      ,e "case\n\+>         \ when 1=2 then 'stuff'\n\+>         \ when 2=3 then 'blah'\n\+>         \ else 'test'::text\n\+>         \end" $ Right $ ScalarType "text"+>      ,e "case\n\+>         \ when 1=2 then 'stuff'\n\+>         \ when true=3 then 'blah'\n\+>         \ else 'test'\n\+>         \end" $ Left [NoMatchingOperator "=" [typeBool,typeInt]]+>      ,e "case\n\+>         \ when 1=2 then true\n\+>         \ when 2=3 then false\n\+>         \ else 1\n\+>         \end" $ Left [IncompatibleTypeSet [typeBool+>                                         ,typeBool+>                                         ,typeInt]]+>      ,e "case\n\+>         \ when 1=2 then false\n\+>         \ when 2=3 then 1\n\+>         \ else true\n\+>         \end" $ Left [IncompatibleTypeSet [typeBool+>                                           ,typeInt+>                                           ,typeBool]]+>      ,e "case 1 when 2 then 3 else 4 end" $ Right typeInt+>      ,e "case 1 when true then 3 else 4 end"+>             $ Left [IncompatibleTypeSet [ScalarType "int4"+>                                          ,ScalarType "bool"]]+>      ,e "case 1 when 2 then true else false end" $ Right typeBool+>      ,e "case 1 when 2 then 3 else false end"+>             $ Left [IncompatibleTypeSet [ScalarType "int4"+>                                          ,ScalarType "bool"]]+>      ]+>  where+>    e = Expr+
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/CatalogChaining.lhs view
@@ -0,0 +1,34 @@++> module Database.HsSqlPpp.Tests.TypeChecking.CatalogChaining+>     (tcCatalogChainingTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types+>++> tcCatalogChainingTestData :: Item+> tcCatalogChainingTestData =+>   Group "check catalog chaining" [+>+>     -- create function then select+>     -- select then create function+>     -- then in two separate chained asts+>+>       s "create function t1() returns void as $$\n\+>         \begin\n\+>         \  null;\n\+>         \end;\n\+>         \$$ language plpgsql stable;\n\+>         \select t1();"+>         (Right [Nothing,Just ([], [])])+>      ,s "select t1();\n\+>         \create function t1() returns void as $$\n\+>         \begin\n\+>         \  null;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         (Left [NoMatchingOperator "t1" []])+>   ]+>  where+>    s = StmtType
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/CombineSelects.lhs view
@@ -0,0 +1,42 @@++> module Database.HsSqlPpp.Tests.TypeChecking.CombineSelects+>     (tcCombineSelectsTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types+>+> tcCombineSelectsTestData :: Item+> tcCombineSelectsTestData =+>   Group "combine selects" [+>      s "select 1,2  union select '3', '4';" $ Right [Just ([],+>                                      [("?column?", typeInt)+>                                      ,("?column?", typeInt)])]+>      ,s "select 1,2 intersect select 'a', true;" $ Left [IncompatibleTypeSet [typeInt+>                                                         ,typeBool]]+>      ,s "select '3', '4' except select 1,2;" $ Right [Just ([],+>                                      [("?column?", typeInt)+>                                      ,("?column?", typeInt)])]+>      ,s "select 'a', true union select 1,2;"+>                                      $ Left [IncompatibleTypeSet [typeBool+>                                                         ,typeInt]]+>      ,s "select 'a'::text, '2'::int2 intersect select '1','2';" $ Right [Just ([],+>                                      [("text", ScalarType "text")+>                                      ,("int2", typeSmallInt)])]+>      ,s "select 1,2,3 except select 1,2;" $ Left [ValuesListsMustBeSameLength]+>      ,s "select '3' as a, '4' as b except select 1,2;" $ Right [Just ([],+>                                      [("a", typeInt)+>                                      ,("b", typeInt)])]+>      --FIXME: withs not working+>      {-,s [here|+>          with a as (select 1 as a1),+>               b as (select * from a)+>               select * from a+>               union select * from b; |]+>          $ Right [Just $ ([],+>                            [("a1", typeInt)])]-}+>      ]++>  where+>    s = StmtType+
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/Creates.lhs view
@@ -0,0 +1,60 @@++> module Database.HsSqlPpp.Tests.TypeChecking.Creates+>     (tcCreateTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types+>+> import Database.HsSqlPpp.Catalog++> tcCreateTestData :: Item+> tcCreateTestData =+>   Group "creates" [+>       d "create table t1 (\n\+>         \   a int,\n\+>         \   b text\n\+>         \);"+>         [CatCreateTable "t1" [("a",ScalarType "int4")+>                               ,("b",ScalarType "text")]+>                               [("tableoid", ScalarType "oid")+>                               ,("cmax", ScalarType "cid")+>                               ,("xmax", ScalarType "xid")+>                               ,("cmin", ScalarType "cid")+>                               ,("xmin", ScalarType "xid")+>                               ,("ctid", ScalarType "tid")]]+>      ,d "create type t1 as (\n\+>         \   a int,\n\+>         \   b text\n\+>         \);"+>         [CatCreateComposite "t1" [("a",ScalarType "int4")+>                                   ,("b",ScalarType "text")]]+>+>      ,d "create domain t1 as text;"+>         [CatCreateDomain (DomainType "t1") (ScalarType "text")]++>      --fixme: check in domain constraint+>      {-,d "create domain t1 as text check (value in ('a', 'b'));\n\+>         \select 'text'::t1;"+>         [CatCreateDomain (DomainType "t1") (ScalarType "text")]-}+>+>+>      ,d "create view v1 as select * from pg_attrdef;"+>         [CatCreateView "v1" [("adrelid",ScalarType "oid")+>                              ,("adnum",ScalarType "int2")+>                              ,("adbin",ScalarType "pg_node_tree")+>                              ,("adsrc",ScalarType "text")]]+>+>      ,d "create function t1(text) returns text as $$\n\+>         \null;\n\+>         \$$ language sql stable;"+>         [CatCreateFunction FunName "t1" [ScalarType "text"]+>                             (ScalarType "text") False]+>      ,d "create language plpgsql;"+>         [CatCreateFunction FunName "plpgsql_call_handler" [] (Pseudo LanguageHandler) False+>         ,CatCreateFunction FunName "plpgsql_validator" [ScalarType "oid"] (Pseudo Void) False]+>      ]+>+>  where+>    d = Ddl+
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/Delete.lhs view
@@ -0,0 +1,23 @@++> module Database.HsSqlPpp.Tests.TypeChecking.Delete+>     (tcDeleteTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types++> tcDeleteTestData :: Item+> tcDeleteTestData =+>   Group "delete" [+>       s "delete from nope;"+>         $ Left [UnrecognisedRelation "nope"]+>      ,s "delete from pg_attrdef where 1=2;"+>         $ Right [Just ([], [])]+>      ,s "delete from pg_attrdef where 1;"+>         $ Left [ExpressionMustBeBool]+>      ,s "delete from pg_attrdef where adsrc='';"+>         $ Right [Just ([], [])]+>      ]++>  where+>    s = StmtType
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/Drops.lhs view
@@ -0,0 +1,39 @@++> module Database.HsSqlPpp.Tests.TypeChecking.Drops+>     (tcDropsTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types+>+> import Database.HsSqlPpp.Catalog++--------------------------------------------------------------------------------+++> tcDropsTestData :: Item+> tcDropsTestData =+>   Group "drop stuff" [+>       d "create function test(a int) returns void as $$\n\+>         \begin\n\+>         \  null;\n\+>         \end\n\+>         \$$ language plpgsql;"+>         [CatCreateFunction FunName "test" [typeInt] (Pseudo Void) False]+>      ,d "create function test(a int) returns void as $$\n\+>         \begin\n\+>         \  null;\n\+>         \end\n\+>         \$$ language plpgsql;\n\+>         \drop function test(int);"+>         []+>         -- FIXME: this should fail but doesn't+>      ,d "drop function test(int);"+>         []+>      ,d "drop function if exists test(int);"+>         []+>      ]++>  where+>    d = Ddl+
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/Insert.lhs view
@@ -0,0 +1,34 @@++> module Database.HsSqlPpp.Tests.TypeChecking.Insert+>     (tcInsertTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types++> tcInsertTestData :: Item+> tcInsertTestData =+>   Group "insert" [+>       s "insert into nope (a,b) values (c,d);"+>         $ Left [UnrecognisedRelation "nope"+>                ,UnrecognisedIdentifier "c"+>                ,UnrecognisedIdentifier "d"]+>      ,s "insert into pg_attrdef (adrelid,adnum,adbin,adsrc)\n\+>         \values (1,2, 'a', 'b');"+>         $ Right [Just ([], [])]+>      ,s "insert into pg_attrdef\n\+>         \values (1,2, 'a', 'c');"+>         $ Right [Just ([], [])]+>      ,s "insert into pg_attrdef (hello,adnum,adbin,adsrc)\n\+>         \values (1,2, 'a', 'b');"+>         $ Left [UnrecognisedIdentifier "hello"]+>      ,s "insert into pg_attrdef (adrelid,adnum,adbin,adsrc)\n\+>         \values (1,true, 'a', 'b');"+>         $ Left [IncompatibleTypes (ScalarType "int2") (ScalarType "bool")]+>      ,s "insert into pg_attrdef (adrelid,adnum,adbin,adsrc)\n\+>         \values (1,true, 'a', 'b','c');"+>         $ Left [WrongNumberOfColumns]+>      ]++>  where+>    s = StmtType
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/Into.lhs view
@@ -0,0 +1,113 @@++> module Database.HsSqlPpp.Tests.TypeChecking.Into+>     (tcIntoTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types++--------------------------------------------------------------------------------+++> tcIntoTestData :: Item+> tcIntoTestData = --fixme: intos need fixing+>   Group "select into" $ drop 1000 [+>       s "insert into pg_attrdef (adrelid,adnum,adbin,adsrc)\n\+>         \values (1,2, 'a', 'b') returning adnum,adbin;"+>         $ Right [Just ([], [("adnum", ScalarType "int2")+>                            ,("adbin", ScalarType "pg_node_tree")])]+>      ,s "update pg_attrdef set adnum = adnum + 1 returning adnum;"+>         $ Right [Just ([], [("adnum", ScalarType "int2")])]+>      ,s "delete from pg_attrdef returning adnum,adbin;"+>         $ Right [Just ([], [("adnum", ScalarType "int2")+>                            ,("adbin", ScalarType "pg_node_tree")])]+>      ,s "create function t1() returns void as $$\n\+>         \declare\n\+>         \  a int;\n\+>         \  b text;\n\+>         \begin\n\+>         \  select adnum,adbin into a,b from pg_attrdef;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         $ Right [Nothing]+>      ,s "create function t1() returns void as $$\n\+>         \declare\n\+>         \  a int;\n\+>         \  b text;\n\+>         \begin\n\+>         \  select adnum,adbin into b,a from pg_attrdef;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         $ Left [IncompatibleTypes (ScalarType "text") (ScalarType "int2")+>                ,IncompatibleTypes (ScalarType "int4") (ScalarType "text")]+>      ,s "create function t1() returns void as $$\n\+>         \declare\n\+>         \  a int;\n\+>         \  b text;\n\+>         \begin\n\+>         \  select adnum,adbin into a,c from pg_attrdef;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         $ Left [UnrecognisedIdentifier "c"]+>      ,s "create function t1() returns void as $$\n\+>         \declare\n\+>         \  a int;\n\+>         \  b text;\n\+>         \begin\n\+>         \  select adnum,adbin into a from pg_attrdef;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         $ Left [WrongNumberOfColumns]+>      ,s "create function t1() returns void as $$\n\+>         \declare\n\+>         \  r record;\n\+>         \  a int;\n\+>         \  b text;\n\+>         \begin\n\+>         \  select adnum,adbin into r from pg_attrdef;\n\+>         \  a := r.adnum;\n\+>         \  b := r.adbin;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         $ Right [Nothing]+>      ,s "create function t1() returns void as $$\n\+>         \declare\n\+>         \  r record;\n\+>         \  a int;\n\+>         \  b text;\n\+>         \begin\n\+>         \  select adnum,adbin into r from pg_attrdef;\n\+>         \  a := r.adnum;\n\+>         \  b := r.adsrc;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         $ Left [UnrecognisedIdentifier "adsrc"]+>      ,s "create function t1() returns void as $$\n\+>         \declare\n\+>         \  r pg_attrdef;\n\+>         \begin\n\+>         \  select * into r from pg_attrdef;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         $ Right [Nothing]+>      ,s "create function t1() returns void as $$\n\+>         \declare\n\+>         \  r pg_class;\n\+>         \begin\n\+>         \  select adnum,adbin into r from pg_attrdef;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         $ Left [IncompatibleTypes (NamedCompositeType "pg_class") (AnonymousRecordType [ScalarType "int2",ScalarType "text"])]+>      ,s "create function t1() returns void as $$\n\+>         \declare\n\+>         \  r record;\n\+>         \begin\n\+>         \  select adnum,adbin into r from pg_attrdef;\n\+>         \  select relname into r from pg_class;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         $ Right [Nothing]+>      ]+>  where+>    s = StmtType+
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/Joins.lhs view
@@ -0,0 +1,66 @@++> module Database.HsSqlPpp.Tests.TypeChecking.Joins+>     (tcJoinsTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types++> tcJoinsTestData :: Item+> tcJoinsTestData =+>     Group "simple join selects" [+>       s "select * from (select 1 as a, 2 as b) a\n\+>         \  cross join (select true as c, 4.5 as d) b;"+>         $ Right [Just ([], [("a", typeInt)+>                            ,("b", typeInt)+>                            ,("c", typeBool)+>                            ,("d", typeNumeric)])]+>      ,s "select * from (select 1 as a, 2 as b) a\n\+>         \  inner join (select true as c, 4.5 as d) b on true;"+>         $ Right [Just ([], [("a", typeInt)+>                            ,("b", typeInt)+>                            ,("c", typeBool)+>                            ,("d", typeNumeric)])]+>      ,s "select * from (select 1 as a, 2 as b) a\n\+>         \  inner join (select 1 as a, 4.5 as d) b using(a);"+>         $ Right [Just ([], [("a", typeInt)+>                            ,("b", typeInt)+>                            ,("d", typeNumeric)])]+>      ,s "select * from (select 1 as a, 2 as b) a\n\+>         \ natural inner join (select 1 as a, 4.5 as d) b;"+>         $ Right [Just ([], [("a", typeInt)+>                            ,("b", typeInt)+>                            ,("d", typeNumeric)])]+>         --check the attribute order+>      ,s "select * from (select 2 as b, 1 as a) a\n\+>         \ natural inner join (select 4.5 as d, 1 as a) b;"+>         $ Right [Just ([], [("a", typeInt)+>                            ,("b", typeInt)+>                            ,("d", typeNumeric)])]+>       --fixme: result set compatilibity check+>      {-,s "select * from (select 1 as a1, 2 as b) a\n\+>         \ natural inner join (select true as a1, 4.5 as d) b;"+>         $ Left [UnrecognisedCorrelationName ""+>                ,IncompatibleTypeSet [ScalarType "int4"+>                                     ,ScalarType "bool"]]-}+>       --fixme: result set compatilibity check+>       {-,s "select * from (select 1 as a1, 2 as b) a\n\+>         \ natural inner join (select true as a1, 4.5 as d) b;"+>         $ Left [UnrecognisedCorrelationName ""+>                ,IncompatibleTypeSet [ScalarType "int4"+>                                     ,ScalarType "bool"]]-}+>        ,s "select * from (select 1 as a1) a, (select 2 as a2) b;"+>         $ Right [Just ([], [("a1", typeInt)+>                                            ,("a2", typeInt)])]+>+>        ,s "select * from (select 1 as a1) a, (select 2 as a1) b;"+>         $ Right [Just ([], [("a1", typeInt)+>                                            ,("a1", typeInt)])]+>        --fixme: error detection (fixupids?)+>        {-,s "select a1 from (select 1 as a1) a,  (select 2 as a1) b;"+>         $ Left [AmbiguousIdentifier "a1"]-}+>      ]++>  where+>    s = StmtType+
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/Literals.lhs view
@@ -0,0 +1,25 @@++> module Database.HsSqlPpp.Tests.TypeChecking.Literals+>     (tcLiteralTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types+>+> tcLiteralTestData :: Item+> tcLiteralTestData =+>    Group "basic literal types" [+>       e "1" $ Right typeInt+>      ,e "1.0" $ Right typeNumeric+>      ,e "'test'" $ Right UnknownType+>      ,e "true" $ Right typeBool+>      ,e "array[1,2,3]" $ Right (ArrayType typeInt)+>      ,e "array['a','b']" $ Right (ArrayType UnknownType)+>      ,e "array['a'::text,'b']" $ Right (ArrayType (ScalarType "text"))+>      ,e "array['a','b'::text]" $ Right (ArrayType (ScalarType "text"))+>      ,e "array[1,'b']" $ Right (ArrayType typeInt)+>      ,e "array[1,true]" $ Left [NoMatchingOperator "!arrayctor" [ScalarType "int4",ScalarType "bool"]]+>      ]+>  where+>    e = Expr+
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/Misc.lhs view
@@ -0,0 +1,62 @@++Set of tests to check the type checking code. Includes tests for the+errors for sql which doesn't type check.++> module Database.HsSqlPpp.Tests.TypeChecking.Misc+>     (tcMiscTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types+>+> --import Database.HsSqlPpp.Catalog++--------------------------------------------------------------------------------+++> tcMiscTestData :: Item+> tcMiscTestData = --fixme+>   Group "misc" [+>   {-Group "composite elements" [+>       s "create function t1() returns void as $$\n\+>         \declare\n\+>         \  r pg_attrdef;\n\+>         \  a int;\n\+>         \  b text;\n\+>         \begin\n\+>         \  b = r.adsrc;\n\+>         \  r.adnum := a;\n\+>         \  b = r.adsrc;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         $ Right [Nothing]+>      ]-}++>   {-,Group "positional args" [+>       s "create function distance(int, int, int, int) returns float(24) as $$\n\+>         \  select (point($1, $2) <-> point($3, $4))::float(24) as result;\n\+>         \$$ language sql immutable;"+>         $ Right [Nothing]+>      ,s "create function distance(int, int, int, int) returns float(24) as $$\n\+>         \  select (point($1, $2) <-> point($3, $5))::float(24) as result;\n\+>         \$$ language sql immutable;"+>         $ Left [UnrecognisedIdentifier "$5"]+>      ]++>   ,-}Group "window fns" [+>       s "select *, row_number() over () from pg_attrdef;"+>         $ Right [Just ([],+>                   [("adrelid",ScalarType "oid")+>                   ,("adnum",ScalarType "int2")+>                   ,("adbin",ScalarType "pg_node_tree")+>                   ,("adsrc",ScalarType "text")+>                   ,("row_number",ScalarType "int8")])]+>      ]+>   ]++>  where+>    --e = Expr+>    s = StmtType+>    --c = CatStmtType+>    --d = Ddl+
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/MiscExpressions.lhs view
@@ -0,0 +1,63 @@++> module Database.HsSqlPpp.Tests.TypeChecking.MiscExpressions+>     (miscExpressionsTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types+>+>+> miscExpressionsTestData :: Item+> miscExpressionsTestData =+>   Group "misc expressions" [++~~~~+implicit casting and function/operator choice tests:+check when multiple implicit and one exact match on num args+check multiple matches with num args, only one with implicit conversions+check multiple implicit matches with one preferred+check multiple implicit matches with one preferred highest count+check casts from unknown string lits+~~~~++>   Group "some expressions" [+>       e "3 + '4'" $ Right typeInt+>      ,e "3.0 + '4'" $ Right typeNumeric+>      ,e "'3' + '4'" $ Left [NoMatchingOperator "+" [UnknownType+>                                                    ,UnknownType]]+>      ]+>   ,Group "exists expressions" [+>       e "exists (select 1 from pg_type)" $ Right typeBool+>      ,e "exists (select testit from pg_type)"+>        $ Left [UnrecognisedIdentifier "testit"]+>      ]++>   ,Group "polymorphic functions" [+>       e "array_append(ARRAY[1,2], 3)"+>         $ Right (ArrayType typeInt)+>      ,e "array_append(ARRAY['a','b'], 'c')"+>         $ Right (ArrayType UnknownType)+>      ,e "array_append(ARRAY['a','b'], 'c'::text)"+>         $ Right (ArrayType $ ScalarType "text")+>      ,e "array_append(ARRAY['a','b'::text], 'c')"+>         $ Right (ArrayType $ ScalarType "text")+>      ,e "array_append(ARRAY['a'::int,'b'], 'c')"+>         $ Right (ArrayType typeInt)+>      ]++>   ,Group "cast expressions" [+>       e "cast ('1' as integer)"+>         $ Right typeInt+>      ,e "cast ('1' as baz)"+>         $ Left [UnknownTypeName "baz"]+>      ,e "array[]" -- FIXME: this isn't quite right but not sure how to do it atm+>                   -- no point fixing this case since need a load of other+>                   -- test cases where the behaviour is different+>         $ Right (Pseudo AnyArray) -- Left [TypelessEmptyArray]+>      ,e "array[] :: text[]"+>         $ Right (ArrayType (ScalarType "text"))+>      ]++>      ]+>  where+>    e = Expr
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/MiscSelects.lhs view
@@ -0,0 +1,83 @@++> module Database.HsSqlPpp.Tests.TypeChecking.MiscSelects+>     (tcMiscSelectTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types+> import Database.HsSqlPpp.Catalog++> tcMiscSelectTestData :: Item+> tcMiscSelectTestData =+>   Group "misc selects" [+>   Group "aggregates" [+>        s "select max(prorettype::int) from pg_proc;"+>         $ Right [Just ([], [("max", typeInt)])]+>      ]++>   ,Group "simple wheres" [+>       s "select 1 from pg_type where true;"+>         $ Right [Just ([], [("?column?", typeInt)])]+>      ,s "select 1 from pg_type where 1;"+>         $ Left [ExpressionMustBeBool]+>      ,s "select typname from pg_type where typbyval;"+>         $ Right [Just ([], [("typname", ScalarType "name")])]+>      ,s "select typname from pg_type where typtype = 'b';"+>         $ Right [Just ([], [("typname", ScalarType "name")])]+>      ,s "select typname from pg_type where what = 'b';"+>         $ Left [UnrecognisedIdentifier "what"]+>      ]++>   ,Group "unnest" [+>       s "select conname,unnest(conkey) as attnum from pg_constraint;"+>         $ Right [Just ([], [("conname",ScalarType "name")+>                                          ,("attnum",typeSmallInt)])]+>      ]++TODO: check identifier stacking working, then remove the pg_namespace+qualifier before oid and this should still work++>   ,Group "subqueries" [+>       s "select relname as relvar_name\n\+>         \    from pg_class\n\+>         \    where ((relnamespace =\n\+>         \           (select oid\n\+>         \              from pg_namespace\n\+>         \              where (nspname = 'public'))) and (relkind = 'r'));"+>         $ Right [Just ([], [("relvar_name",ScalarType "name")])]+>      ,s "select relname from pg_class where relkind in ('r', 'v');"+>         $ Right [Just ([], [("relname",ScalarType "name")])]+>      ,s "select * from generate_series(1,7) g\n\+>         \where g not in (select * from generate_series(3,5));"+>         $ Right [Just ([], [("g",typeInt)])]+>      ,s "select * from generate_series(3,5);"+>         $ Right [Just ([], [("generate_series",typeInt)])]+>      ,s "select * from generate_series(1,7) g\n\+>         \where g not in (1,2);"+>         $ Right [Just ([], [("g",typeInt)])]++>      ,s "select 3 = any(array[1,2,3]);"+>         $ Right [Just ([], [("?column?",typeBool)])]+>      ,c "select b.t,b.u from a,b where a.t = b.t\n\+>         \ and b.u = (select min(b.u) from b where a.t = b.t);"+>         [CatCreateTable "a" [("t", typeInt)] []+>         ,CatCreateTable "b" [("t", typeInt)+>                             ,("u", typeNumeric)] []]+>         $ Right [Just ([], [("t", typeInt)+>                            ,("u", typeNumeric)])]+>      ]+>+>  -- identifiers in select parts+>     ,Group "select part identifiers" [+>       s "select relname as relvar_name,attname as name from pg_class\n\+>         \inner join pg_attribute\n\+>         \on pg_attribute.attrelid = pg_class.oid;"+>         $ Right [Just ([], [("relvar_name",ScalarType "name")+>                            ,("name",ScalarType "name")])]+>      ]+>   ]+++>  where+>    s = StmtType+>    c = CatStmtType
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/Plpgsql.lhs view
@@ -0,0 +1,179 @@++> module Database.HsSqlPpp.Tests.TypeChecking.Plpgsql+>     (tcPlpgsqlTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types++--------------------------------------------------------------------------------++~~~~+check the identifier resolution for functions:+parameters+variable declarations+select expressions inside these:+refer to param+refer to variable+override var with var+override var with select iden+todo: override var with param, override select iden with param++check var defs:+check type exists+check type of initial values+++> tcPlpgsqlTestData :: Item+> tcPlpgsqlTestData = --fixme: plpgsql ids+>   Group "plpgsql" $ drop 1000 [+>   Group "create function param resolution" [+>       s "create function t1(stuff text) returns text as $$\n\+>         \begin\n\+>         \  return stuff || ' and stuff';\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         (Right [Nothing])+>      ,s "create function t1(stuff text) returns text as $$\n\+>         \begin\n\+>         \  return badstuff || ' and stuff';\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         (Left [UnrecognisedIdentifier "badstuff"])+>      ,s "create function t1() returns text as $$\n\+>         \declare\n\+>         \  stuff text;\n\+>         \begin\n\+>         \  return stuff || ' and stuff';\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         (Right [Nothing])+>      ]+++--------------------------------------------------------------------------------++>   ,Group "plpgsqlbits" [+>       s "create function t1(stuff text) returns text as $$\n\+>         \begin\n\+>         \  return stuff || ' and stuff';\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         (Right [Nothing])+>      ,s "create function t1(stuff text) returns text as $$\n\+>         \begin\n\+>         \  return badstuff || ' and stuff';\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         (Left [UnrecognisedIdentifier "badstuff"])+>      ,s "create function t1() returns text as $$\n\+>         \declare\n\+>         \  stuff text;\n\+>         \begin\n\+>         \  return stuff || ' and stuff';\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         (Right [Nothing])+>      ,s "create function t1() returns void as $$\n\+>         \declare\n\+>         \  a bool;\n\+>         \begin\n\+>         \  a := 3;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         (Left [IncompatibleTypes (ScalarType "bool") (ScalarType "int4")])+>      ,s "create function t1() returns void as $$\n\+>         \declare\n\+>         \  a boolean;\n\+>         \begin\n\+>         \  a := true;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         (Right [Nothing])+>      ]++--------------------------------------------------------------------------------++>   ,Group "for loops" [+>       s "create function t1() returns void as $$\n\+>         \declare\n\+>         \  r record;\n\+>         \  t int;\n\+>         \begin\n\+>         \  for r in select * from pg_attrdef loop\n\+>         \    t := r.adnum;\n\+>         \  end loop;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         (Right [Nothing])+>+>+>      {-,s "create function t1() returns void as $$\n\+>         \declare\n\+>         \  r record;\n\+>         \  t int;\n\+>         \begin\n\+>         \  for r in select adnum from pg_attrdef loop\n\+>         \    t := r;\n\+>         \  end loop;\n\+>         \end;\n\+>         \$$ language plpgsql stable;"+>         (Right [Nothing])-}+>+>       -- loop var already declared+>+>      ,s "create function test() returns void as $$\n\+>         \declare\n\+>         \  i int;\n\+>         \  i1 int;\n\+>         \begin\n\+>         \  for i in 0 .. 10 loop\n\+>         \    i1 := i;\n\+>         \  end loop;\n\+>         \end;\n\+>         \$$ language plpgsql volatile;"+>        (Right [Nothing])+>+>        --implicitly created loop var+>+>      ,s "create function test() returns void as $$\n\+>         \declare\n\+>         \  i1 int;\n\+>         \begin\n\+>         \  for i in 0 .. 10 loop\n\+>         \    i1 := i;\n\+>         \  end loop;\n\+>         \end;\n\+>         \$$ language plpgsql volatile;"+>        (Right [Nothing])+>+>        --loop var already declared, wrong type+>+>      ,s "create function test() returns void as $$\n\+>         \declare\n\+>         \  i bool;\n\+>         \begin\n\+>         \  for i in 0 .. 10 loop\n\+>         \    null;\n\+>         \  end loop;\n\+>         \end;\n\+>         \$$ language plpgsql volatile;"+>        (Left [IncompatibleTypes (ScalarType "bool") (ScalarType "int4")])+>+>       --loop var implicit check it's type+>+>      ,s "create function test() returns void as $$\n\+>         \declare\n\+>         \  t bool;\n\+>         \begin\n\+>         \  for i in 0 .. 10 loop\n\+>         \    t := i;\n\+>         \  end loop;\n\+>         \end;\n\+>         \       $$ language plpgsql volatile;"+>         (Left [IncompatibleTypes (ScalarType "bool") (ScalarType "int4")])+>      ]+>      ]+>  where+>    s = StmtType+
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/Qualification.lhs view
@@ -0,0 +1,47 @@++> module Database.HsSqlPpp.Tests.TypeChecking.Qualification+>     (tcQualificationTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types++> tcQualificationTestData :: Item+> tcQualificationTestData =+>   Group "simple scalar identifier qualification" [+>       s "select a.* from \n\+>         \(select 1 as a, 2 as b) a \n\+>         \cross join (select 3 as c, 4 as d) b;"+>         $ Right [Just ([], [("a", typeInt)+>                            ,("b", typeInt)])]+>      {-,s "select nothere.* from \n\+>         \(select 1 as a, 2 as b) a \n\+>         \cross join (select 3 as c, 4 as d) b;"+>         $ Left [UnrecognisedCorrelationName "nothere"]-}+>      ,s "select a.b,b.c from \n\+>         \(select 1 as a, 2 as b) a \n\+>         \natural inner join (select 3 as a, 4 as c) b;"+>         $ Right [Just ([], [("b", typeInt)+>                            ,("c", typeInt)])]+>        ,s "select a.a,b.a from \n\+>         \(select 1 as a, 2 as b) a \n\+>         \natural inner join (select 3 as a, 4 as c) b;"+>         $ Right [Just ([], [("a", typeInt)+>                            ,("a", typeInt)])]+>      ,s "select pg_attrdef.adsrc from pg_attrdef;"+>         $ Right [Just ([], [("adsrc", ScalarType "text")])]+>+>      ,s "select a.adsrc from pg_attrdef a;"+>         $ Right [Just ([], [("adsrc", ScalarType "text")])]+>+>      ,s "select pg_attrdef.adsrc from pg_attrdef a;"+>         $ Left [UnrecognisedCorrelationName "pg_attrdef"]+>+>      ,s "select a from (select 2 as b, 1 as a) a\n\+>         \natural inner join (select 4.5 as d, 1 as a) b;"+>         $ Right [Just ([], [("a", typeInt)])]+>+>      ]++>  where+>    s = StmtType
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/RowCtors.lhs view
@@ -0,0 +1,52 @@++Set of tests to check the type checking code. Includes tests for the+errors for sql which doesn't type check.++> module Database.HsSqlPpp.Tests.TypeChecking.RowCtors+>     (tcRowCtorsTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types+>+>+> tcRowCtorsTestData :: Item+> tcRowCtorsTestData =+>   Group "row comparison expressions" [++~~~~+rows different lengths+rows match types pairwise, same and different types+rows implicit cast from unknown+rows don't match types+~~~~++>       e "row(1)" $ Right (AnonymousRecordType [typeInt])+>      ,e "row(1,2)" $ Right (AnonymousRecordType [typeInt,typeInt])+>      ,e "row('t1','t2')" $ Right (AnonymousRecordType [UnknownType,UnknownType])+>      ,e "row(true,1,'t3')" $ Right (AnonymousRecordType [typeBool, typeInt,UnknownType])+>      ,e "(true,1,'t3',75.3)" $ Right (AnonymousRecordType [typeBool,typeInt+>                                       ,UnknownType,typeNumeric])+>      ,e "row(1) = row(2)" $ Right typeBool+>      ,e "row(1,2) = row(2,1)" $ Right typeBool+>      ,e "(1,2) = (2,1)" $ Right typeBool+>      ,e "(1,2,3) = (2,1)" $ Left [NoMatchingOperator "="+>                                   [AnonymousRecordType [ScalarType "int4"+>                                                        ,ScalarType "int4"+>                                                        ,ScalarType "int4"]+>                                    ,AnonymousRecordType [ScalarType "int4"+>                                                         ,ScalarType "int4"]]]+>      ,e "('1',2) = (2,'1')" $ Right typeBool+>      ,e "(1,true) = (2,1)" $ Left [NoMatchingOperator "="+>                                    [AnonymousRecordType [ScalarType "int4"+>                                                         ,ScalarType "bool"]+>                                    ,AnonymousRecordType [ScalarType "int4"+>                                                         ,ScalarType "int4"]]]+>      ,e "(1,2) <> (2,1)" $ Right typeBool+>      ,e "(1,2) >= (2,1)" $ Right typeBool+>      ,e "(1,2) <= (2,1)" $ Right typeBool+>      ,e "(1,2) > (2,1)" $ Right typeBool+>      ,e "(1,2) < (2,1)" $ Right typeBool+>      ]+>  where+>    e = Expr
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/SelectFrom.lhs view
@@ -0,0 +1,77 @@++> module Database.HsSqlPpp.Tests.TypeChecking.SelectFrom+>     (tcSelectFromTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types+>+> import Database.HsSqlPpp.Catalog++> tcSelectFromTestData :: Item+> tcSelectFromTestData =+>   Group "selects from" [+>   Group "simple selects from" [+>       s "select a from (select 1 as a, 2 as b) x;"+>         $ Right [Just ([], [("a", typeInt)])]+>      ,s "select b from (select 1 as a, 2 as b) x;"+>         $ Right [Just ([], [("b", typeInt)])]+>      ,s "select c from (select 1 as a, 2 as b) x;"+>         $ Left [UnrecognisedIdentifier "c"]+>      ,s "select typlen from pg_type;"+>         $ Right [Just ([], [("typlen", typeSmallInt)])]+>      ,s "select oid from pg_type;"+>         $ Right [Just ([], [("oid", ScalarType "oid")])]+>      ,s "select p.oid from pg_type p;"+>         $ Right [Just ([], [("oid", ScalarType "oid")])]+>      ,s "select typlen from nope;"+>         $ Left [UnrecognisedRelation "nope"]+>      ,s "select generate_series from generate_series(1,7);"+>         $ Right [Just ([], [("generate_series", typeInt)])]+>+>      -- check aliasing+>      ,s "select generate_series.generate_series from generate_series(1,7);"+>         $ Right [Just ([], [("generate_series", typeInt)])]+>      ,s "select g from generate_series(1,7) g;"+>         $ Right [Just ([], [("g", typeInt)])]+>      ,s "select g.g from generate_series(1,7) g;"+>         $ Right [Just ([], [("g", typeInt)])]+>      ,s "select generate_series.g from generate_series(1,7) g;"+>         $ Left [UnrecognisedCorrelationName "generate_series"]+>      ,s "select g.generate_series from generate_series(1,7) g;"+>         $ Left [UnrecognisedIdentifier "generate_series"]+>+>      ,s "select * from pg_attrdef;"+>         $ Right [Just ([],+>          [("adrelid",ScalarType "oid")+>          ,("adnum",ScalarType "int2")+>          ,("adbin",ScalarType "pg_node_tree")+>          ,("adsrc",ScalarType "text")])]+>      ,s "select abs from abs(3);"+>         $ Right [Just ([], [("abs", typeInt)])]+>         --todo: these are both valid,+>         --the second one means select 3+generate_series from generate_series(1,7)+>         --  select generate_series(1,7);+>         -- select 3 + generate_series(1,7);+>      ]++>   ,Group "simple selects from 2" [+>       -- fixme: needs compfuntref?+>       {-c "select a,b from testfunc();"+>         [CatCreateComposite "testType" [("a", ScalarType "text")+>                                        ,("b", typeInt)+>                                        ,("c", typeInt)]+>         ,CatCreateFunction FunName "testfunc" []+>          (SetOfType $ NamedCompositeType "testType") False]+>         $ Right [Just ([],+>                  [("a",ScalarType "text"),("b",ScalarType "int4")])]+>+>      ,-}c "select testfunc();"+>         [CatCreateFunction FunName "testfunc" [] (Pseudo Void) False]+>         $ Right [Just ([], [])]+>      ]+>   ]++>  where+>    s = StmtType+>    c = CatStmtType
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/SimpleExpressions.lhs view
@@ -0,0 +1,73 @@++> module Database.HsSqlPpp.Tests.TypeChecking.SimpleExpressions+>     (tcSimpleExpressionTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types+>+>+> tcSimpleExpressionTestData :: Item+> tcSimpleExpressionTestData =+>    Group "simple expressions" [+>       e "1=1" $ Right typeBool+>      ,e "1=true" $ Left [NoMatchingOperator "=" [typeInt,typeBool]]+>      ,e "substring('aqbc' from 2 for 2)" $ Right (ScalarType "text")+>+>      ,e "substring(3 from 2 for 2)" $ Left+>                                      [NoMatchingOperator "!substring"+>                                       [ScalarType "int4"+>                                       ,ScalarType "int4"+>                                       ,ScalarType "int4"]]+>      ,e "substring('aqbc' from 2 for true)" $ Left+>                     [NoMatchingOperator "!substring"+>                      [UnknownType+>                      ,ScalarType "int4"+>                      ,ScalarType "bool"]]+>+>      ,e "3 between 2 and 4" $ Right typeBool+>      ,e "3 between true and 4" $ Left+>                                [IncompatibleTypeSet [ScalarType "int4"+>                                                     ,ScalarType "bool"+>                                                     ,ScalarType "int4"]]+>+>      ,e "array[1,2,3][2]" $ Right typeInt+>      ,e "array['a','b'][1]" $ Right UnknownType+>      ,e "array['a'::text,'b'][1]" $ Right (ScalarType "text")+>         -- FIXME?+>      {-,p "array['a','b'][true]" (TypeError ("",0,0)+>                                   (WrongType+>                                    typeInt+>                                    UnknownType))-}+>      ,e "not true" $ Right typeBool+>      ,e "not 1" $ Left+>                  [NoMatchingOperator "!not" [typeInt]]+>+>      ,e "@ 3" $ Right typeInt+>      ,e "@ true" $ Left+>                  [NoMatchingOperator "@" [ScalarType "bool"]]+>+>      ,e "-3" $ Right typeInt+>      ,e "-'a'" $ Left+>                  [NoMatchingOperator "-" [UnknownType]]+>+>      ,e "4-3" $ Right typeInt+>+>      ,e "1 is null" $ Right typeBool+>      ,e "1 is not null" $ Right typeBool+>+>      ,e "1+1" $ Right typeInt+>      ,e "1+1" $ Right typeInt+>      ,e "31*511" $ Right typeInt+>      ,e "5/2" $ Right typeInt+>      ,e "2^10" $ Right typeFloat8+>      ,e "17%5" $ Right typeInt+>      ,e "3 and 4" $ Left+>                   [NoMatchingOperator "!and" [typeInt,typeInt]]+>      ,e "True and False" $ Right typeBool+>      ,e "false or true" $ Right typeBool+>      ,e "lower('TEST')" $ Right (ScalarType "text")+>      ,e "lower(1)" $ Left [NoMatchingOperator "lower" [typeInt]]+>      ]+>  where+>    e = Expr
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/SimpleSelects.lhs view
@@ -0,0 +1,44 @@++> module Database.HsSqlPpp.Tests.TypeChecking.SimpleSelects+>     (tcSimpleSelectsTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types+>+>+> tcSimpleSelectsTestData :: Item+> tcSimpleSelectsTestData =+>   Group "simple selects" [+>       s "select 1;" $ Right [Just ([], [("?column?", typeInt)])]+>      ,s "select 1 as a;" $+>         Right [Just ([], [("a", typeInt)])]+>      ,s "select 1,2;" $+>         Right [Just ([], [("?column?", typeInt)+>                                                 ,("?column?", typeInt)])]+>      ,s "select 1 as a, 2 as b;" $+>         Right [Just ([], [("a", typeInt)+>                                                 ,("b", typeInt)])]+>      ,s "select 1+2 as a, 'a' || 'b';" $+>         Right [Just ([], [("a", typeInt)+>                                        ,("?column?", ScalarType "text")])]+>      ,s "values (1,2);" $ Right [Just ([],+>                                           [("column1", typeInt)+>                                           ,("column2", typeInt)])]+>      ,s "values (1,2),('3', '4');" $ Right [Just ([],+>                                                      [("column1", typeInt)+>                                                      ,("column2", typeInt)])]+>      ,s "values (1,2),('a', true);" $ Left [IncompatibleTypeSet [typeInt+>                                                                 ,typeBool]]+>      ,s "values ('3', '4'),(1,2);" $ Right [Just ([],+>                                                      [("column1", typeInt)+>                                                      ,("column2", typeInt)])]+>      ,s "values ('a', true),(1,2);" $ Left [IncompatibleTypeSet [typeBool+>                                                                 ,typeInt]]+>      ,s "values ('a'::text, '2'::int2),('1','2');" $ Right [Just ([],+>                                      [("column1", ScalarType "text")+>                                      ,("column2", typeSmallInt)])]+>      ,s "values (1,2,3),(1,2);" $ Left [ValuesListsMustBeSameLength]+>      ]+>  where+>    s = StmtType
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/SpecialFunctions.lhs view
@@ -0,0 +1,32 @@++> module Database.HsSqlPpp.Tests.TypeChecking.SpecialFunctions+>     (tcSpecialFunctionsTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types+>+>+> tcSpecialFunctionsTestData :: Item+> tcSpecialFunctionsTestData =+>   Group "special functions" [+>       e "coalesce(null,1,2,null)" $ Right typeInt+>      ,e "coalesce('3',1,2,null)" $ Right typeInt+>      ,e "coalesce('3',1,true,null)"+>             $ Left [NoMatchingOperator "coalesce" [UnknownType+>                                                   ,ScalarType "int4"+>                                                   ,ScalarType "bool"+>                                                   ,UnknownType]]+>      ,e "nullif('hello','hello')" $ Right UnknownType+>      ,e "nullif('hello'::text,'hello')" $ Right (ScalarType "text")+>      ,e "nullif(3,4)" $ Right typeInt+>      ,e "nullif(true,3)"+>             $ Left [NoMatchingOperator "nullif" [ScalarType "bool"+>                                           ,ScalarType "int4"]]+>      ,e "greatest(3,5,6,4,3)" $ Right typeInt+>      ,e "least(3,5,6,4,3)" $ Right typeInt+>      ,e "least(5,true)"+>             $ Left [NoMatchingOperator "least" [ScalarType "int4",ScalarType "bool"]]+>      ]+>  where+>    e = Expr
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/TableRefTests.lhs view
@@ -0,0 +1,136 @@+Test the type checking and errors within tablerefs+and test the produced simple select lists++> module Database.HsSqlPpp.Tests.TypeChecking.TableRefTests+>     (tableRefTests+>     --,tableRefTestData+>     --,Item(..)+>     ) where+>+> import Test.HUnit+> import Test.Framework+> import Test.Framework.Providers.HUnit+> --import Data.List+> import Data.Generics.Uniplate.Data+> import Control.Monad+> import Text.Groom+>+> --import Database.HsSqlPpp.Utils.Here+> import Database.HsSqlPpp.Parser+> import Database.HsSqlPpp.TypeChecker+> import Database.HsSqlPpp.Annotation+> import Database.HsSqlPpp.Catalog+> import Database.HsSqlPpp.Types+> --import Database.HsSqlPpp.Utils.PPExpr+> --import Database.HsSqlPpp.Tests.TestUtils+> import Database.HsSqlPpp.Pretty+>+> data Item = Group String [Item]+>           | Query [CatalogUpdate] String (Either [TypeError] Type)+>+> tableRefTests :: Test.Framework.Test+> tableRefTests = itemToTft tableRefTestData+>+> tableRefTestData :: Item+> tableRefTestData = Group "tableRefs"+>   [Query db1 "select * from t;"+>      $ Right $ SetOfType $ CompositeType+>         [("a",typeInt)+>         ,("b",typeInt)]+>   ,Query db1 "select a,b from t;"+>      $ Right $ SetOfType $ CompositeType+>         [("a",typeInt)+>         ,("b",typeInt)]+>   ,Query db1 "select t.* from t;"+>      $ Right $ SetOfType $ CompositeType+>         [("a",typeInt)+>         ,("b",typeInt)]+>   {-,Query db1 "select u.* from t;"+>      $ Left [UnrecognisedCorrelationName "u"]-}+>   ,Query db1 "select * from t u;"+>      $ Right $ SetOfType $ CompositeType+>         [("a",typeInt)+>         ,("b",typeInt)]+>   ,Query db1 "select * from t u(c,d);"+>      $ Right $ SetOfType $ CompositeType+>         [("c",typeInt)+>         ,("d",typeInt)]+>   ,Query db1 "select u.* from t u(c,d);"+>      $ Right $ SetOfType $ CompositeType+>         [("c",typeInt)+>         ,("d",typeInt)]+>   ,Query db1 "select c,d from t u(c,d);"+>      $ Right $ SetOfType $ CompositeType+>         [("c",typeInt)+>         ,("d",typeInt)]+>   {-,Query db1 "select t.* from t u;"+>      $ Left [UnrecognisedCorrelationName "t"]-}+>   -- FIXME: disabled because the error comes out twice, and I can't work out why+>   -- this problem occurs in the uuagc code so it is probably the ag code which is wrong+>   {-,Query db1 "select * from t u(a);"+>      $ Left [WrongNumberOfAliasCols 2 1]-}+>   ,Query db1 "select c from t;"+>      $ Left [UnrecognisedIdentifier "c"]+>   ,Query db1 "select a from t u(c,d);"+>      $ Left [UnrecognisedIdentifier "a"]+>   ,Query db1 "select * from non;"+>      $ Left [UnrecognisedRelation "non"]+>   ,Query db1 "select a,b,d from t,u where a=c;"+>      $ Right $ SetOfType $ CompositeType+>         [("a",typeInt)+>         ,("b",typeInt)+>         ,("d",typeInt)]+>   ]++table ref tests:++columns in:+tref, subtref, funtref+jointref: aliased, unaliased, 3 way++select lists:+simple, qualified, *, q.*+++errors:+unrecognised id+ambiguous id+incompatible join columns+unrecognised relation+missing join attribute+++++> db1 :: [CatalogUpdate]+> db1 = [CatCreateTable "t" [("a",typeInt)+>                           ,("b", typeInt)] []+>       ,CatCreateTable "u" [("c",typeInt)+>                           ,("d", typeInt)] []+>       ,CatCreateTable "v" [("v",typeInt)] []]++> itemToTft :: Item -> Test.Framework.Test+> itemToTft (Group s is) = testGroup s $ map itemToTft is+> itemToTft (Query eu sql t) = testCase ("typecheck " ++ sql) $ do+>   let ast = case parseQueryExpr "" sql of+>               Left e -> error $ show e+>               Right l -> l+>       aast = typeCheckQueryExpr cat ast+>       ty = atype $ getAnnotation aast+>       er :: [TypeError]+>       er = universeBi aast+>       res = if null er+>             then case ty of+>                    Nothing -> Left []+>                    Just ty' -> Right ty'+>             else Left er+>   when (t /= res) $ putStrLn $ "bad sql: " ++ printQueryExpr aast+>        ++ "\n" ++ groom aast+>   assertEqual "" t res+>   where+>     cat = case updateCatalog defaultTemplate1Catalog eu of+>                         Left x -> error $ show x+>                         Right e -> e+++
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/TpchTests.lhs view
@@ -0,0 +1,168 @@++Tests using the tpch queries. Just tests the result type at the+moment.++> module Database.HsSqlPpp.Tests.TypeChecking.TpchTests+>     (tpchTests) where+>+> import Test.HUnit+> import Test.Framework+> import Test.Framework.Providers.HUnit+> --import Data.List+> import Data.Generics.Uniplate.Data+> import Control.Monad+> --import Text.Groom+>+> --import Database.HsSqlPpp.Utils.Here+> import Database.HsSqlPpp.Parser+> import Database.HsSqlPpp.TypeChecker+> import Database.HsSqlPpp.Annotation+> import Database.HsSqlPpp.Catalog+> import Database.HsSqlPpp.Types+> --import Database.HsSqlPpp.Utils.PPExpr+> --import Database.HsSqlPpp.Tests.TestUtils+> import Database.HsSqlPpp.Pretty+> import Database.HsSqlPpp.Tests.TpchData+>+> data Item = Group String [Item]+>           | Query String String Type+>+> tpchTests :: Test.Framework.Test+> tpchTests = itemToTft tpchTestData+>+> tpchTestData :: Item+> tpchTestData =+>   Group "tpch" $+>         -- FIXME: 15 has with expression which doesn't quite work atm+>         -- (todo with fixup identifiers I think+>         let (s,e) = splitAt 14 t+>         in s ++ drop 1 e+>   where+>     t = zipWith (\(n,s) t' ->  Query n s (SetOfType $ CompositeType t'))+>          tpchQueries+>          [-- q1+>           [("l_returnflag", typeChar)+>           ,("l_linestatus", typeChar)+>           ,("sum_qty", typeNumeric)+>           ,("sum_base_price", typeNumeric)+>           ,("sum_disc_price", typeNumeric)+>           ,("sum_charge", typeNumeric)+>           ,("avg_qty", typeNumeric)+>           ,("avg_price", typeNumeric)+>           ,("avg_disc", typeNumeric)+>           ,("count_order", typeBigInt)]+>          ,--q2+>           [("s_acctbal", typeNumeric)+>           ,("s_name", typeChar)+>           ,("n_name", typeChar)+>           ,("p_partkey", typeInt)+>           ,("p_mfgr", typeChar)+>           ,("s_address", typeVarChar)+>           ,("s_phone", typeChar)+>           ,("s_comment", typeVarChar)]+>          ,--q3+>           [("l_orderkey", typeInt)+>           ,("revenue", typeNumeric)+>           ,("o_orderdate", typeDate)+>           ,("o_shippriority", typeInt)]+>          ,--q4+>           [("o_orderpriority", typeChar)+>           ,("order_count", typeBigInt)]+>          ,--q5+>           [("n_name", typeChar)+>           ,("revenue", typeNumeric)]+>          ,--q6+>           [("revenue", typeNumeric)]+>          ,--q7+>           [("supp_nation", typeChar)+>           ,("cust_nation", typeChar)+>           ,("l_year", typeFloat8)+>           ,("revenue", typeNumeric)]+>          ,--q8+>           [("o_year", typeFloat8)+>           ,("mkt_share", typeNumeric)]+>          ,--q9+>           [("nation", typeChar)+>           ,("o_year", typeFloat8)+>           ,("sum_profit", typeNumeric)]+>          ,--q10+>           [("c_custkey",typeInt)+>           ,("c_name", typeChar)+>           ,("revenue", typeNumeric)+>           ,("c_acctbal", typeNumeric)+>           ,("n_name", typeChar)+>           ,("c_address", typeVarChar)+>           ,("c_phone", typeChar)+>           ,("c_comment", typeVarChar)]+>          ,--q11+>           [("ps_partkey", typeInt)+>           ,("value", typeNumeric)]+>          ,--q12+>           [("l_shipmode", typeChar)+>           ,("high_line_count", typeBigInt)+>           ,("low_line_count", typeBigInt)]+>          ,--q13+>           [("c_count", typeBigInt)+>           ,("custdist", typeBigInt)]+>          ,--q14+>           [("promo_revenue", typeNumeric)]+>          ,--q15+>           [("s_suppkey", typeInt)+>           ,("s_name", typeChar)+>           ,("s_address", typeVarChar)+>           ,("s_phone", typeChar)+>           ,("total_revenue", typeNumeric)]+>          ,--q16+>           [("p_brand", typeChar)+>           ,("p_type", typeVarChar)+>           ,("p_size", typeInt)+>           ,("supplier_cnt", typeBigInt)]+>          ,--q17+>           [("avg_yearly", typeNumeric)]+>          ,--q18+>           [("c_name", typeChar)+>           ,("c_custkey", typeInt)+>           ,("o_orderkey", typeInt)+>           ,("o_orderdate", typeDate)+>           ,("o_totalprice", typeNumeric)+>           ,("sum", typeNumeric)]+>          ,--q19+>           [("revenue", typeNumeric)]+>          ,--q20+>           [("s_name", typeChar)+>           ,("s_address", typeVarChar)]+>          ,--q21+>           [("s_name", typeChar)+>           ,("numwait", typeBigInt)]+>          ,--q22+>           [("cntrycode", ScalarType "char")+>           ,("numcust", typeBigInt)+>           ,("totacctbal", typeNumeric)]+>          ]++> itemToTft :: Item -> Test.Framework.Test+> itemToTft (Group s is) = testGroup s $ map itemToTft is+> itemToTft (Query n sql t) = testCase ("typecheck tpch " ++ n ++ ":") $ do+>   let ast = case parseQueryExpr "" sql of+>               Left e -> error $ show e+>               Right l -> l+>       aast = typeCheckQueryExpr cat ast+>       ty = atype $ getAnnotation aast+>       er :: [TypeError]+>       er = universeBi aast+>       res = if null er+>             then case ty of+>                    Nothing -> Left []+>                    Just ty' -> Right ty'+>             else Left er+>       ok = Right t == res+>   unless ok $ putStrLn $ "bad sql: " ++ printQueryExpr aast+>        -- ++ "\n" ++ groom aast+>   assertBool "" ok+>   where+>     cat = case updateCatalog defaultTemplate1Catalog tpchCatalog of+>                         Left x -> error $ show x+>                         Right e -> e+++
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/Triggers.lhs view
@@ -0,0 +1,94 @@++Set of tests to check the type checking code. Includes tests for the+errors for sql which doesn't type check.++> module Database.HsSqlPpp.Tests.TypeChecking.Triggers+>     (tcTriggersTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> --import Database.HsSqlPpp.Types+>+> --import Database.HsSqlPpp.Catalog++--------------------------------------------------------------------------------+++> tcTriggersTestData :: Item+> tcTriggersTestData = --fixme+>   Group "triggers" [+>       {-d [$here|+>          create table t1 (+>            a int,+>            b int,+>            c text+>          );+>          create table t2 (+>            a int,+>            b int,+>            c int+>          );+>          create function trig_fn() returns trigger as $a$+>          begin+>            if (NEW.a > 100) or (OLD.b < 5) then+>                raise exception 'no good';+>            end if;+>            return NEW;+>          end;+>          $a$ language plpgsql volatile;+>          create trigger trig+>            after update on t1+>            for each row+>            execute procedure check_relvar_update();+>          create trigger trig+>            after update on t2+>            for each row+>            execute procedure check_relvar_update();+>          |]+>       [CatCreateTable "t1" [("a",ScalarType "int4")+>                            ,("b",ScalarType "int4")+>                            ,("c",ScalarType "text")]+>                            [("tableoid",ScalarType "oid")+>                            ,("cmax",ScalarType "cid")+>                            ,("xmax",ScalarType "xid")+>                            ,("cmin",ScalarType "cid")+>                            ,("xmin",ScalarType "xid")+>                            ,("ctid",ScalarType "tid")]+>       ,CatCreateTable "t2" [("a",ScalarType "int4")+>                            ,("b",ScalarType "int4")+>                            ,("c",ScalarType "int4")]+>                            [("tableoid",ScalarType "oid")+>                            ,("cmax",ScalarType "cid")+>                            ,("xmax",ScalarType "xid")+>                            ,("cmin",ScalarType "cid")+>                            ,("xmin",ScalarType "xid")+>                            ,("ctid",ScalarType "tid")]+>       ,CatCreateFunction FunName "trig_fn" [] (Pseudo Trigger) False]-}+>      {-,s [$here|+>          create table t1 (+>            a int,+>            b int,+>            c text+>          );+>          create function trig_fn() returns trigger as $a$+>          begin+>            if NEW.d = 'bad value' then+>              return NEW;+>                raise exception 'no good';+>            end if;+>          end;+>          $a$ language plpgsql volatile;+>          create trigger trig+>            after update on t1+>            for each row+>            execute procedure check_relvar_update();+>          |]+>         $ Left []-}+>      ]++>  where+>    --e = Expr+>    --s = StmtType+>    --c = CatStmtType+>    --d = Ddl+
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/TypeCheckTests.lhs view
@@ -0,0 +1,115 @@++> module Database.HsSqlPpp.Tests.TypeChecking.TypeCheckTests+>     (typeCheckTests+>     ,typeCheckTestData+>     ,Item(..)) where++> import Test.Framework+++> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Tests.TypeChecking.TableRefTests+> import Database.HsSqlPpp.Tests.TypeChecking.TpchTests+> import Database.HsSqlPpp.Tests.TypeChecking.TypeInferenceTests+> import Database.HsSqlPpp.Tests.TypeChecking.Literals+> import Database.HsSqlPpp.Tests.TypeChecking.SimpleExpressions+> import Database.HsSqlPpp.Tests.TypeChecking.SpecialFunctions+> import Database.HsSqlPpp.Tests.TypeChecking.RowCtors+> import Database.HsSqlPpp.Tests.TypeChecking.CaseExpressions+> import Database.HsSqlPpp.Tests.TypeChecking.MiscExpressions+> import Database.HsSqlPpp.Tests.TypeChecking.SimpleSelects+> import Database.HsSqlPpp.Tests.TypeChecking.CombineSelects+> import Database.HsSqlPpp.Tests.TypeChecking.SelectFrom+> import Database.HsSqlPpp.Tests.TypeChecking.Joins+> import Database.HsSqlPpp.Tests.TypeChecking.Qualification+> import Database.HsSqlPpp.Tests.TypeChecking.MiscSelects+> import Database.HsSqlPpp.Tests.TypeChecking.Insert+> import Database.HsSqlPpp.Tests.TypeChecking.Update+> import Database.HsSqlPpp.Tests.TypeChecking.Delete+> import Database.HsSqlPpp.Tests.TypeChecking.Creates+> import Database.HsSqlPpp.Tests.TypeChecking.Plpgsql+> import Database.HsSqlPpp.Tests.TypeChecking.CatalogChaining+> import Database.HsSqlPpp.Tests.TypeChecking.Into+> import Database.HsSqlPpp.Tests.TypeChecking.Drops+> import Database.HsSqlPpp.Tests.TypeChecking.Triggers+> import Database.HsSqlPpp.Tests.TypeChecking.Misc++> typeCheckTestData :: Item+> typeCheckTestData = Group "typeCheckTests" typeCheckTestList++> typeCheckTestList :: [Item]+> typeCheckTestList = [tcLiteralTestData+>                     ,tcSimpleExpressionTestData+>                     ,tcSpecialFunctionsTestData+>                     ,tcRowCtorsTestData+>                     ,caseExpressionsTestData+>                     ,miscExpressionsTestData+>                     ,tcSimpleSelectsTestData+>                     ,tcCombineSelectsTestData+>                     ,tcSelectFromTestData+>                     ,tcJoinsTestData+>                     ,tcQualificationTestData+>                     ,tcMiscSelectTestData+>                     ,tcInsertTestData+>                     ,tcUpdateTestData+>                     ,tcDeleteTestData+>                     ,tcCreateTestData+>                     ,tcPlpgsqlTestData+>                     ,tcCatalogChainingTestData+>                     ,tcIntoTestData+>                     ,tcDropsTestData+>                     ,tcTriggersTestData+>                     ,tcMiscTestData]++todo:++--------------------------------------------------------------------------------++~~~~+test some casts+assign composite to record+  then assign record to composite+assign row to composite+ : check wrong cols, wrong types+check read and write fields in composite->record+check read and write fields in composite+check domain <-> base assigns+check call function with compatible composite, compatible row ctor+assign comp to comp++todo for chaos sql+for loop var = scalar, select = setof composite with one scalar++select into+composite assignment and equality+autocast from rowctor to composite when calling function+assignment to composite fields+read fields of composite++array_contains -> match anyelement+createtable as cat update+window functions+assign domain <-> base+sql function not working+~~~~+++~~~~+check insert returning, update returning, delete returning, one check each+check select into: multiple vars, record (then access fields to check),+  composite var+check errors: select into wrong number of vars, wrong types, and into+  composite wrong number and wrong type+~~~~+++++> typeCheckTests :: Test.Framework.Test+> typeCheckTests =+>   testGroup "typeChecking" $+>                 [tableRefTests+>                 ,tpchTests+>                 ,typeInferenceTests]+>                 ++ map itemToTft typeCheckTestList
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/TypeInferenceTests.lhs view
@@ -0,0 +1,66 @@++> {-# LANGUAGE QuasiQuotes #-}+> module Database.HsSqlPpp.Tests.TypeChecking.TypeInferenceTests (typeInferenceTests) where++> import Test.HUnit+> import Test.Framework+> import Test.Framework.Providers.HUnit+> --import Data.List+> import Data.Generics.Uniplate.Data++> --import Debug.Trace+>+> --import Database.HsSqlPpp.Utils.Here+> --import Database.HsSqlPpp.Parser+> import Database.HsSqlPpp.TypeChecker+> import Database.HsSqlPpp.Annotation+> import Database.HsSqlPpp.Catalog+> import Database.HsSqlPpp.Types+> import Database.HsSqlPpp.Quote+> import Database.HsSqlPpp.Ast+> import Database.HsSqlPpp.Pretty++> data Item = Expr ScalarExpr [Maybe Type]+>           | Group String [Item]++> typeInferenceTests :: Test.Framework.Test+> typeInferenceTests = itemToTft typeInferenceTestData+>+> typeInferenceTestData :: Item+> typeInferenceTestData =+>   Group "typeInferenceTests" [+>     e [sqlExpr| 1 = '2'|] [Just typeBool+>                           ,Just typeInt+>                           ,Just typeInt]+>    ,e [sqlExpr| (3,4) = ('2','3')|] [Just typeBool+>                                     ,Just $ AnonymousRecordType [typeInt,typeInt]+>                                     ,Just typeInt+>                                     ,Just typeInt+>                                     ,Just $ AnonymousRecordType [typeInt,typeInt]+>                                     ,Just typeInt+>                                     ,Just typeInt]+>    ,e [sqlExpr| ('2','3') = (3,4)|] [Just typeBool+>                                     ,Just $ AnonymousRecordType [typeInt,typeInt]+>                                     ,Just typeInt+>                                     ,Just typeInt+>                                     ,Just $ AnonymousRecordType [typeInt,typeInt]+>                                     ,Just typeInt+>                                     ,Just typeInt]+>    ,e [sqlExpr| ('2',3) = (3,'4')|] [Just typeBool+>                                     ,Just $ AnonymousRecordType [typeInt,typeInt]+>                                     ,Just typeInt+>                                     ,Just typeInt+>                                     ,Just $ AnonymousRecordType [typeInt,typeInt]+>                                     ,Just typeInt+>                                     ,Just typeInt]+>   ]+>   where+>     e = Expr++> itemToTft :: Item -> Test.Framework.Test+> itemToTft (Group s is) = testGroup s $ map itemToTft is++> itemToTft (Expr e t) = testCase (printScalarExpr e) $+>     let a = typeCheckScalarExpr defaultTemplate1Catalog e+>         t1 = filter (/= Nothing) [infType el | el <- universeBi a]+>     in assertEqual "" t t1
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/Update.lhs view
@@ -0,0 +1,48 @@++> module Database.HsSqlPpp.Tests.TypeChecking.Update+>     (tcUpdateTestData) where+>+> import Database.HsSqlPpp.Tests.TypeChecking.Utils++> import Database.HsSqlPpp.Types++> tcUpdateTestData :: Item+> tcUpdateTestData =+>   Group "update" [+>       s "update nope set a = 1;"+>         $ Left [UnrecognisedRelation "nope"]+>      ,s "update pg_attrdef set adsrc = '' where 1;"+>         $ Left [ExpressionMustBeBool]+>      ,s "update pg_attrdef set (adbin,adsrc) = ('a','b','c');"+>         $ Left [IncompatibleTypes+>                 (AnonymousRecordType [ScalarType "pg_node_tree"+>                                      ,ScalarType "text"])+>                 (AnonymousRecordType [UnknownType+>                                      ,UnknownType+>                                      ,UnknownType])]+>      ,s "update pg_attrdef set (adrelid,adsrc) = (true,'b');"+>         $ Left [IncompatibleTypes+>                 (AnonymousRecordType [ScalarType "oid"+>                                      ,ScalarType "text"])+>                 (AnonymousRecordType [ScalarType "bool"+>                                      ,UnknownType])]+>      ,s "update pg_attrdef set (shmadrelid,adsrc) = ('a','b');"+>         $ Left [UnrecognisedIdentifier "shmadrelid"]+>      ,s "update pg_attrdef set adsrc='';"+>         $ Right [Just ([], [])]+>      ,s "update pg_attrdef set adsrc='' where 1=2;"+>         $ Right [Just ([], [])]+>           -- FIXME?+>       -- TODO: actually, pg doesn't support this so need to generate error instead+>      {-,s "update pg_attrdef set (adbin,adsrc) = ((select 'a','b'));"+>         $ Right [Just ([], [])]-}+>      --check where ids+>      ,s "update pg_attrdef set adsrc='' where adsrc='';"+>         $ Right [Just ([], [])]+>      ,s "update pg_attrdef set adnum = adnum + 1;"+>         $ Right [Just ([], [])]+>      ]++>  where+>    s = StmtType+
+ src-extra/tests/Database/HsSqlPpp/Tests/TypeChecking/Utils.lhs view
@@ -0,0 +1,94 @@++> module Database.HsSqlPpp.Tests.TypeChecking.Utils where++> import Test.Framework+++> import Test.HUnit+> import Test.Framework.Providers.HUnit+> import Data.List+> import Data.Generics.Uniplate.Data+> import Database.HsSqlPpp.Parser+> import Database.HsSqlPpp.TypeChecker+> import Database.HsSqlPpp.Annotation+> import Database.HsSqlPpp.Catalog+> import Database.HsSqlPpp.Types+> import Database.HsSqlPpp.Pretty+> --import Text.Groom+> import Database.HsSqlPpp.Tests.TestUtils+++> data Item = Group String [Item]+>           | Expr String (Either [TypeError] Type)+>           | StmtType String (Either [TypeError] [Maybe ParameterizedStatementType])+>           | CatStmtType String [CatalogUpdate] (Either [TypeError] [Maybe ParameterizedStatementType])+>           | Ddl String [CatalogUpdate]+++> testExpressionType :: String -> Either [TypeError] Type -> Test.Framework.Test+> testExpressionType src et = testCase ("typecheck " ++ src) $+>   let ast = case parseScalarExpr "" src of+>                                      Left e -> error $ show e+>                                      Right l -> l+>       aast = typeCheckScalarExpr defaultTemplate1Catalog ast+>       ty = atype $ getAnnotation aast+>       er :: [TypeError]+>       er = universeBi aast+>   in if null er+>      then assertEqual ("typecheck " ++ src) (Just et) $ fmap Right ty+>      else assertEqual ("typecheck " ++ src) et $ Left er+>+> testStatementType :: String -> Either [TypeError] [Maybe ParameterizedStatementType] -> Test.Framework.Test+> testStatementType src sis = testCase ("typecheck " ++ src) $+>   let ast = case parseStatements "" src of+>                               Left e -> error $ show e+>                               Right l -> l+>       aast = snd $ typeCheckStatements defaultTemplate1Catalog ast+>       is = map (stType . getAnnotation) aast+>       er :: [TypeError]+>       er = universeBi aast+>   in case (length er, length is) of+>        (0,0) -> assertFailure "didn't get any infos?"+>        (0,_) -> assertTrace (printStatements aast) ("typecheck " ++ src) sis $ Right is+>        _ -> assertTrace (printStatements aast) ("typecheck " ++ src) sis $ Left er++> testCatUpStatementType :: String+>                        -> [CatalogUpdate]+>                        -> Either [TypeError] [Maybe ParameterizedStatementType]+>                        -> Test.Framework.Test+> testCatUpStatementType src eu sis = testCase ("typecheck " ++ src) $+>   let ast = case parseStatements "" src of+>                               Left e -> error $ show e+>                               Right l -> l+>       aast = snd $ typeCheckStatements makeCat ast+>       is = map (stType . getAnnotation) aast+>       er :: [TypeError]+>       er = universeBi aast+>   in {-trace (show aast) $-} case (length er, length is) of+>        (0,0) -> assertFailure "didn't get any infos?"+>        (0,_) -> assertTrace (printStatements aast) ("typecheck " ++ src) sis $ Right is+>        _ -> assertTrace (printStatements aast) ("typecheck " ++ src) sis $ Left er+>   where+>     makeCat = case updateCatalog defaultTemplate1Catalog eu of+>                         Left x -> error $ show x+>                         Right e -> e+>+> testCat :: String -> [CatalogUpdate] -> Test.Framework.Test+> testCat src eu = testCase ("check catalog: " ++ src) $+>   let ast = case parseStatements "" src of+>                               Left e -> error $ show e+>                               Right l -> l+>       (ncat,aast) = typeCheckStatements defaultTemplate1Catalog ast+>       er :: [TypeError]+>       er = universeBi aast+>       neu = deconstructCatalog ncat \\ deconstructCatalog defaultTemplate1Catalog+>   in if not (null er)+>        then assertFailure $ show er+>        else assertEqual "check eus" eu neu+>+> itemToTft :: Item -> Test.Framework.Test+> itemToTft (Expr s r) = testExpressionType s r+> itemToTft (StmtType s r) = testStatementType s r+> itemToTft (CatStmtType s c r) = testCatUpStatementType s c r+> itemToTft (Ddl s c) = testCat s c+> itemToTft (Group s is) = testGroup s $ map itemToTft is
+ src-extra/tests/Tests.lhs view
@@ -0,0 +1,28 @@+test files todo:++create new test hierarchy, move test code here, add new exe to run+  them++disable failing tests++get website generating again++start new test pages + renderer+++extensions tests++local bindings tests++parameterized statement tests+parsertests+quasiquote tests+roundtrip tests+type check tests+type inference tests++> import Database.HsSqlPpp.Tests.Tests+> import Test.Framework++> main :: IO ()+> main = defaultMain allTests
+ src-extra/util/Database/HsSqlPpp/Utils/CatalogReader.lhs view
@@ -0,0 +1,333 @@++This module contains the code to read a set of catalog updates+from a database.++The code here hasn't been tidied up since the Catalog data type+was heavily changed so it's a bit messy.++> {-# LANGUAGE QuasiQuotes #-}+>+> module Database.HsSqlPpp.Utils.CatalogReader+>     (readCatalogFromDatabase) where+>+> import qualified Data.Map as M+> import Data.Maybe+> import Control.Applicative+> --import Debug.Trace+>+> --import Database.HsSqlPpp.Internals.TypeType+> --import Database.HsSqlPpp.Utils.Utils+> import Database.HsSqlPpp.Utils.Here+> --import Database.HsSqlPpp.Internals.Catalog.CatalogInternal+> import Database.HsSqlPpp.Utils.PgUtils+> import Database.HsSqlPpp.Catalog+> import Database.HsSqlPpp.Types+>+> -- | Creates an 'CatalogUpdate' list by reading the database given.+> -- To create an Catalog value from this, use+> --+> -- @+> -- cat <- readCatalogFromDatabase 'something'+> -- let newCat = updateCatalog defaultCatalog cat+> -- @+> readCatalogFromDatabase :: String -- ^ connection string of the database to read+>                             -> IO [CatalogUpdate]+> readCatalogFromDatabase cs = withConn cs $ \conn -> do+>    typeInfo <- selectRelation conn [here|++\begin{code}++select t.oid as oid,+       t.typtype,+       case nspname+         when 'public' then t.typname+         when 'pg_catalog' then t.typname+         else nspname || '.' || t.typname+       end as typname,+       t.typarray,+       coalesce(e.typtype,'0') as atyptype,+       e.oid as aoid,+       e.typname as atypname+  from pg_catalog.pg_type t+  left outer join pg_type e+    on t.typarray = e.oid+   inner join pg_namespace ns+      on t.typnamespace = ns.oid+         and ns.nspname in ('pg_catalog'+                           ,'public'+                           ,'information_schema')+  where /*pg_catalog.pg_type_is_visible(t.oid)+   and */not exists(select 1 from pg_catalog.pg_type el+                       where el.typarray = t.oid)+  order by t.typname;++\end{code}++>                |] []+>    let typeStuff = concatMap convTypeInfoRow typeInfo+>        typeAssoc = map (\(a,b,_) -> (a,b)) typeStuff+>        typeMap = M.fromList typeAssoc+>    cts <- map (\(nm:cat:pref:[]) ->+>                CatCreateScalar (ScalarType nm) cat ( read pref :: Bool)) <$>+>           selectRelation conn [here|++\begin{code}++select t.typname,typcategory,typispreferred+from pg_type t+   inner join pg_namespace ns+      on t.typnamespace = ns.oid+         and ns.nspname in ('pg_catalog', 'public', 'information_schema')+where t.typarray<>0 and+    typtype='b' /*and+    pg_catalog.pg_type_is_visible(t.oid)*/;++\end{code}++>                |] []+>    domainDefInfo <- selectRelation conn [here|++\begin{code}++select pg_type.oid, typbasetype+  from pg_type+  inner join pg_namespace ns+      on pg_type.typnamespace = ns.oid+         and ns.nspname in ('pg_catalog', 'public', 'information_schema')+ where typtype = 'd'+     /*and  pg_catalog.pg_type_is_visible(oid)*/;++\end{code}++>                |] []+>    let jlt k = fromJust $ M.lookup k typeMap+>    let domainDefs = map (\l -> (jlt (l!!0),  jlt (l!!1))) domainDefInfo+>    --let domainCasts = map (\(t,b) ->(t,b,ImplicitCastContext)) domainDefs+>    castInfo <- selectRelation conn+>                  "select castsource,casttarget,castcontext from pg_cast;" []+>    let casts =+>      {- domainCasts ++ -}+>          flip map castInfo+>               (\l -> (jlt (l!!0)+>                      ,jlt (l!!1)+>                      ,case (l!!2) of+>                                   "a" -> AssignmentCastContext+>                                   "i" -> ImplicitCastContext+>                                   "e" -> ExplicitCastContext+>                                   _ -> error $ "internal error: unknown \+>                                                \cast context " ++ (l!!2)))+>    operatorInfo <- selectRelation conn [here|++\begin{code}++select oprname,+       oprleft,+       oprright,+       oprresult+from pg_operator+      where not (oprleft <> 0 and oprright <> 0+         and oprname = '@') --hack for now+      order by oprname;++\end{code}++>                |] []+>    let getOps a b c [] = (a,b,c)+>        getOps pref post bin (l:ls) =+>          let bit = (\a -> (l!!0, a, jlt(l!!3)))+>          in case () of+>                   _ | l!!1 == "0"+>                         -> getOps (bit [jlt (l!!2)]:pref) post bin ls+>                     | l!!2 == "0"+>                         -> getOps pref (bit [jlt (l!!1)]:post) bin ls+>                     | otherwise -> getOps pref post (bit [jlt (l!!1)+>                                                          ,jlt (l!!2)]:bin) ls+>    let (prefixOps, postfixOps, binaryOps) = getOps [] [] [] operatorInfo+>    functionInfo <- selectRelation conn [here|++\begin{code}++select proname,+       array_to_string(proargtypes,','),+       proretset,+       prorettype+from pg_proc+where pg_catalog.pg_function_is_visible(pg_proc.oid)+      and provariadic = 0+      and not proisagg+      and not proiswindow+order by proname,proargtypes;+\end{code}++>                |] []+>    let fnProts = map (convFnRow jlt) functionInfo+>    aggregateInfo <- selectRelation conn [here|++\begin{code}++select proname,+       array_to_string(proargtypes,','),+       proretset,+       prorettype+from pg_proc+where pg_catalog.pg_function_is_visible(pg_proc.oid)+      and provariadic = 0+      and proisagg+order by proname,proargtypes;+\end{code}++>                |] []+>    let aggProts = map (convFnRow jlt) aggregateInfo+>    windowInfo <- selectRelation conn [here|++\begin{code}++select proname,+       array_to_string(proargtypes,','),+       proretset,+       prorettype+from pg_proc+where pg_catalog.pg_function_is_visible(pg_proc.oid)+      and provariadic = 0+      and proiswindow+order by proname,proargtypes;++\end{code}++>                |] []+>    let winProts = map (convFnRow jlt) windowInfo+>    comps <- map (\(kind:nm:atts:sysatts:nsp:[]) ->+>              let nm1 = case nsp of+>                                 "pg_catalog" -> nm+>                                 "public" -> nm+>                                 n -> n ++ "." ++ nm+>              in case kind of+>                     "c" -> CatCreateComposite nm1 (convertAttString jlt atts)+>                     "r" -> CatCreateTable nm1 (convertAttString jlt atts)+>                                               (convertAttString jlt sysatts)+>                     "v" -> CatCreateView nm1 (convertAttString jlt atts)+>                     _ -> error $ "unrecognised relkind: " ++ kind) <$>+>                 selectRelation conn [here|++\begin{code}++with att1 as (+ select+     attrelid,+     attname,+     attnum,+     atttypid+   from pg_attribute+   inner join pg_class cls+      on cls.oid = attrelid+   inner join pg_namespace ns+      on cls.relnamespace = ns.oid+         and ns.nspname in ('pg_catalog', 'public', 'information_schema')+   where /*pg_catalog.pg_table_is_visible(cls.oid)+      and*/ cls.relkind in ('r','v','c')+      and not attisdropped),+ sysAtt as (+ select attrelid,+     array_to_string(+       array_agg(attname || ';' || atttypid)+         over (partition by attrelid order by attnum+               range between unbounded preceding+               and unbounded following)+       ,',') as sysAtts+   from att1+   where attnum < 0),+ att as (+ select attrelid,+     array_to_string(+       array_agg(attname || ';' || atttypid)+          over (partition by attrelid order by attnum+                range between unbounded preceding+                and unbounded following)+       ,',') as atts+   from att1+   where attnum > 0)+ select distinct+     cls.relkind,+     cls.relname,+     atts,+     coalesce(sysAtts,''),+     nspname+   from att left outer join sysAtt using (attrelid)+   inner join pg_class cls+     on cls.oid = attrelid+   inner join pg_namespace ns+      on cls.relnamespace = ns.oid+   order by relkind,relname;++\end{code}++>                |] []+>    return+>      $ concat [cts+>               ,map (uncurry CatCreateDomain) domainDefs+>               ,map (\(a,b,c) -> CatCreateCast a b c) casts+>               ,map (\(a,b,c) ->+>                     CatCreateFunction FunPrefix a b c False) prefixOps+>               ,map (\(a,b,c) ->+>                     CatCreateFunction FunPostfix a b c False) postfixOps+>               ,map (\(a,b,c) ->+>                     CatCreateFunction FunBinary a b c False) binaryOps+>               ,map (\(a,b,c) ->+>                     CatCreateFunction FunName a b c False) fnProts+>               ,map (\(a,b,c) ->+>                     CatCreateFunction FunAgg a b c False) aggProts+>               ,map (\(a,b,c) ->+>                     CatCreateFunction FunWindow a b c False) winProts+>               ,comps]+>    where+>      convertAttString jlt s =+>          let ps = split ',' s+>              ps1 = map (split ';') ps+>          in map (\pl -> (head pl, jlt (pl!!1))) ps1+>      convFnRow jlt l =+>         (head l,fnArgs,fnRet)+>         where+>           fnRet = let rt1 = jlt (l!!3)+>                   in if read (l!!2)::Bool+>                        then SetOfType rt1+>                        else rt1+>           fnArgs = if (l!!1) == ""+>                      then []+>                      else let a = split ',' (l!!1)+>                           in map jlt a+>      convTypeInfoRow l =+>        let name = canonicalizeTypeName (l!!2)+>            ctor = case (l!!1) of+>                     "b" -> ScalarType+>                     "c" -> NamedCompositeType+>                     "d" -> DomainType+>                     "e" -> EnumType+>                     "p" -> Pseudo . pn+>                     _ -> error $ "internal error: unknown type type: "+>                          ++ (l !! 1)+>            scType = (head l, ctor name, name)+>        in if (l!!4) /= "0"+>           then [(l!!5,ArrayType $ ctor name, '_':name), scType]+>           else [scType]+>      pn t = case t of+>                    "any" -> Any+>                    "anyarray" -> AnyArray+>                    "anyelement" -> AnyElement+>                    "anyenum" -> AnyEnum+>                    "anynonarray" -> AnyNonArray+>                    "cstring" -> Cstring+>                    "internal" -> Internal+>                    "language_handler" -> LanguageHandler+>                    "opaque" -> Opaque+>                    "record" -> Record+>                    "trigger" -> Trigger+>                    "void" -> Void+>                    "fdw_handler" -> FdwHandler+>                    _ -> error $ "internal error: unknown pseudo " ++ t++> split :: Char -> String -> [String]+> split _ ""                =  []+> split c s                 =  let (l, s') = break (== c) s+>                            in  l : case s' of+>                                            [] -> []+>                                            (_:s'') -> split c s''
+ src-extra/util/Database/HsSqlPpp/Utils/Here.lhs view
@@ -0,0 +1,16 @@++Multiline string support, mainly used to enter multiline sql strings++robbed from http://old.nabble.com/Multi-line-string-literals-are-both-easy--and--elegant-in-Haskell-td19959973.html++> module Database.HsSqlPpp.Utils.Here where+>+> import Language.Haskell.TH.Quote+> --import Language.Haskell.TH.Syntax+> import Language.Haskell.TH.Lib+>+> here :: QuasiQuoter+> here = QuasiQuoter {quoteExp = litE . stringL+>                    ,quotePat = litP . stringL+>                    ,quoteType = undefined+>                    ,quoteDec = undefined}
+ src-extra/util/Database/HsSqlPpp/Utils/PgUtils.lhs view
@@ -0,0 +1,37 @@++Some simple wrappers around HDBC for the code to use.++> module Database.HsSqlPpp.Utils.PgUtils+>     (withConn+>     ,selectRelation+>     ,runSqlCommand+>     ,withTransaction+>     ,Pg.Connection+>     ,IConnection) where+>+> import qualified Database.HDBC.PostgreSQL as Pg+> import Database.HDBC+> import Control.Exception+>+> withConn :: String -> (Pg.Connection -> IO c) -> IO c+> withConn cs = bracket (Pg.connectPostgreSQL cs) disconnect+>+> selectRelation ::(IConnection conn) =>+>                  conn -> String -> [String] -> IO [[String]]+> selectRelation conn query args = do+>   sth <- prepare conn query+>   _ <- execute sth $ map sToSql args+>   v <- fetchAllRows' sth+>   return $ map (map sqlToS) v+>+> runSqlCommand :: (IConnection conn) =>+>           conn -> String -> IO ()+> runSqlCommand conn query = do+>     _ <- run conn query []+>     commit conn+>+> sToSql :: String -> SqlValue+> sToSql s = toSql (s::String)+>+> sqlToS :: SqlValue -> String+> sqlToS = fromSql
src/Database/HsSqlPpp/Internals/AstInternal.hs view
@@ -1,8 +1,8 @@   -- UUAGC 0.9.39.1 (src/Database/HsSqlPpp/Internals/AstInternal.ag)+{-# LANGUAGE DeriveDataTypeable,ScopedTypeVariables #-} module Database.HsSqlPpp.Internals.AstInternal(-    -- {-# LANGUAGE DeriveDataTypeable,ScopedTypeVariables #-}     --from the ag files:     --ast nodes     Statement (..)
src/Database/HsSqlPpp/Internals/TypeChecking/IDEnv.lhs view
@@ -5,6 +5,7 @@ this should eventually expand to take over the local identifier bindings code +> {-# LANGUAGE TupleSections #-} > module Database.HsSqlPpp.Internals.TypeChecking.IDEnv >     (IDEnv(..) >     ,emptyIDEnv
src/Database/HsSqlPpp/Internals/TypeChecking/TypeConversion.lhs view
@@ -25,7 +25,7 @@ off.  -> {-# LANGUAGE PatternGuards #-}+> {-# LANGUAGE PatternGuards,NondecreasingIndentation #-} > module Database.HsSqlPpp.Internals.TypeChecking.TypeConversion ( >                        findCallMatch >                       ,resolveResultSetType
src/Database/HsSqlPpp/Parsing/ParserInternal.lhs view
@@ -2,7 +2,7 @@ The main file for parsing sql, uses parsec. Not sure if parsec is the right choice, but it seems to do the job pretty well at the moment. -> {-# LANGUAGE FlexibleContexts,ExplicitForAll #-}+> {-# LANGUAGE FlexibleContexts,ExplicitForAll,TupleSections #-} > -- | Functions to parse SQL. > module Database.HsSqlPpp.Parsing.ParserInternal >     (-- * Main