hssqlppp-0.0.6: Database/HsSqlPpp/Tests/ParserTests.lhs
Copyright 2009 Jake Wheat
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 in a tdd style, which the coverage of the tests reflects.
There are no tests for invalid sql at the moment.
> module Database.HsSqlPpp.Tests.ParserTests (parserTests) where
> import Test.HUnit
> import Test.Framework
> import Test.Framework.Providers.HUnit
> import Data.Char
> import Database.HsSqlPpp.TypeChecking.Ast
> import Database.HsSqlPpp.TypeChecking.TypeChecker
> import Database.HsSqlPpp.Parsing.Parser
> import Database.HsSqlPpp.PrettyPrinter.PrettyPrinter
> parserTests :: Test.Framework.Test
> parserTests =
> testGroup "parserTests" [
================================================================================
uses a whole bunch of shortcuts (at the bottom of main) to make this
code more concise. Could probably use a few more.
> testGroup "parse expression"
> (mapExpr [
start with some really basic expressions, we just use the expression
parser rather than the full sql statement parser. (the expression parser
requires a single expression followed by eof.)
> p "1" (IntegerLit [] 1)
> ,p "-1" (FunCall [] "u-" [IntegerLit [] 1])
> ,p "1.1" (FloatLit [] 1.1)
> ,p "-1.1" (FunCall [] "u-" [FloatLit [] 1.1])
> ,p " 1 + 1 " (FunCall [] "+" [IntegerLit [] 1
> ,IntegerLit [] 1])
> ,p "1+1+1" (FunCall [] "+" [FunCall [] "+" [IntegerLit [] 1
> ,IntegerLit [] 1]
> ,IntegerLit [] 1])
check some basic parens use wrt naked values and row constructors
these tests reflect how pg seems to interpret the variants.
> ,p "(1)" (IntegerLit [] 1)
> ,p "row ()" (FunCall [] "!rowCtor" [])
> ,p "row (1)" (FunCall [] "!rowCtor" [IntegerLit [] 1])
> ,p "row (1,2)" (FunCall [] "!rowCtor" [IntegerLit [] 1,IntegerLit [] 2])
> ,p "(1,2)" (FunCall [] "!rowCtor" [IntegerLit [] 1,IntegerLit [] 2])
test some more really basic expressions
> ,p "'test'" (stringQ "test")
> ,p "''" (stringQ "")
> ,p "hello" (Identifier [] "hello")
> ,p "helloTest" (Identifier [] "helloTest")
> ,p "hello_test" (Identifier [] "hello_test")
> --,p "\"this is an identifier\"" (Identifier [] "this is an identifier")
> ,p "hello1234" (Identifier [] "hello1234")
> ,p "true" (BooleanLit [] True)
> ,p "false" (BooleanLit [] False)
> ,p "null" (NullLit [])
array selector
> ,p "array[1,2]" (FunCall [] "!arrayCtor" [IntegerLit [] 1, IntegerLit [] 2])
array subscripting
> ,p "a[1]" (FunCall [] "!arraySub" [Identifier [] "a", IntegerLit [] 1])
we just produce a ast, so no type checking or anything like that is
done
some operator tests
> ,p "1 + tst1" (FunCall [] "+" [IntegerLit [] 1
> ,Identifier [] "tst1"])
> ,p "tst1 + 1" (FunCall [] "+" [Identifier [] "tst1"
> ,IntegerLit [] 1])
> ,p "tst + tst1" (FunCall [] "+" [Identifier [] "tst"
> ,Identifier [] "tst1"])
> ,p "'a' || 'b'" (FunCall [] "||" [stringQ "a"
> ,stringQ "b"])
> ,p "'stuff'::text" (Cast [] (stringQ "stuff") (SimpleTypeName "text"))
> ,p "245::float(24)" (Cast [] (IntegerLit [] 245) (PrecTypeName "float" 24))
> ,p "a between 1 and 3"
> (FunCall [] "!between" [Identifier [] "a", IntegerLit [] 1, IntegerLit [] 3])
> ,p "cast(a as text)"
> (Cast [] (Identifier [] "a") (SimpleTypeName "text"))
> ,p "@ a"
> (FunCall [] "@" [Identifier [] "a"])
> ,p "substring(a from 0 for 3)"
> (FunCall [] "!substring" [Identifier [] "a", IntegerLit [] 0, IntegerLit [] 3])
> ,p "substring(a from 0 for (5 - 3))"
> (FunCall [] "!substring" [Identifier [] "a",IntegerLit [] 0,
> FunCall [] "-" [IntegerLit [] 5,IntegerLit [] 3]])
> ,p "a like b"
> (FunCall [] "!like" [Identifier [] "a", Identifier [] "b"])
some function call tests
> ,p "fn()" (FunCall [] "fn" [])
> ,p "fn(1)" (FunCall [] "fn" [IntegerLit [] 1])
> ,p "fn('test')" (FunCall [] "fn" [stringQ "test"])
> ,p "fn(1,'test')" (FunCall [] "fn" [IntegerLit [] 1, stringQ "test"])
> ,p "fn('test')" (FunCall [] "fn" [stringQ "test"])
simple whitespace sanity checks
> ,p "fn (1)" (FunCall [] "fn" [IntegerLit [] 1])
> ,p "fn( 1)" (FunCall [] "fn" [IntegerLit [] 1])
> ,p "fn(1 )" (FunCall [] "fn" [IntegerLit [] 1])
> ,p "fn(1) " (FunCall [] "fn" [IntegerLit [] 1])
null stuff
> ,p "not null" (FunCall [] "!not" [NullLit []])
> ,p "a is null" (FunCall [] "!isNull" [Identifier [] "a"])
> ,p "a is not null" (FunCall [] "!isNotNull" [Identifier [] "a"])
some slightly more complex stuff
> ,p "case when a,b then 3\n\
> \ when c then 4\n\
> \ else 5\n\
> \end"
> (Case [] [([Identifier [] "a", Identifier [] "b"], IntegerLit [] 3)
> ,([Identifier [] "c"], IntegerLit [] 4)]
> (Just $ IntegerLit [] 5))
> ,p "case 1 when 2 then 3 else 4 end"
> (CaseSimple [] (IntegerLit [] 1)
> [([IntegerLit [] 2], IntegerLit [] 3)]
> (Just $ IntegerLit [] 4))
positional args used in sql and sometimes plpgsql functions
> ,p "$1" (PositionalArg [] 1)
> ,p "exists (select 1 from a)"
> (Exists [] (selectFrom [SelExp (IntegerLit [] 1)] (Tref [] "a")))
> (Exists (makeSelect {
> selSelectList = sle [(IntegerLit [] 1)]
> ,selTref = Just $ Tref "a"}))
selectFrom [SelExp (IntegerLit [] 1)] (Tref "a")))
in variants, including using row constructors
> ,p "t in (1,2)"
> (InPredicate [] (Identifier [] "t") True (InList [IntegerLit [] 1,IntegerLit [] 2]))
> ,p "t not in (1,2)"
> (InPredicate [] (Identifier [] "t") False (InList [IntegerLit [] 1,IntegerLit [] 2]))
> ,p "(t,u) in (1,2)"
> (InPredicate [] (FunCall [] "!rowCtor" [Identifier [] "t",Identifier [] "u"]) True
> (InList [IntegerLit [] 1,IntegerLit [] 2]))
> ,p "a < b"
> (FunCall [] "<" [Identifier [] "a", Identifier [] "b"])
> ,p "a <> b"
> (FunCall [] "<>" [Identifier [] "a", Identifier [] "b"])
> ,p "a != b"
> (FunCall [] "<>" [Identifier [] "a", Identifier [] "b"])
> ])
================================================================================
test some string parsing, want to check single quote behaviour,
and dollar quoting, including nesting.
> ,testGroup "string parsing"
> (mapExpr [
> p "''" (stringQ "")
> ,p "''''" (stringQ "'")
> ,p "'test'''" (stringQ "test'")
> ,p "'''test'" (stringQ "'test")
> ,p "'te''st'" (stringQ "te'st")
> ,p "$$test$$" (StringLit [] "$$" "test")
> ,p "$$te'st$$" (StringLit [] "$$" "te'st")
> ,p "$st$test$st$" (StringLit [] "$st$" "test")
> ,p "$outer$te$$yup$$st$outer$" (StringLit [] "$outer$" "te$$yup$$st")
> ,p "'spl$$it'" (stringQ "spl$$it")
> ])
================================================================================
first statement, pretty simple
> ,testGroup "select expression"
> (mapSql [
> p "select 1;" [SelectStatement [] $ selectE (SelectList [SelExp (IntegerLit [] 1)] [])]
> ])
================================================================================
test a whole bunch more select statements
> ,testGroup "select from table"
> (mapSql [
> p "select * from tbl;"
> [SelectStatement [] $ selectFrom (selIL ["*"]) (Tref [] "tbl")]
> ,p "select a,b from tbl;"
> [SelectStatement [] $ selectFrom (selIL ["a", "b"]) (Tref [] "tbl")]
> ,p "select a,b from inf.tbl;"
> [SelectStatement [] $ selectFrom (selIL ["a", "b"]) (Tref [] "inf.tbl")]
> ,p "select distinct * from tbl;"
> [SelectStatement [] $ Select [] Distinct (SelectList (selIL ["*"]) []) (Just $ Tref [] "tbl")
> Nothing [] Nothing [] Asc Nothing Nothing]
> ,p "select a from tbl where b=2;"
> [SelectStatement [] $ selectFromWhere
> (selIL ["a"])
> (Tref [] "tbl")
> (FunCall [] "="
> [Identifier [] "b", IntegerLit [] 2])]
> ,p "select a from tbl where b=2 and c=3;"
> [SelectStatement [] $ selectFromWhere
> (selIL ["a"])
> (Tref [] "tbl")
> (FunCall [] "!and"
> [FunCall [] "=" [Identifier [] "b", IntegerLit [] 2]
> ,FunCall [] "=" [Identifier [] "c", IntegerLit [] 3]])]
> ,p "select a from tbl\n\
> \except\n\
> \select a from tbl1;"
> [SelectStatement [] $ CombineSelect [] Except
> (selectFrom (selIL ["a"]) (Tref [] "tbl"))
> (selectFrom (selIL ["a"]) (Tref [] "tbl1"))]
> ,p "select a from tbl where true\n\
> \except\n\
> \select a from tbl1 where true;"
> [SelectStatement [] $ CombineSelect [] Except
> (selectFromWhere (selIL ["a"]) (Tref [] "tbl") (BooleanLit [] True))
> (selectFromWhere (selIL ["a"]) (Tref [] "tbl1") (BooleanLit [] True))]
> ,p "select a from tbl\n\
> \union\n\
> \select a from tbl1;"
> [SelectStatement [] $ CombineSelect [] Union
> (selectFrom (selIL ["a"]) (Tref [] "tbl"))
> (selectFrom (selIL ["a"]) (Tref [] "tbl1"))]
> ,p "select a from tbl\n\
> \union all\n\
> \select a from tbl1;"
> [SelectStatement [] $ CombineSelect [] UnionAll
> (selectFrom (selIL ["a"]) (Tref [] "tbl"))
> (selectFrom (selIL ["a"]) (Tref [] "tbl1"))]
> ,p "select a as b from tbl;"
> [SelectStatement [] $ selectFrom [SelectItem (Identifier [] "a") "b"] (Tref [] "tbl")]
> ,p "select a + b as b from tbl;"
> [SelectStatement [] $ selectFrom
> [SelectItem
> (FunCall [] "+"
> [Identifier [] "a", Identifier [] "b"]) "b"]
> (Tref [] "tbl")]
> ,p "select a.* from tbl a;"
> [SelectStatement [] $ selectFrom (selIL ["a.*"]) (TrefAlias [] "tbl" "a")]
> ,p "select a from b inner join c on b.a=c.a;"
> [SelectStatement [] $ selectFrom
> (selIL ["a"])
> (JoinedTref [] (Tref [] "b") Unnatural Inner (Tref [] "c")
> (Just (JoinOn
> (FunCall [] "=" [Identifier [] "b.a", Identifier [] "c.a"]))))]
> ,p "select a from b inner join c as d on b.a=d.a;"
> [SelectStatement [] $ selectFrom
> (selIL ["a"])
> (JoinedTref [] (Tref [] "b") Unnatural Inner (TrefAlias [] "c" "d")
> (Just (JoinOn
> (FunCall [] "=" [Identifier [] "b.a", Identifier [] "d.a"]))))]
> ,p "select a from b inner join c using(d,e);"
> [SelectStatement [] $ selectFrom
> (selIL ["a"])
> (JoinedTref [] (Tref [] "b") Unnatural Inner (Tref [] "c")
> (Just (JoinUsing ["d","e"])))]
> ,p "select a from b natural inner join c;"
> [SelectStatement [] $ selectFrom
> (selIL ["a"])
> (JoinedTref [] (Tref [] "b") Natural Inner (Tref [] "c") Nothing)]
> ,p "select a from b left outer join c;"
> [SelectStatement [] $ selectFrom
> (selIL ["a"])
> (JoinedTref [] (Tref [] "b") Unnatural LeftOuter (Tref [] "c") Nothing)]
> ,p "select a from b full outer join c;"
> [SelectStatement [] $ selectFrom
> (selIL ["a"])
> (JoinedTref [] (Tref [] "b") Unnatural FullOuter (Tref [] "c") Nothing)]
> ,p "select a from b right outer join c;"
> [SelectStatement [] $ selectFrom
> (selIL ["a"])
> (JoinedTref [] (Tref [] "b") Unnatural RightOuter (Tref [] "c") Nothing)]
> ,p "select a from b cross join c;"
> [SelectStatement [] $ selectFrom
> (selIL ["a"])
> (JoinedTref [] (Tref [] "b") Unnatural Cross (Tref [] "c") Nothing)]
> ,p "select a from b\n\
> \ inner join c\n\
> \ on true\n\
> \ inner join d\n\
> \ on 1=1;"
> [SelectStatement [] $ selectFrom
> [SelExp (Identifier [] "a")]
> (JoinedTref []
> (JoinedTref [] (Tref [] "b") Unnatural Inner (Tref [] "c")
> (Just $ JoinOn (BooleanLit [] True)))
> Unnatural Inner (Tref [] "d")
> (Just $ JoinOn (FunCall [] "="
> [IntegerLit [] 1, IntegerLit [] 1])))]
> ,p "select row_number() over(order by a) as place from tbl;"
> [SelectStatement [] $ selectFrom [SelectItem
> (WindowFn []
> (FunCall [] "row_number" [])
> []
> [Identifier [] "a"] Asc)
> "place"]
> (Tref [] "tbl")]
> ,p "select row_number() over(order by a asc) as place from tbl;"
> [SelectStatement [] $ selectFrom [SelectItem
> (WindowFn []
> (FunCall [] "row_number" [])
> []
> [Identifier [] "a"] Asc)
> "place"]
> (Tref [] "tbl")]
> ,p "select row_number() over(order by a desc) as place from tbl;"
> [SelectStatement [] $ selectFrom [SelectItem
> (WindowFn []
> (FunCall [] "row_number" [])
> []
> [Identifier [] "a"] Desc)
> "place"]
> (Tref [] "tbl")]
> ,p "select row_number()\n\
> \over(partition by (a,b) order by c) as place\n\
> \from tbl;"
> [SelectStatement [] $ selectFrom [SelectItem
> (WindowFn []
> (FunCall [] "row_number" [])
> [FunCall [] "!rowCtor" [Identifier [] "a",Identifier [] "b"]]
> [Identifier [] "c"] Asc)
> "place"]
> (Tref [] "tbl")]
> ,p "select * from a natural inner join (select * from b) as a;"
> [SelectStatement [] $ selectFrom
> (selIL ["*"])
> (JoinedTref [] (Tref [] "a") Natural
> Inner (SubTref [] (selectFrom
> (selIL ["*"])
> (Tref [] "b")) "a")
> Nothing)]
> ,p "select * from a order by c;"
> [SelectStatement [] $ Select [] Dupes
> (sl (selIL ["*"]))
> (Just $ Tref [] "a")
> Nothing [] Nothing [Identifier [] "c"] Asc Nothing Nothing]
> ,p "select * from a order by c,d asc;"
> [SelectStatement [] $ Select [] Dupes
> (sl (selIL ["*"]))
> (Just $ Tref [] "a")
> Nothing [] Nothing [Identifier [] "c", Identifier [] "d"] Asc Nothing Nothing]
> ,p "select * from a order by c,d desc;"
> [SelectStatement [] $ Select [] Dupes
> (sl (selIL ["*"]))
> (Just $ Tref [] "a")
> Nothing [] Nothing [Identifier [] "c", Identifier [] "d"] Desc Nothing Nothing]
> ,p "select * from a order by c limit 1;"
> [SelectStatement [] $ Select [] Dupes
> (sl (selIL ["*"]))
> (Just $ Tref [] "a")
> Nothing [] Nothing [Identifier [] "c"] Asc (Just (IntegerLit [] 1)) Nothing]
> ,p "select * from a order by c offset 3;"
> [SelectStatement [] $ Select [] Dupes
> (sl (selIL ["*"]))
> (Just $ Tref [] "a")
> Nothing [] Nothing [Identifier [] "c"] Asc Nothing (Just $ IntegerLit [] 3)]
> ,p "select a from (select b from c) as d;"
> [SelectStatement [] $ selectFrom
> (selIL ["a"])
> (SubTref [] (selectFrom
> (selIL ["b"])
> (Tref [] "c"))
> "d")]
> ,p "select * from gen();"
> [SelectStatement [] $ selectFrom (selIL ["*"]) (TrefFun [] $ FunCall [] "gen" [])]
> ,p "select * from gen() as t;"
> [SelectStatement [] $ selectFrom
> (selIL ["*"])
> (TrefFunAlias [] (FunCall [] "gen" []) "t")]
> ,p "select a, count(b) from c group by a;"
> [SelectStatement [] $ Select [] Dupes
> (sl [selI "a", SelExp (FunCall [] "count" [Identifier [] "b"])])
> (Just $ Tref [] "c") Nothing [Identifier [] "a"]
> Nothing [] Asc Nothing Nothing]
> ,p "select a, count(b) as cnt from c group by a having cnt > 4;"
> [SelectStatement [] $ Select [] Dupes
> (sl [selI "a", SelectItem (FunCall [] "count" [Identifier [] "b"]) "cnt"])
> (Just $ Tref [] "c") Nothing [Identifier [] "a"]
> (Just $ FunCall [] ">" [Identifier [] "cnt", IntegerLit [] 4])
> [] Asc Nothing Nothing]
> ,p "select a from (select 1 as a, 2 as b) x;"
> [SelectStatement [] $ selectFrom
> [selI "a"]
> (SubTref [] (selectE $ SelectList
> [SelectItem (IntegerLit [] 1) "a"
> ,SelectItem (IntegerLit [] 2) "b"] [])
> "x")]
> ])
================================================================================
one sanity check for parsing multiple statements
> ,testGroup "multiple statements"
> (mapSql [
> p "select 1;\nselect 2;" [SelectStatement [] $ selectE $ sl [SelExp (IntegerLit [] 1)]
> ,SelectStatement [] $ selectE $ sl [SelExp (IntegerLit [] 2)]]
> ])
================================================================================
test comment behaviour
> ,testGroup "comments"
> (mapSql [
> p "" []
> ,p "-- this is a test" []
> ,p "/* this is\n\
> \a test*/" []
maybe some people actually put block comments inside parts of
statements when they program?
> ,p "select 1;\n\
> \-- this is a test\n\
> \select -- this is a test\n\
> \2;" [SelectStatement [] $ selectE $ sl [SelExp (IntegerLit [] 1)]
> ,SelectStatement [] $ selectE $ sl [SelExp (IntegerLit [] 2)]
> ]
> ,p "select 1;\n\
> \/* this is\n\
> \a test*/\n\
> \select /* this is a test*/2;"
> [SelectStatement [] $ selectE $ sl [SelExp (IntegerLit [] 1)]
> ,SelectStatement [] $ selectE $ sl [SelExp (IntegerLit [] 2)]
> ]
> ])
================================================================================
dml statements
> ,testGroup "dml"
> (mapSql [
simple insert
> p "insert into testtable\n\
> \(columna,columnb)\n\
> \values (1,2);\n"
> [Insert []
> "testtable"
> ["columna", "columnb"]
> (Values [] [[IntegerLit [] 1, IntegerLit [] 2]])
> Nothing]
multi row insert, test the stand alone values statement first, maybe
that should be in the select section?
> ,p "values (1,2), (3,4);"
> [SelectStatement [] $ Values [] [[IntegerLit [] 1, IntegerLit [] 2]
> ,[IntegerLit [] 3, IntegerLit [] 4]]]
> ,p "insert into testtable\n\
> \(columna,columnb)\n\
> \values (1,2), (3,4);\n"
> [Insert []
> "testtable"
> ["columna", "columnb"]
> (Values [] [[IntegerLit [] 1, IntegerLit [] 2]
> ,[IntegerLit [] 3, IntegerLit [] 4]])
> Nothing]
insert from select
> ,p "insert into a\n\
> \ select b from c;"
> [Insert [] "a" []
> (selectFrom [selI "b"] (Tref [] "c"))
> Nothing]
> ,p "insert into testtable\n\
> \(columna,columnb)\n\
> \values (1,2) returning id;\n"
> [Insert []
> "testtable"
> ["columna", "columnb"]
> (Values [] [[IntegerLit [] 1, IntegerLit [] 2]])
> (Just $ sl [selI "id"])]
updates
> ,p "update tb\n\
> \ set x = 1, y = 2;"
> [Update [] "tb" [SetClause "x" (IntegerLit [] 1)
> ,SetClause "y" (IntegerLit [] 2)]
> Nothing Nothing]
> ,p "update tb\n\
> \ set x = 1, y = 2 where z = true;"
> [Update [] "tb" [SetClause "x" (IntegerLit [] 1)
> ,SetClause "y" (IntegerLit [] 2)]
> (Just $ FunCall [] "="
> [Identifier [] "z", BooleanLit [] True])
> Nothing]
> ,p "update tb\n\
> \ set x = 1, y = 2 returning id;"
> [Update [] "tb" [SetClause "x" (IntegerLit [] 1)
> ,SetClause "y" (IntegerLit [] 2)]
> Nothing (Just $ sl [selI "id"])]
> ,p "update pieces\n\
> \set a=b returning tag into r.tag;"
> [Update [] "pieces" [SetClause "a" (Identifier [] "b")]
> Nothing (Just (SelectList
> [SelExp (Identifier [] "tag")]
> ["r.tag"]))]
> ,p "update tb\n\
> \ set (x,y) = (1,2);"
> [Update [] "tb" [RowSetClause
> ["x","y"]
> [IntegerLit [] 1,IntegerLit [] 2]]
> Nothing Nothing]
delete
> ,p "delete from tbl1 where x = true;"
> [Delete [] "tbl1" (Just $ FunCall [] "="
> [Identifier [] "x", BooleanLit [] True])
> Nothing]
> ,p "delete from tbl1 where x = true returning id;"
> [Delete [] "tbl1" (Just $ FunCall [] "="
> [Identifier [] "x", BooleanLit [] True])
> (Just $ sl [selI "id"])]
> ,p "truncate test;"
> [Truncate [] ["test"] ContinueIdentity Restrict]
> ,p "truncate table test, test2 restart identity cascade;"
> [Truncate [] ["test","test2"] RestartIdentity Cascade]
copy, bit crap at the moment
> ,p "copy tbl(a,b) from stdin;\n\
> \bat t\n\
> \bear f\n\
> \\\.\n"
> [Copy [] "tbl" ["a", "b"] Stdin
> ,CopyData [] "\
> \bat t\n\
> \bear f\n"]
> ])
================================================================================
some ddl
> ,testGroup "create"
> (mapSql [
create table tests
> p "create table test (\n\
> \ fielda text,\n\
> \ fieldb int\n\
> \);"
> [CreateTable []
> "test"
> [att "fielda" "text"
> ,att "fieldb" "int"
> ]
> []]
> ,p "create table tbl (\n\
> \ fld boolean default false);"
> [CreateTable [] "tbl" [AttributeDef "fld" (SimpleTypeName "boolean")
> (Just $ BooleanLit [] False) []][]]
> ,p "create table tbl as select 1;"
> [CreateTableAs [] "tbl"
> (selectE (SelectList [SelExp (IntegerLit [] 1)] []))]
other creates
> ,p "create view v1 as\n\
> \select a,b from t;"
> [CreateView []
> "v1"
> (selectFrom [selI "a", selI "b"] (Tref [] "t"))]
> ,p "create domain td as text check (value in ('t1', 't2'));"
> [CreateDomain [] "td" (SimpleTypeName "text")
> (Just (InPredicate [] (Identifier [] "value") True
> (InList [stringQ "t1" ,stringQ "t2"])))]
> ,p "create type tp1 as (\n\
> \ f1 text,\n\
> \ f2 text\n\
> \);"
> [CreateType [] "tp1" [TypeAttDef "f1" (SimpleTypeName "text")
> ,TypeAttDef "f2" (SimpleTypeName "text")]]
drops
> ,p "drop domain t;"
> [DropSomething [] Domain Require ["t"] Restrict]
> ,p "drop domain if exists t,u cascade;"
> [DropSomething [] Domain IfExists ["t", "u"] Cascade]
> ,p "drop domain t restrict;"
> [DropSomething [] Domain Require ["t"] Restrict]
> ,p "drop type t;"
> [DropSomething [] Type Require ["t"] Restrict]
> ,p "drop table t;"
> [DropSomething [] Table Require ["t"] Restrict]
> ,p "drop view t;"
> [DropSomething [] View Require ["t"] Restrict]
> ])
constraints
> ,testGroup "constraints"
> (mapSql [
nulls
> p "create table t1 (\n\
> \ a text null\n\
> \);"
> [CreateTable [] "t1" [AttributeDef "a" (SimpleTypeName "text")
> Nothing [NullConstraint]]
> []]
> ,p "create table t1 (\n\
> \ a text not null\n\
> \);"
> [CreateTable [] "t1" [AttributeDef "a" (SimpleTypeName "text")
> Nothing [NotNullConstraint]]
> []]
unique table
> ,p "create table t1 (\n\
> \ x int,\n\
> \ y int,\n\
> \ unique (x,y)\n\
> \);"
> [CreateTable [] "t1" [att "x" "int"
> ,att "y" "int"]
> [UniqueConstraint ["x","y"]]]
test arbitrary ordering
> ,p "create table t1 (\n\
> \ x int,\n\
> \ unique (x),\n\
> \ y int\n\
> \);"
> [CreateTable [] "t1" [att "x" "int"
> ,att "y" "int"]
> [UniqueConstraint ["x"]]]
unique row
> ,p "create table t1 (\n\
> \ x int unique\n\
> \);"
> [CreateTable [] "t1" [AttributeDef "x" (SimpleTypeName "int") Nothing
> [RowUniqueConstraint]][]]
> ,p "create table t1 (\n\
> \ x int unique not null\n\
> \);"
> [CreateTable [] "t1" [AttributeDef "x" (SimpleTypeName "int") Nothing
> [RowUniqueConstraint
> ,NotNullConstraint]][]]
quick sanity check
> ,p "create table t1 (\n\
> \ x int not null unique\n\
> \);"
> [CreateTable [] "t1" [AttributeDef "x" (SimpleTypeName "int") Nothing
> [NotNullConstraint
> ,RowUniqueConstraint]][]]
primary key row, table
> ,p "create table t1 (\n\
> \ x int primary key\n\
> \);"
> [CreateTable [] "t1" [AttributeDef "x" (SimpleTypeName "int") Nothing
> [RowPrimaryKeyConstraint]][]]
> ,p "create table t1 (\n\
> \ x int,\n\
> \ y int,\n\
> \ primary key (x,y)\n\
> \);"
> [CreateTable [] "t1" [att "x" "int"
> ,att "y" "int"]
> [PrimaryKeyConstraint ["x", "y"]]]
check row, table
> ,p "create table t (\n\
> \f text check (f in('a', 'b'))\n\
> \);"
> [CreateTable [] "t"
> [AttributeDef "f" (SimpleTypeName "text") Nothing
> [RowCheckConstraint (InPredicate []
> (Identifier [] "f") True
> (InList [stringQ "a", stringQ "b"]))]] []]
> ,p "create table t1 (\n\
> \ x int,\n\
> \ y int,\n\
> \ check (x>y)\n\
> \);"
> [CreateTable [] "t1" [att "x" "int"
> ,att "y" "int"]
> [CheckConstraint (FunCall [] ">" [Identifier [] "x", Identifier [] "y"])]]
row, whole load of constraints, todo: add reference here
> ,p "create table t (\n\
> \f text not null unique check (f in('a', 'b'))\n\
> \);"
> [CreateTable [] "t"
> [AttributeDef "f" (SimpleTypeName "text") Nothing
> [NotNullConstraint
> ,RowUniqueConstraint
> ,RowCheckConstraint (InPredicate []
> (Identifier [] "f") True
> (InList [stringQ "a"
> ,stringQ "b"]))]] []]
reference row, table
> ,p "create table t1 (\n\
> \ x int references t2\n\
> \);"
> [CreateTable [] "t1" [AttributeDef "x" (SimpleTypeName "int") Nothing
> [RowReferenceConstraint "t2" Nothing
> Restrict Restrict]][]]
> ,p "create table t1 (\n\
> \ x int references t2(y)\n\
> \);"
> [CreateTable [] "t1" [AttributeDef "x" (SimpleTypeName "int") Nothing
> [RowReferenceConstraint "t2" (Just "y")
> Restrict Restrict]][]]
> ,p "create table t1 (\n\
> \ x int,\n\
> \ y int,\n\
> \ foreign key (x,y) references t2\n\
> \);"
> [CreateTable [] "t1" [att "x" "int"
> ,att "y" "int"]
> [ReferenceConstraint ["x", "y"] "t2" []
> Restrict Restrict]]
> ,p "create table t1 (\n\
> \ x int,\n\
> \ y int,\n\
> \ foreign key (x,y) references t2(z,w)\n\
> \);"
> [CreateTable [] "t1" [att "x" "int"
> ,att "y" "int"]
> [ReferenceConstraint ["x", "y"] "t2" ["z", "w"]
> Restrict Restrict]]
> ,p "create table t1 (\n\
> \ x int references t2 on delete cascade\n\
> \);"
> [CreateTable [] "t1" [AttributeDef "x" (SimpleTypeName "int") Nothing
> [RowReferenceConstraint "t2" Nothing
> Cascade Restrict]][]]
> ,p "create table t1 (\n\
> \ x int references t2 on update cascade\n\
> \);"
> [CreateTable [] "t1" [AttributeDef "x" (SimpleTypeName "int") Nothing
> [RowReferenceConstraint "t2" Nothing
> Restrict Cascade]][]]
> ,p "create table t1 (\n\
> \ x int,\n\
> \ y int,\n\
> \ foreign key (x,y) references t2 on delete cascade on update cascade\n\
> \);"
> [CreateTable [] "t1" [att "x" "int"
> ,att "y" "int"]
> [ReferenceConstraint ["x", "y"] "t2" []
> Cascade Cascade]]
> ])
================================================================================
test functions
> ,testGroup "functions"
> (mapSql [
> p "create function t1(text) returns text as $$\n\
> \select a from t1 where b = $1;\n\
> \$$ language sql stable;"
> [CreateFunction [] Sql "t1" [ParamDefTp $ SimpleTypeName "text"]
> (SimpleTypeName "text") "$$"
> (SqlFnBody
> [SelectStatement [] $ selectFromWhere [SelExp (Identifier [] "a")] (Tref [] "t1")
> (FunCall [] "="
> [Identifier [] "b", PositionalArg [] 1])])
> Stable]
> ,p "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 [] Plpgsql "fn" [] (SimpleTypeName "void") "$$"
> (PlpgsqlFnBody [VarDef "a" (SimpleTypeName "int") Nothing
> ,VarDef "b" (SimpleTypeName "text") Nothing]
> [NullStatement []])
> Volatile]
> ,p "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 [] Plpgsql "fn" [] (SimpleTypeName "void") "$$"
> (PlpgsqlFnBody [VarDef "a" (SimpleTypeName "int") Nothing
> ,VarDef "b" (SimpleTypeName "text") Nothing]
> [NullStatement []])
> Volatile]
> ,p "create function fn(a text[]) returns int[] as $$\n\
> \declare\n\
> \ b xtype[] := '{}';\n\
> \begin\n\
> \ null;\n\
> \end;\n\
> \$$ language plpgsql immutable;"
> [CreateFunction [] Plpgsql "fn"
> [ParamDef "a" $ ArrayTypeName $ SimpleTypeName "text"]
> (ArrayTypeName $ SimpleTypeName "int") "$$"
> (PlpgsqlFnBody
> [VarDef "b" (ArrayTypeName $ SimpleTypeName "xtype") (Just $ stringQ "{}")]
> [NullStatement []])
> Immutable]
> ,p "create function fn() returns void as '\n\
> \declare\n\
> \ a int := 3;\n\
> \begin\n\
> \ null;\n\
> \end;\n\
> \' language plpgsql stable;"
> [CreateFunction [] Plpgsql "fn" [] (SimpleTypeName "void") "'"
> (PlpgsqlFnBody [VarDef "a" (SimpleTypeName "int") (Just $ IntegerLit [] 3)]
> [NullStatement []])
> Stable]
> ,p "create function fn() returns setof int as $$\n\
> \begin\n\
> \ null;\n\
> \end;\n\
> \$$ language plpgsql stable;"
> [CreateFunction [] Plpgsql "fn" []
> (SetOfTypeName $ SimpleTypeName "int") "$$"
> (PlpgsqlFnBody [] [NullStatement []])
> Stable]
> ,p "create function fn() returns void as $$\n\
> \begin\n\
> \ null;\n\
> \end\n\
> \$$ language plpgsql stable;"
> [CreateFunction [] Plpgsql "fn" []
> (SimpleTypeName "void") "$$"
> (PlpgsqlFnBody [] [NullStatement []])
> Stable]
> ,p "drop function test(text);"
> [DropFunction [] Require [("test",["text"])] Restrict]
> ,p "drop function if exists a(),test(text) cascade;"
> [DropFunction [] IfExists [("a",[])
> ,("test",["text"])] Cascade]
> ])
================================================================================
test non sql plpgsql statements
> ,testGroup "plpgsqlStatements"
> (mapPlpgsql [
simple statements
> p "success := true;"
> [Assignment [] "success" (BooleanLit [] True)]
> ,p "success = true;"
> [Assignment [] "success" (BooleanLit [] True)]
> ,p "return true;"
> [Return [] $ Just (BooleanLit [] True)]
> ,p "return;"
> [Return [] Nothing]
> ,p "return next 1;"
> [ReturnNext [] $ IntegerLit [] 1]
> ,p "return query select a from b;"
> [ReturnQuery [] $ selectFrom [selI "a"] (Tref [] "b")]
> ,p "raise notice 'stuff %', 1;"
> [Raise [] RNotice "stuff %" [IntegerLit [] 1]]
> ,p "perform test();"
> [Perform [] $ FunCall [] "test" []]
> ,p "perform test(a,b);"
> [Perform [] $ FunCall [] "test" [Identifier [] "a", Identifier [] "b"]]
> ,p "perform test(r.relvar_name || '_and_stuff');"
> [Perform [] $ FunCall [] "test" [
> FunCall [] "||" [Identifier [] "r.relvar_name"
> ,stringQ "_and_stuff"]]]
> ,p "select into a,b c,d from e;"
> [SelectStatement [] $ Select [] Dupes (SelectList [selI "c", selI "d"] ["a", "b"])
> (Just $ Tref [] "e") Nothing [] Nothing [] Asc Nothing Nothing]
> ,p "select c,d into a,b from e;"
> [SelectStatement [] $ Select [] Dupes (SelectList [selI "c", selI "d"] ["a", "b"])
> (Just $ Tref [] "e") Nothing [] Nothing [] Asc Nothing Nothing]
> ,p "execute s;"
> [Execute [] (Identifier [] "s")]
> ,p "execute s into r;"
> [ExecuteInto [] (Identifier [] "s") ["r"]]
> ,p "continue;" [ContinueStatement []]
complicated statements
> ,p "for r in select a from tbl loop\n\
> \null;\n\
> \end loop;"
> [ForSelectStatement [] "r" (selectFrom [selI "a"] (Tref [] "tbl"))
> [NullStatement []]]
> ,p "for r in select a from tbl where true loop\n\
> \null;\n\
> \end loop;"
> [ForSelectStatement [] "r"
> (selectFromWhere [selI "a"] (Tref [] "tbl") (BooleanLit [] True))
> [NullStatement []]]
> ,p "for r in 1 .. 10 loop\n\
> \null;\n\
> \end loop;"
> [ForIntegerStatement [] "r"
> (IntegerLit [] 1) (IntegerLit [] 10)
> [NullStatement []]]
> ,p "if a=b then\n\
> \ update c set d = e;\n\
> \end if;"
> [If [] [((FunCall [] "=" [Identifier [] "a", Identifier [] "b"])
> ,[Update [] "c" [SetClause "d" (Identifier [] "e")] Nothing Nothing])]
> []]
> ,p "if true then\n\
> \ null;\n\
> \else\n\
> \ null;\n\
> \end if;"
> [If [] [((BooleanLit [] True),[NullStatement []])]
> [NullStatement []]]
> ,p "if true then\n\
> \ null;\n\
> \elseif false then\n\
> \ return;\n\
> \end if;"
> [If [] [((BooleanLit [] True), [NullStatement []])
> ,((BooleanLit [] False), [Return [] Nothing])]
> []]
> ,p "if true then\n\
> \ null;\n\
> \elseif false then\n\
> \ return;\n\
> \elseif false then\n\
> \ return;\n\
> \else\n\
> \ return;\n\
> \end if;"
> [If [] [((BooleanLit [] True), [NullStatement []])
> ,((BooleanLit [] False), [Return [] Nothing])
> ,((BooleanLit [] False), [Return [] Nothing])]
> [Return [] Nothing]]
> ,p "case a\n\
> \ when b then null;\n\
> \ when c,d then null;\n\
> \ else null;\n\
> \end case;"
> [CaseStatement [] (Identifier [] "a")
> [([Identifier [] "b"], [NullStatement []])
> ,([Identifier [] "c", Identifier [] "d"], [NullStatement []])]
> [NullStatement []]]
> ])
> --,testProperty "random expression" prop_expression_ppp
> -- ,testProperty "random statements" prop_statements_ppp
> ]
> where
> mapExpr = map $ uncurry checkParseExpression
> mapSql = map $ uncurry checkParse
> mapPlpgsql = map $ uncurry checkParsePlpgsql
> p a b = (a,b)
> selIL = map selI
> selI = SelExp . Identifier []
> sl a = SelectList a []
> selectE selList = Select [] Dupes selList
> Nothing Nothing [] Nothing [] Asc Nothing Nothing
> selectFrom selList frm =
> Select [] Dupes (SelectList selList [])
> (Just frm) Nothing [] Nothing [] Asc Nothing Nothing
> selectFromWhere selList frm whr =
> Select [] Dupes (SelectList selList [])
> (Just frm) (Just whr) [] Nothing [] Asc Nothing Nothing
> stringQ = StringLit [] "'"
> att n t = AttributeDef n (SimpleTypeName t) Nothing []
================================================================================
Unit test helpers
parse and then pretty print and parse a statement
> checkParse :: String -> [Statement] -> Test.Framework.Test
> checkParse src ast = parseUtil1 src ast parseSql
parse and then pretty print and parse an expression
> checkParseExpression :: String -> Expression -> Test.Framework.Test
> checkParseExpression src ast = parseUtil src ast
> parseExpression printExpression
> checkParsePlpgsql :: String -> [Statement] -> Test.Framework.Test
> checkParsePlpgsql src ast = parseUtil1 src ast parsePlpgsql
> parseUtil :: (Show t, Eq b, Show b) =>
> String
> -> b
> -> (String -> Either t b)
> -> (b -> String)
> -> Test.Framework.Test
> parseUtil src ast parser printer = testCase ("parse " ++ src) $ do
> let ast' = case parser src of
> Left er -> error $ show er
> Right l -> l
> assertEqual ("parse " ++ src) ast ast'
> -- pretty print then parse to check
> let pp = printer ast
> let ast'' = case parser pp of
> Left er -> error $ "reparse\n" ++ show er ++ "\n" -- ++ pp ++ "\n"
> Right l -> l
> assertEqual ("reparse " ++ pp) ast ast''
> parseUtil1 :: (Show a) => String
> -> [Statement]
> -> (String -> Either a StatementList)
> -> Test.Framework.Test
> parseUtil1 src ast parser = testCase ("parse " ++ src) $ do
> let ast' = case parser src of
> Left er -> error $ show er
> Right l -> l
> assertEqual ("parse " ++ src) ast $ map stripAnnotations ast'
> -- pretty print then parse to check
> let pp = printSql ast'
> let ast'' = case parser pp of
> Left er -> error $ "reparse\n" ++ show er ++ "\n" -- ++ pp ++ "\n"
> Right l -> l
> assertEqual ("reparse " ++ pp) ast $ map stripAnnotations ast''