starlitcanopy/simple-sql-parser
1
Fork 0
Code Activity

refactor dialect into a non enum and separate to own file

Browse source
This commit is contained in:
Jake Wheat 2016-02-12 12:51:06 +02:00
parent 2b73907119
commit 1b4eefc431
22 changed files with 304 additions and 252 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

51
Language/SQL/SimpleSQL/Dialect.lhs Normal file
View file

@ -0,0 +1,51 @@
Data types to represent different dialect options
> {-# LANGUAGE DeriveDataTypeable #-}
> module Language.SQL.SimpleSQL.Dialect
> (SyntaxFlavour(..)
> ,Dialect(..)
> ,ansi2011
> ,mysql
> ,postgres
> ,oracle
> ,sqlserver
> ) where
> import Data.Data
hack for now, later will expand to flags on a feature by feature basis
> data SyntaxFlavour = ANSI2011
> | MySQL
> | Postgres
> | Oracle
> | SQLServer
> deriving (Eq,Show,Read,Data,Typeable)
> -- | Used to set the dialect used for parsing and pretty printing,
> -- very unfinished at the moment.
> data Dialect = Dialect {diSyntaxFlavour :: SyntaxFlavour}
> deriving (Eq,Show,Read,Data,Typeable)
> -- | ansi sql 2011 dialect
> ansi2011 :: Dialect
> ansi2011 = Dialect ANSI2011
> -- | mysql dialect
> mysql :: Dialect
> mysql = Dialect MySQL
> -- | postgresql dialect
> postgres :: Dialect
> postgres = Dialect Postgres
> -- | oracle dialect
> oracle :: Dialect
> oracle = Dialect Postgres
> -- | microsoft sql server dialect
> sqlserver :: Dialect
> sqlserver = Dialect Postgres

4
Language/SQL/SimpleSQL/Lex.lhs
View file

@ -18,7 +18,7 @@ parsec
> ,ParseError(..)
> ,Dialect(..)) where
> import Language.SQL.SimpleSQL.Syntax (Dialect(..))
> import Language.SQL.SimpleSQL.Dialect
> import Text.Parsec (option,string,manyTill,anyChar
> ,try,string,many1,oneOf,digit,(<|>),choice,char,eof
@ -200,7 +200,7 @@ u&"unicode quoted identifier"
> ,return $ concat [t,s]]
> -- mysql can quote identifiers with `
> mySqlQIden = do
> guard (d == MySQL)
> guard (diSyntaxFlavour d == MySQL)
> char '`' *> takeWhile1 (/='`') <* char '`'
This parses a valid identifier without quotes.

13
Language/SQL/SimpleSQL/Parse.lhs
View file

@ -202,6 +202,7 @@ fixing them in the syntax but leaving them till the semantic checking
> import Language.SQL.SimpleSQL.Syntax
> import Language.SQL.SimpleSQL.Combinators
> import Language.SQL.SimpleSQL.Errors
> import Language.SQL.SimpleSQL.Dialect
> import qualified Language.SQL.SimpleSQL.Lex as L
> import Data.Maybe
> import Text.Parsec.String (GenParser)
@ -1359,7 +1360,7 @@ allows offset and fetch in either order
> fetch :: Parser ValueExpr
> fetch = fetchFirst <|> limit
> where
> fetchFirst = guardDialect [SQL2011]
> fetchFirst = guardDialect [ANSI2011]
> *> fs *> valueExpr <* ro
> fs = makeKeywordTree ["fetch first", "fetch next"]
> ro = makeKeywordTree ["rows only", "row only"]
@ -2107,7 +2108,7 @@ keywords (I'm not sure what exactly being an unreserved keyword
means).
> reservedWord :: Dialect -> [String]
> reservedWord SQL2011 =
> reservedWord d | diSyntaxFlavour d == ANSI2011 =
> ["abs"
> --,"all"
> ,"allocate"
@ -2435,9 +2436,9 @@ means).
> ]
TODO: create this list properly
move this list into the dialect data type
> reservedWord MySQL = reservedWord SQL2011 ++ ["limit"]
> reservedWord _ = reservedWord ansi2011 ++ ["limit"]
-----------
@ -2450,10 +2451,10 @@ different parsers can be used for different dialects
> type Parser = GenParser Token ParseState
> guardDialect :: [Dialect] -> Parser ()
> guardDialect :: [SyntaxFlavour] -> Parser ()
> guardDialect ds = do
> d <- getState
> guard (d `elem` ds)
> guard (diSyntaxFlavour d `elem` ds)
TODO: the ParseState and the Dialect argument should be turned into a
flags struct. Part (or all?) of this struct is the dialect

3
Language/SQL/SimpleSQL/Pretty.lhs
View file

@ -13,6 +13,7 @@ TODO: there should be more comments in this file, especially the bits
which have been changed to try to improve the layout of the output.
> import Language.SQL.SimpleSQL.Syntax
> import Language.SQL.SimpleSQL.Dialect
> import Text.PrettyPrint (render, vcat, text, (<>), (<+>), empty, parens,
> nest, Doc, punctuate, comma, sep, quotes,
> doubleQuotes, brackets,hcat)
@ -336,7 +337,7 @@ which have been changed to try to improve the layout of the output.
> ]
> where
> fetchFirst =
> me (\e -> if dia == MySQL
> me (\e -> if diSyntaxFlavour dia == MySQL
> then text "limit" <+> valueExpr dia e
> else text "fetch first" <+> valueExpr dia e
> <+> text "rows only") fe

19
Language/SQL/SimpleSQL/Syntax.lhs
View file

@ -55,13 +55,19 @@
> ,PrivilegeAction(..)
> ,AdminOptionFor(..)
> ,GrantOptionFor(..)
> -- * Dialect
> ,Dialect(..)
> -- * Dialects
> ,Dialect
> ,ansi2011
> ,mysql
> ,postgres
> ,oracle
> ,sqlserver
> -- * Comment
> ,Comment(..)
> ) where
> import Data.Data
> import Language.SQL.SimpleSQL.Dialect
> -- | Represents a value expression. This is used for the expressions
> -- in select lists. It is also used for expressions in where, group
@ -702,15 +708,6 @@ I'm not sure if this is valid syntax or not.
> | PrivExecute
> deriving (Eq,Show,Read,Data,Typeable)
--------------------------
> -- | Used to set the dialect used for parsing and pretty printing,
> -- very unfinished at the moment.
> data Dialect = SQL2011
> | MySQL
> deriving (Eq,Show,Read,Data,Typeable)
> -- | Comment. Useful when generating SQL code programmatically. The
> -- parser doesn't produce these.
> data Comment = BlockComment String

6
simple-sql-parser.cabal
View file

@ -36,7 +36,8 @@ library
Language.SQL.SimpleSQL.Lex,
Language.SQL.SimpleSQL.Syntax
Other-Modules: Language.SQL.SimpleSQL.Errors,
Language.SQL.SimpleSQL.Combinators
Language.SQL.SimpleSQL.Combinators,
Language.SQL.SimpleSQL.Dialect
other-extensions: TupleSections
build-depends: base >=4.5 && <4.9,
parsec >=3.1 && <3.2,
@ -63,7 +64,8 @@ Test-Suite Tests
Language.SQL.SimpleSQL.Lex,
Language.SQL.SimpleSQL.Syntax,
Language.SQL.SimpleSQL.Errors,
Language.SQL.SimpleSQL.Combinators
Language.SQL.SimpleSQL.Combinators,
Language.SQL.SimpleSQL.Dialect
Language.SQL.SimpleSQL.ErrorMessages,
Language.SQL.SimpleSQL.FullQueries,

2
tools/Language/SQL/SimpleSQL/FullQueries.lhs
View file

@ -8,7 +8,7 @@ Some tests for parsing full queries.
> fullQueriesTests :: TestItem
> fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr SQL2011))
> fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr ansi2011))
> [("select count(*) from t"
> ,makeSelect
> {qeSelectList = [(App [Name "count"] [Star], Nothing)]

6
tools/Language/SQL/SimpleSQL/GroupBy.lhs
View file

@ -15,7 +15,7 @@ Here are the tests for the group by component of query exprs
> ]
> simpleGroupBy :: TestItem
> simpleGroupBy = Group "simpleGroupBy" $ map (uncurry (TestQueryExpr SQL2011))
> simpleGroupBy = Group "simpleGroupBy" $ map (uncurry (TestQueryExpr ansi2011))
> [("select a,sum(b) from t group by a"
> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)
> ,(App [Name "sum"] [Iden [Name "b"]],Nothing)]
@ -37,7 +37,7 @@ test the new group by (), grouping sets, cube and rollup syntax (not
sure which sql version they were introduced, 1999 or 2003 I think).
> newGroupBy :: TestItem
> newGroupBy = Group "newGroupBy" $ map (uncurry (TestQueryExpr SQL2011))
> newGroupBy = Group "newGroupBy" $ map (uncurry (TestQueryExpr ansi2011))
> [("select * from t group by ()", ms [GroupingParens []])
> ,("select * from t group by grouping sets ((), (a))"
> ,ms [GroupingSets [GroupingParens []
@ -53,7 +53,7 @@ sure which sql version they were introduced, 1999 or 2003 I think).
> ,qeGroupBy = g}
> randomGroupBy :: TestItem
> randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr SQL2011)
> randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
> ["select * from t GROUP BY a"
> ,"select * from t GROUP BY GROUPING SETS((a))"
> ,"select * from t GROUP BY a,b,c"

6
tools/Language/SQL/SimpleSQL/LexerTests.lhs
View file

@ -57,9 +57,9 @@ Test for the lexer
> lexerTests :: TestItem
> lexerTests = Group "lexerTests" $
> [Group "lexer token tests" $ [LexerTest SQL2011 s t | (s,t) <- lexerTable]
> [Group "lexer token tests" $ [LexerTest ansi2011 s t | (s,t) <- lexerTable]
> ,Group "generated combination lexer tests" $
> [ LexerTest SQL2011 (s ++ s1) (t ++ t1)
> [ LexerTest ansi2011 (s ++ s1) (t ++ t1)
> | (s,t) <- lexerTable
> , (s1,t1) <- lexerTable
@ -75,7 +75,7 @@ number number (todo: double check more carefully)
> ]
> ,Group "adhoc lexer tests" $
> map (uncurry $ LexerTest SQL2011)
> map (uncurry $ LexerTest ansi2011)
> [("", [])
> ,("-- line com\nstuff", [LineComment "-- line com\n",Identifier "stuff"])
> ]

10
tools/Language/SQL/SimpleSQL/MySQL.lhs
View file

@ -18,20 +18,20 @@ limit syntax
[LIMIT {[offset,] row_count | row_count OFFSET offset}]
> backtickQuotes :: TestItem
> backtickQuotes = Group "backtickQuotes" (map (uncurry (TestValueExpr MySQL))
> backtickQuotes = Group "backtickQuotes" (map (uncurry (TestValueExpr mysql))
> [("`test`", Iden [DQName "`" "`" "test"])
> ]
> ++ [ParseValueExprFails SQL2011 "`test`"]
> ++ [ParseValueExprFails ansi2011 "`test`"]
> )
> limit :: TestItem
> limit = Group "queries" ( map (uncurry (TestQueryExpr MySQL))
> limit = Group "queries" ( map (uncurry (TestQueryExpr mysql))
> [("select * from t limit 5"
> ,sel {qeFetchFirst = Just (NumLit "5")}
> )
> ]
> ++ [ParseQueryExprFails MySQL "select a from t fetch next 10 rows only;"
> ,ParseQueryExprFails SQL2011 "select * from t limit 5"]
> ++ [ParseQueryExprFails mysql "select a from t fetch next 10 rows only;"
> ,ParseQueryExprFails ansi2011 "select * from t limit 5"]
> )
> where
> sel = makeSelect

2
tools/Language/SQL/SimpleSQL/Postgres.lhs
View file

@ -8,7 +8,7 @@ revisited when the dialect support is added.
> import Language.SQL.SimpleSQL.TestTypes
> postgresTests :: TestItem
> postgresTests = Group "postgresTests" $ map (ParseQueryExpr SQL2011)
> postgresTests = Group "postgresTests" $ map (ParseQueryExpr ansi2011)
lexical syntax section

20
tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
View file

@ -28,7 +28,7 @@ These are a few misc tests which don't fit anywhere else.
> duplicates :: TestItem
> duplicates = Group "duplicates" $ map (uncurry (TestQueryExpr SQL2011))
> duplicates = Group "duplicates" $ map (uncurry (TestQueryExpr ansi2011))
> [("select a from t" ,ms SQDefault)
> ,("select all a from t" ,ms All)
> ,("select distinct a from t", ms Distinct)
@ -40,7 +40,7 @@ These are a few misc tests which don't fit anywhere else.
> ,qeFrom = [TRSimple [Name "t"]]}
> selectLists :: TestItem
> selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr SQL2011))
> selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr ansi2011))
> [("select 1",
> makeSelect {qeSelectList = [(NumLit "1",Nothing)]})
@ -73,7 +73,7 @@ These are a few misc tests which don't fit anywhere else.
> ]
> whereClause :: TestItem
> whereClause = Group "whereClause" $ map (uncurry (TestQueryExpr SQL2011))
> whereClause = Group "whereClause" $ map (uncurry (TestQueryExpr ansi2011))
> [("select a from t where a = 5"
> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)]
> ,qeFrom = [TRSimple [Name "t"]]
@ -81,7 +81,7 @@ These are a few misc tests which don't fit anywhere else.
> ]
> having :: TestItem
> having = Group "having" $ map (uncurry (TestQueryExpr SQL2011))
> having = Group "having" $ map (uncurry (TestQueryExpr ansi2011))
> [("select a,sum(b) from t group by a having sum(b) > 5"
> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)
> ,(App [Name "sum"] [Iden [Name "b"]],Nothing)]
@ -93,7 +93,7 @@ These are a few misc tests which don't fit anywhere else.
> ]
> orderBy :: TestItem
> orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr SQL2011))
> orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr ansi2011))
> [("select a from t order by a"
> ,ms [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault])
@ -119,7 +119,7 @@ These are a few misc tests which don't fit anywhere else.
> ,qeOrderBy = o}
> offsetFetch :: TestItem
> offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr SQL2011))
> offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr ansi2011))
> [-- ansi standard
> ("select a from t offset 5 rows fetch next 10 rows only"
> ,ms (Just $ NumLit "5") (Just $ NumLit "10"))
@ -142,7 +142,7 @@ These are a few misc tests which don't fit anywhere else.
> ,qeFetchFirst = l}
> combos :: TestItem
> combos = Group "combos" $ map (uncurry (TestQueryExpr SQL2011))
> combos = Group "combos" $ map (uncurry (TestQueryExpr ansi2011))
> [("select a from t union select b from u"
> ,CombineQueryExpr ms1 Union SQDefault Respectively ms2)
@ -173,7 +173,7 @@ These are a few misc tests which don't fit anywhere else.
> withQueries :: TestItem
> withQueries = Group "with queries" $ map (uncurry (TestQueryExpr SQL2011))
> withQueries = Group "with queries" $ map (uncurry (TestQueryExpr ansi2011))
> [("with u as (select a from t) select a from u"
> ,With False [(Alias (Name "u") Nothing, ms1)] ms2)
@ -197,13 +197,13 @@ These are a few misc tests which don't fit anywhere else.
> ms3 = ms "a" "x"
> values :: TestItem
> values = Group "values" $ map (uncurry (TestQueryExpr SQL2011))
> values = Group "values" $ map (uncurry (TestQueryExpr ansi2011))
> [("values (1,2),(3,4)"
> ,Values [[NumLit "1", NumLit "2"]
> ,[NumLit "3", NumLit "4"]])
> ]
> tables :: TestItem
> tables = Group "tables" $ map (uncurry (TestQueryExpr SQL2011))
> tables = Group "tables" $ map (uncurry (TestQueryExpr ansi2011))
> [("table tbl", Table [Name "tbl"])
> ]

2
tools/Language/SQL/SimpleSQL/QueryExprs.lhs
View file

@ -8,7 +8,7 @@ query expressions from one string.
> import Language.SQL.SimpleSQL.Syntax
> queryExprsTests :: TestItem
> queryExprsTests = Group "query exprs" $ map (uncurry (TestStatements SQL2011))
> queryExprsTests = Group "query exprs" $ map (uncurry (TestStatements ansi2011))
> [("select 1",[ms])
> ,("select 1;",[ms])
> ,("select 1;select 1",[ms,ms])

60
tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs
View file

@ -73,124 +73,124 @@ grant, etc
CURRENT_USER
| CURRENT_ROLE
> (TestStatement SQL2011
> (TestStatement ansi2011
> "grant all privileges on tbl1 to role1"
> $ GrantPrivilege [PrivAll]
> (PrivTable [Name "tbl1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant all privileges on tbl1 to role1,role2"
> $ GrantPrivilege [PrivAll]
> (PrivTable [Name "tbl1"])
> [Name "role1",Name "role2"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant all privileges on tbl1 to role1 with grant option"
> $ GrantPrivilege [PrivAll]
> (PrivTable [Name "tbl1"])
> [Name "role1"] WithGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant all privileges on table tbl1 to role1"
> $ GrantPrivilege [PrivAll]
> (PrivTable [Name "tbl1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant all privileges on domain mydom to role1"
> $ GrantPrivilege [PrivAll]
> (PrivDomain [Name "mydom"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant all privileges on type t1 to role1"
> $ GrantPrivilege [PrivAll]
> (PrivType [Name "t1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant all privileges on sequence s1 to role1"
> $ GrantPrivilege [PrivAll]
> (PrivSequence [Name "s1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant select on table t1 to role1"
> $ GrantPrivilege [PrivSelect []]
> (PrivTable [Name "t1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant select(a,b) on table t1 to role1"
> $ GrantPrivilege [PrivSelect [Name "a", Name "b"]]
> (PrivTable [Name "t1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant delete on table t1 to role1"
> $ GrantPrivilege [PrivDelete]
> (PrivTable [Name "t1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant insert on table t1 to role1"
> $ GrantPrivilege [PrivInsert []]
> (PrivTable [Name "t1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant insert(a,b) on table t1 to role1"
> $ GrantPrivilege [PrivInsert [Name "a", Name "b"]]
> (PrivTable [Name "t1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant update on table t1 to role1"
> $ GrantPrivilege [PrivUpdate []]
> (PrivTable [Name "t1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant update(a,b) on table t1 to role1"
> $ GrantPrivilege [PrivUpdate [Name "a", Name "b"]]
> (PrivTable [Name "t1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant references on table t1 to role1"
> $ GrantPrivilege [PrivReferences []]
> (PrivTable [Name "t1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant references(a,b) on table t1 to role1"
> $ GrantPrivilege [PrivReferences [Name "a", Name "b"]]
> (PrivTable [Name "t1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant usage on table t1 to role1"
> $ GrantPrivilege [PrivUsage]
> (PrivTable [Name "t1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant trigger on table t1 to role1"
> $ GrantPrivilege [PrivTrigger]
> (PrivTable [Name "t1"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant execute on specific function f to role1"
> $ GrantPrivilege [PrivExecute]
> (PrivFunction [Name "f"])
> [Name "role1"] WithoutGrantOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant select,delete on table t1 to role1"
> $ GrantPrivilege [PrivSelect [], PrivDelete]
> (PrivTable [Name "t1"])
@ -217,7 +217,7 @@ functions, etc., by argument types since they can be overloaded
<role definition> ::=
CREATE ROLE <role name> [ WITH ADMIN <grantor> ]
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create role rolee"
> $ CreateRole (Name "rolee"))
@ -233,16 +233,16 @@ functions, etc., by argument types since they can be overloaded
<role granted> ::=
<role name>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant role1 to public"
> $ GrantRole [Name "role1"] [Name "public"] WithoutAdminOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant role1,role2 to role3,role4"
> $ GrantRole [Name "role1",Name "role2"]
> [Name "role3", Name "role4"] WithoutAdminOption)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "grant role1 to role3 with admin option"
> $ GrantRole [Name "role1"] [Name "role3"] WithAdminOption)
@ -252,7 +252,7 @@ functions, etc., by argument types since they can be overloaded
<drop role statement> ::=
DROP ROLE <role name>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "drop role rolee"
> $ DropRole (Name "rolee"))
@ -274,13 +274,13 @@ functions, etc., by argument types since they can be overloaded
| HIERARCHY OPTION FOR
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "revoke select on t1 from role1"
> $ RevokePrivilege NoGrantOptionFor [PrivSelect []]
> (PrivTable [Name "t1"])
> [Name "role1"] DefaultDropBehaviour)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "revoke grant option for select on t1 from role1,role2 cascade"
> $ RevokePrivilege GrantOptionFor [PrivSelect []]
> (PrivTable [Name "t1"])
@ -296,18 +296,18 @@ functions, etc., by argument types since they can be overloaded
<role revoked> ::=
<role name>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "revoke role1 from role2"
> $ RevokeRole NoAdminOptionFor [Name "role1"]
> [Name "role2"] DefaultDropBehaviour)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "revoke role1,role2 from role3,role4"
> $ RevokeRole NoAdminOptionFor [Name "role1",Name "role2"]
> [Name "role3",Name "role4"] DefaultDropBehaviour)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "revoke admin option for role1 from role2 cascade"
> $ RevokeRole AdminOptionFor [Name "role1"] [Name "role2"] Cascade)

16
tools/Language/SQL/SimpleSQL/SQL2011Bits.lhs
View file

@ -22,7 +22,7 @@ commit, savepoint, etc.), and session management (set).
BEGIN is not in the standard!
> (TestStatement SQL2011
> (TestStatement ansi2011
> "start transaction"
> $ StartTransaction)
@ -77,7 +77,7 @@ BEGIN is not in the standard!
<savepoint specifier> ::=
<savepoint name>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "savepoint difficult_bit"
> $ Savepoint $ Name "difficult_bit")
@ -87,7 +87,7 @@ BEGIN is not in the standard!
<release savepoint statement> ::=
RELEASE SAVEPOINT <savepoint specifier>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "release savepoint difficult_bit"
> $ ReleaseSavepoint $ Name "difficult_bit")
@ -97,11 +97,11 @@ BEGIN is not in the standard!
<commit statement> ::=
COMMIT [ WORK ] [ AND [ NO ] CHAIN ]
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "commit"
> $ Commit)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "commit work"
> $ Commit)
@ -114,15 +114,15 @@ BEGIN is not in the standard!
<savepoint clause> ::=
TO SAVEPOINT <savepoint specifier>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "rollback"
> $ Rollback Nothing)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "rollback work"
> $ Rollback Nothing)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "rollback to savepoint difficult_bit"
> $ Rollback $ Just $ Name "difficult_bit")

36
tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.lhs
View file

@ -108,18 +108,18 @@ Section 14 in Foundation
[ [ AS ] <correlation name> ]
[ WHERE <search condition> ]
> (TestStatement SQL2011 "delete from t"
> (TestStatement ansi2011 "delete from t"
> $ Delete [Name "t"] Nothing Nothing)
> ,(TestStatement SQL2011 "delete from t as u"
> ,(TestStatement ansi2011 "delete from t as u"
> $ Delete [Name "t"] (Just (Name "u")) Nothing)
> ,(TestStatement SQL2011 "delete from t where x = 5"
> ,(TestStatement ansi2011 "delete from t where x = 5"
> $ Delete [Name "t"] Nothing
> (Just $ BinOp (Iden [Name "x"]) [Name "="] (NumLit "5")))
> ,(TestStatement SQL2011 "delete from t as u where u.x = 5"
> ,(TestStatement ansi2011 "delete from t as u where u.x = 5"
> $ Delete [Name "t"] (Just (Name "u"))
> (Just $ BinOp (Iden [Name "u", Name "x"]) [Name "="] (NumLit "5")))
@ -132,13 +132,13 @@ Section 14 in Foundation
CONTINUE IDENTITY
| RESTART IDENTITY
> ,(TestStatement SQL2011 "truncate table t"
> ,(TestStatement ansi2011 "truncate table t"
> $ Truncate [Name "t"] DefaultIdentityRestart)
> ,(TestStatement SQL2011 "truncate table t continue identity"
> ,(TestStatement ansi2011 "truncate table t continue identity"
> $ Truncate [Name "t"] ContinueIdentity)
> ,(TestStatement SQL2011 "truncate table t restart identity"
> ,(TestStatement ansi2011 "truncate table t restart identity"
> $ Truncate [Name "t"] RestartIdentity)
@ -175,31 +175,31 @@ Section 14 in Foundation
<insert column list> ::=
<column name list>
> ,(TestStatement SQL2011 "insert into t select * from u"
> ,(TestStatement ansi2011 "insert into t select * from u"
> $ Insert [Name "t"] Nothing
> $ InsertQuery makeSelect
> {qeSelectList = [(Star, Nothing)]
> ,qeFrom = [TRSimple [Name "u"]]})
> ,(TestStatement SQL2011 "insert into t(a,b,c) select * from u"
> ,(TestStatement ansi2011 "insert into t(a,b,c) select * from u"
> $ Insert [Name "t"] (Just [Name "a", Name "b", Name "c"])
> $ InsertQuery makeSelect
> {qeSelectList = [(Star, Nothing)]
> ,qeFrom = [TRSimple [Name "u"]]})
> ,(TestStatement SQL2011 "insert into t default values"
> ,(TestStatement ansi2011 "insert into t default values"
> $ Insert [Name "t"] Nothing DefaultInsertValues)
> ,(TestStatement SQL2011 "insert into t values(1,2)"
> ,(TestStatement ansi2011 "insert into t values(1,2)"
> $ Insert [Name "t"] Nothing
> $ InsertQuery $ Values [[NumLit "1", NumLit "2"]])
> ,(TestStatement SQL2011 "insert into t values (1,2),(3,4)"
> ,(TestStatement ansi2011 "insert into t values (1,2),(3,4)"
> $ Insert [Name "t"] Nothing
> $ InsertQuery $ Values [[NumLit "1", NumLit "2"]
> ,[NumLit "3", NumLit "4"]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "insert into t values (default,null,array[],multiset[])"
> $ Insert [Name "t"] Nothing
> $ InsertQuery $ Values [[Iden [Name "default"]
@ -447,29 +447,29 @@ FROM CentralOfficeAccounts;
[ WHERE <search condition> ]
> ,(TestStatement SQL2011 "update t set a=b"
> ,(TestStatement ansi2011 "update t set a=b"
> $ Update [Name "t"] Nothing
> [Set [Name "a"] (Iden [Name "b"])] Nothing)
> ,(TestStatement SQL2011 "update t set a=b, c=5"
> ,(TestStatement ansi2011 "update t set a=b, c=5"
> $ Update [Name "t"] Nothing
> [Set [Name "a"] (Iden [Name "b"])
> ,Set [Name "c"] (NumLit "5")] Nothing)
> ,(TestStatement SQL2011 "update t set a=b where a>5"
> ,(TestStatement ansi2011 "update t set a=b where a>5"
> $ Update [Name "t"] Nothing
> [Set [Name "a"] (Iden [Name "b"])]
> $ Just $ BinOp (Iden [Name "a"]) [Name ">"] (NumLit "5"))
> ,(TestStatement SQL2011 "update t as u set a=b where u.a>5"
> ,(TestStatement ansi2011 "update t as u set a=b where u.a>5"
> $ Update [Name "t"] (Just $ Name "u")
> [Set [Name "a"] (Iden [Name "b"])]
> $ Just $ BinOp (Iden [Name "u",Name "a"])
> [Name ">"] (NumLit "5"))
> ,(TestStatement SQL2011 "update t set (a,b)=(3,5)"
> ,(TestStatement ansi2011 "update t set (a,b)=(3,5)"
> $ Update [Name "t"] Nothing
> [SetMultiple [[Name "a"],[Name "b"]]
> [NumLit "3", NumLit "5"]] Nothing)

100
tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs
View file

@ -504,7 +504,7 @@ Specify a non-null value.
> characterStringLiterals :: TestItem
> characterStringLiterals = Group "character string literals"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("'a regular string literal'"
> ,StringLit "a regular string literal")
> ,("'something' ' some more' 'and more'"
@ -532,7 +532,7 @@ character set allows them.
> nationalCharacterStringLiterals :: TestItem
> nationalCharacterStringLiterals = Group "national character string literals"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("N'something'", CSStringLit "N" "something")
> ,("n'something'", CSStringLit "n" "something")
> ]
@ -549,7 +549,7 @@ character set allows them.
> unicodeCharacterStringLiterals :: TestItem
> unicodeCharacterStringLiterals = Group "unicode character string literals"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("U&'something'", CSStringLit "U&" "something")
> ,("u&'something' escape ="
> ,Escape (CSStringLit "u&" "something") '=')
@ -568,7 +568,7 @@ TODO: unicode escape
> binaryStringLiterals :: TestItem
> binaryStringLiterals = Group "binary string literals"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [--("B'101010'", CSStringLit "B" "101010")
> ("X'7f7f7f'", CSStringLit "X" "7f7f7f")
> ,("X'7f7f7f' escape z", Escape (CSStringLit "X" "7f7f7f") 'z')
@ -598,7 +598,7 @@ TODO: unicode escape
> numericLiterals :: TestItem
> numericLiterals = Group "numeric literals"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("11", NumLit "11")
> ,("11.11", NumLit "11.11")
@ -704,7 +704,7 @@ TODO: unicode escape
> intervalLiterals :: TestItem
> intervalLiterals = Group "intervalLiterals literals"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("interval '1'", TypedLit (TypeName [Name "interval"]) "1")
> ,("interval '1' day"
> ,IntervalLit Nothing "1" (Itf "day" Nothing) Nothing)
@ -727,7 +727,7 @@ TODO: unicode escape
> booleanLiterals :: TestItem
> booleanLiterals = Group "boolean literals"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("true", Iden [Name "true"])
> ,("false", Iden [Name "false"])
> ,("unknown", Iden [Name "unknown"])
@ -747,7 +747,7 @@ Specify names.
> identifiers :: TestItem
> identifiers = Group "identifiers"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("test",Iden [Name "test"])
> ,("_test",Iden [Name "_test"])
> ,("t1",Iden [Name "t1"])
@ -1188,11 +1188,11 @@ expression
> typeNameTests :: TestItem
> typeNameTests = Group "type names"
> [Group "type names" $ map (uncurry (TestValueExpr SQL2011))
> [Group "type names" $ map (uncurry (TestValueExpr ansi2011))
> $ concatMap makeSimpleTests $ fst typeNames
> ,Group "generated casts" $ map (uncurry (TestValueExpr SQL2011))
> ,Group "generated casts" $ map (uncurry (TestValueExpr ansi2011))
> $ concatMap makeCastTests $ fst typeNames
> ,Group "generated typename" $ map (uncurry (TestValueExpr SQL2011))
> ,Group "generated typename" $ map (uncurry (TestValueExpr ansi2011))
> $ concatMap makeTests $ snd typeNames]
> where
> makeSimpleTests (ctn, stn) =
@ -1213,7 +1213,7 @@ Define a field of a row type.
> fieldDefinition :: TestItem
> fieldDefinition = Group "field definition"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("cast('(1,2)' as row(a int,b char))"
> ,Cast (StringLit "(1,2)")
> $ RowTypeName [(Name "a", TypeName [Name "int"])
@ -1293,7 +1293,7 @@ Specify a value that is syntactically self-delimited.
> parenthesizedValueExpression :: TestItem
> parenthesizedValueExpression = Group "parenthesized value expression"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("(3)", Parens (NumLit "3"))
> ,("((3))", Parens $ Parens (NumLit "3"))
> ]
@ -1329,7 +1329,7 @@ Specify one or more values, host parameters, SQL parameters, dynamic parameters,
> generalValueSpecification :: TestItem
> generalValueSpecification = Group "general value specification"
> $ map (uncurry (TestValueExpr SQL2011)) $
> $ map (uncurry (TestValueExpr ansi2011)) $
> map mkIden ["CURRENT_DEFAULT_TRANSFORM_GROUP"
> ,"CURRENT_PATH"
> ,"CURRENT_ROLE"
@ -1383,7 +1383,7 @@ TODO: add the missing bits
> parameterSpecification :: TestItem
> parameterSpecification = Group "parameter specification"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [(":hostparam", HostParameter "hostparam" Nothing)
> ,(":hostparam indicator :another_host_param"
> ,HostParameter "hostparam" $ Just "another_host_param")
@ -1420,7 +1420,7 @@ Specify a value whose data type is to be inferred from its context.
> contextuallyTypedValueSpecification :: TestItem
> contextuallyTypedValueSpecification =
> Group "contextually typed value specification"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("null", Iden [Name "null"])
> ,("array[]", Array (Iden [Name "array"]) [])
> ,("multiset[]", MultisetCtor [])
@ -1438,7 +1438,7 @@ Disambiguate a <period>-separated chain of identifiers.
> identifierChain :: TestItem
> identifierChain = Group "identifier chain"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("a.b", Iden [Name "a",Name "b"])]
== 6.7 <column reference>
@ -1452,7 +1452,7 @@ Reference a column.
> columnReference :: TestItem
> columnReference = Group "column reference"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("module.a.b", Iden [Name "module",Name "a",Name "b"])]
== 6.8 <SQL parameter reference>
@ -1475,7 +1475,7 @@ Specify a value derived by the application of a function to an argument.
> setFunctionSpecification :: TestItem
> setFunctionSpecification = Group "set function specification"
> $ map (uncurry (TestQueryExpr SQL2011))
> $ map (uncurry (TestQueryExpr ansi2011))
> [("SELECT SalesQuota, SUM(SalesYTD) TotalSalesYTD,\n\
> \ GROUPING(SalesQuota) AS Grouping\n\
> \FROM Sales.SalesPerson\n\
@ -1676,7 +1676,7 @@ Specify a data conversion.
> castSpecification :: TestItem
> castSpecification = Group "cast specification"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("cast(a as int)"
> ,Cast (Iden [Name "a"]) (TypeName [Name "int"]))
> ]
@ -1690,7 +1690,7 @@ Return the next value of a sequence generator.
> nextValueExpression :: TestItem
> nextValueExpression = Group "next value expression"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("next value for a.b", NextValueFor [Name "a", Name "b"])
> ]
@ -1703,7 +1703,7 @@ Reference a field of a row value.
> fieldReference :: TestItem
> fieldReference = Group "field reference"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("f(something).a"
> ,BinOp (App [Name "f"] [Iden [Name "something"]])
> [Name "."]
@ -1827,7 +1827,7 @@ Return an element of an array.
> arrayElementReference :: TestItem
> arrayElementReference = Group "array element reference"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("something[3]"
> ,Array (Iden [Name "something"]) [NumLit "3"])
> ,("(something(a))[x]"
@ -1850,7 +1850,7 @@ Return the sole element of a multiset of one element.
> multisetElementReference :: TestItem
> multisetElementReference = Group "multisetElementReference"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("element(something)"
> ,App [Name "element"] [Iden [Name "something"]])
> ]
@ -1900,7 +1900,7 @@ Specify a numeric value.
> numericValueExpression :: TestItem
> numericValueExpression = Group "numeric value expression"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("a + b", binOp "+")
> ,("a - b", binOp "-")
> ,("a * b", binOp "*")
@ -2357,7 +2357,7 @@ Specify a boolean value.
> booleanValueExpression :: TestItem
> booleanValueExpression = Group "booleab value expression"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("a or b", BinOp a [Name "or"] b)
> ,("a and b", BinOp a [Name "and"] b)
> ,("not a", PrefixOp [Name "not"] a)
@ -2432,7 +2432,7 @@ Specify construction of an array.
> arrayValueConstructor :: TestItem
> arrayValueConstructor = Group "array value constructor"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("array[1,2,3]"
> ,Array (Iden [Name "array"])
> [NumLit "1", NumLit "2", NumLit "3"])
@ -2470,7 +2470,7 @@ Specify a multiset value.
> multisetValueExpression :: TestItem
> multisetValueExpression = Group "multiset value expression"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("a multiset union b"
> ,MultisetBinOp (Iden [Name "a"]) Union SQDefault (Iden [Name "b"]))
> ,("a multiset union all b"
@ -2500,7 +2500,7 @@ special case term.
> multisetValueFunction :: TestItem
> multisetValueFunction = Group "multiset value function"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("set(a)", App [Name "set"] [Iden [Name "a"]])
> ]
@ -2528,7 +2528,7 @@ Specify construction of a multiset.
> multisetValueConstructor :: TestItem
> multisetValueConstructor = Group "multiset value constructor"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("multiset[a,b,c]", MultisetCtor[Iden [Name "a"]
> ,Iden [Name "b"], Iden [Name "c"]])
> ,("multiset(select * from t)", MultisetQueryCtor qe)
@ -2606,7 +2606,7 @@ Specify a value or list of values to be constructed into a row.
> rowValueConstructor :: TestItem
> rowValueConstructor = Group "row value constructor"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("(a,b)"
> ,SpecialOp [Name "rowctor"] [Iden [Name "a"], Iden [Name "b"]])
> ,("row(1)",App [Name "row"] [NumLit "1"])
@ -2657,7 +2657,7 @@ Specify a set of <row value expression>s to be constructed into a table.
> tableValueConstructor :: TestItem
> tableValueConstructor = Group "table value constructor"
> $ map (uncurry (TestQueryExpr SQL2011))
> $ map (uncurry (TestQueryExpr ansi2011))
> [("values (1,2), (a+b,(select count(*) from t));"
> ,Values [[NumLit "1", NumLit "2"]
> ,[BinOp (Iden [Name "a"]) [Name "+"]
@ -2692,7 +2692,7 @@ Specify a table derived from one or more tables.
> fromClause :: TestItem
> fromClause = Group "fromClause"
> $ map (uncurry (TestQueryExpr SQL2011))
> $ map (uncurry (TestQueryExpr ansi2011))
> [("select * from tbl1,tbl2"
> ,makeSelect
> {qeSelectList = [(Star, Nothing)]
@ -2707,7 +2707,7 @@ Reference a table.
> tableReference :: TestItem
> tableReference = Group "table reference"
> $ map (uncurry (TestQueryExpr SQL2011))
> $ map (uncurry (TestQueryExpr ansi2011))
> [("select * from t", sel)
<table reference> ::= <table factor> | <joined table>
@ -2888,7 +2888,7 @@ Specify a table derived from a Cartesian product, inner join, or outer join.
> joinedTable :: TestItem
> joinedTable = Group "joined table"
> $ map (uncurry (TestQueryExpr SQL2011))
> $ map (uncurry (TestQueryExpr ansi2011))
> [("select * from a cross join b"
> ,sel $ TRJoin a False JCross b Nothing)
> ,("select * from a join b on true"
@ -2945,7 +2945,7 @@ the result of the preceding <from clause>.
> whereClause :: TestItem
> whereClause = Group "where clause"
> $ map (uncurry (TestQueryExpr SQL2011))
> $ map (uncurry (TestQueryExpr ansi2011))
> [("select * from t where a = 5"
> ,makeSelect
> {qeSelectList = [(Star,Nothing)]
@ -3005,7 +3005,7 @@ clause> to the result of the previously specified clause.
> groupByClause :: TestItem
> groupByClause = Group "group by clause"
> $ map (uncurry (TestQueryExpr SQL2011))
> $ map (uncurry (TestQueryExpr ansi2011))
> [("select a,sum(x) from t group by a"
> ,qe [SimpleGroup $ Iden [Name "a"]])
> ,("select a,sum(x) from t group by a collate c"
@ -3053,7 +3053,7 @@ not satisfy a <search condition>.
> havingClause :: TestItem
> havingClause = Group "having clause"
> $ map (uncurry (TestQueryExpr SQL2011))
> $ map (uncurry (TestQueryExpr ansi2011))
> [("select a,sum(x) from t group by a having sum(x) > 1000"
> ,makeSelect
> {qeSelectList = [(Iden [Name "a"], Nothing)
@ -3176,7 +3176,7 @@ Specify a table derived from the result of a <table expression>.
> querySpecification :: TestItem
> querySpecification = Group "query specification"
> $ map (uncurry (TestQueryExpr SQL2011))
> $ map (uncurry (TestQueryExpr ansi2011))
> [("select a from t",qe)
> ,("select all a from t",qe {qeSetQuantifier = All})
> ,("select distinct a from t",qe {qeSetQuantifier = Distinct})
@ -3244,7 +3244,7 @@ Specify a table.
> setOpQueryExpression :: TestItem
> setOpQueryExpression= Group "set operation query expression"
> $ map (uncurry (TestQueryExpr SQL2011))
> $ map (uncurry (TestQueryExpr ansi2011))
> -- todo: complete setop query expression tests
> [{-("select * from t union select * from t"
> ,undefined)
@ -3281,7 +3281,7 @@ everywhere
> explicitTableQueryExpression :: TestItem
> explicitTableQueryExpression= Group "explicit table query expression"
> $ map (uncurry (TestQueryExpr SQL2011))
> $ map (uncurry (TestQueryExpr ansi2011))
> [("table t", Table [Name "t"])
> ]
@ -3303,7 +3303,7 @@ everywhere
> orderOffsetFetchQueryExpression :: TestItem
> orderOffsetFetchQueryExpression = Group "order, offset, fetch query expression"
> $ map (uncurry (TestQueryExpr SQL2011))
> $ map (uncurry (TestQueryExpr ansi2011))
> [-- todo: finish tests for order offset and fetch
> ("select a from t order by a"
> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])
@ -3460,7 +3460,7 @@ Specify a comparison of two row values.
> comparisonPredicates :: TestItem
> comparisonPredicates = Group "comparison predicates"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> $ map mkOp ["=", "<>", "<", ">", "<=", ">="]
> ++ [("ROW(a) = ROW(b)"
> ,BinOp (App [Name "ROW"] [a])
@ -3664,7 +3664,7 @@ Specify a quantified comparison.
> quantifiedComparisonPredicate :: TestItem
> quantifiedComparisonPredicate = Group "quantified comparison predicate"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("a = any (select * from t)"
> ,QuantifiedComparison (Iden [Name "a"]) [Name "="] CPAny qe)
@ -3691,7 +3691,7 @@ Specify a test for a non-empty set.
> existsPredicate :: TestItem
> existsPredicate = Group "exists predicate"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("exists(select * from t where a = 4)"
> ,SubQueryExpr SqExists
> $ makeSelect
@ -3710,7 +3710,7 @@ Specify a test for the absence of duplicate rows.
> uniquePredicate :: TestItem
> uniquePredicate = Group "unique predicate"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("unique(select * from t where a = 4)"
> ,SubQueryExpr SqUnique
> $ makeSelect
@ -3746,7 +3746,7 @@ Specify a test for matching rows.
> matchPredicate :: TestItem
> matchPredicate = Group "match predicate"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("a match (select a from t)"
> ,Match (Iden [Name "a"]) False qe)
> ,("(a,b) match (select a,b from t)"
@ -4098,7 +4098,7 @@ Specify a default collation.
> collateClause :: TestItem
> collateClause = Group "collate clause"
> $ map (uncurry (TestValueExpr SQL2011))
> $ map (uncurry (TestValueExpr ansi2011))
> [("a collate my_collation"
> ,Collate (Iden [Name "a"]) [Name "my_collation"])]
@ -4209,7 +4209,7 @@ Specify a value computed from a collection of rows.
> aggregateFunction :: TestItem
> aggregateFunction = Group "aggregate function"
> $ map (uncurry (TestValueExpr SQL2011)) $
> $ map (uncurry (TestValueExpr ansi2011)) $
> [("count(*)",App [Name "count"] [Star])
> ,("count(*) filter (where something > 5)"
> ,AggregateApp [Name "count"] SQDefault [Star] [] fil)
@ -4304,7 +4304,7 @@ Specify a sort order.
> sortSpecificationList :: TestItem
> sortSpecificationList = Group "sort specification list"
> $ map (uncurry (TestQueryExpr SQL2011))
> $ map (uncurry (TestQueryExpr ansi2011))
> [("select * from t order by a"
> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])
> DirDefault NullsOrderDefault]})

164
tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs
View file

@ -20,7 +20,7 @@ This module covers the tests for parsing schema and DDL statements.
[ <schema character set or path> ]
[ <schema element>... ]
> (TestStatement SQL2011 "create schema my_schema"
> (TestStatement ansi2011 "create schema my_schema"
> $ CreateSchema [Name "my_schema"])
todo: schema name can have .
@ -79,11 +79,11 @@ add schema element support:
| RESTRICT
> ,(TestStatement SQL2011 "drop schema my_schema"
> ,(TestStatement ansi2011 "drop schema my_schema"
> $ DropSchema [Name "my_schema"] DefaultDropBehaviour)
> ,(TestStatement SQL2011 "drop schema my_schema cascade"
> ,(TestStatement ansi2011 "drop schema my_schema cascade"
> $ DropSchema [Name "my_schema"] Cascade)
> ,(TestStatement SQL2011 "drop schema my_schema restrict"
> ,(TestStatement ansi2011 "drop schema my_schema restrict"
> $ DropSchema [Name "my_schema"] Restrict)
11.3 <table definition>
@ -94,7 +94,7 @@ add schema element support:
[ WITH <system versioning clause> ]
[ ON COMMIT <table commit action> ROWS ]
> ,(TestStatement SQL2011 "create table t (a int, b int);"
> ,(TestStatement ansi2011 "create table t (a int, b int);"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing []
> ,TableColumnDef $ ColumnDef (Name "b") (TypeName [Name "int"]) Nothing []])
@ -310,25 +310,25 @@ not null | unique | references | check
todo: constraint characteristics
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int not null);"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
> [ColConstraintDef Nothing ColNotNullConstraint]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int constraint a_not_null not null);"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
> [ColConstraintDef (Just [Name "a_not_null"]) ColNotNullConstraint]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int unique);"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
> [ColConstraintDef Nothing ColUniqueConstraint]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int primary key);"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
@ -339,7 +339,7 @@ references t(a,b)
[perm: on update [cascade | set null | set default | restrict | no action]
on delete ""
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int references u);"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
@ -347,7 +347,7 @@ references t(a,b)
> [Name "u"] Nothing DefaultReferenceMatch
> DefaultReferentialAction DefaultReferentialAction]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int references u(a));"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
@ -355,7 +355,7 @@ references t(a,b)
> [Name "u"] (Just $ Name "a") DefaultReferenceMatch
> DefaultReferentialAction DefaultReferentialAction]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int references u match full);"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
@ -363,7 +363,7 @@ references t(a,b)
> [Name "u"] Nothing MatchFull
> DefaultReferentialAction DefaultReferentialAction]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int references u match partial);"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
@ -371,7 +371,7 @@ references t(a,b)
> [Name "u"] Nothing MatchPartial
> DefaultReferentialAction DefaultReferentialAction]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int references u match simple);"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
@ -379,7 +379,7 @@ references t(a,b)
> [Name "u"] Nothing MatchSimple
> DefaultReferentialAction DefaultReferentialAction]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int references u on update cascade );"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
@ -387,7 +387,7 @@ references t(a,b)
> [Name "u"] Nothing DefaultReferenceMatch
> RefCascade DefaultReferentialAction]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int references u on update set null );"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
@ -395,7 +395,7 @@ references t(a,b)
> [Name "u"] Nothing DefaultReferenceMatch
> RefSetNull DefaultReferentialAction]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int references u on update set default );"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
@ -403,7 +403,7 @@ references t(a,b)
> [Name "u"] Nothing DefaultReferenceMatch
> RefSetDefault DefaultReferentialAction]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int references u on update no action );"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
@ -411,7 +411,7 @@ references t(a,b)
> [Name "u"] Nothing DefaultReferenceMatch
> RefNoAction DefaultReferentialAction]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int references u on delete cascade );"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
@ -420,7 +420,7 @@ references t(a,b)
> DefaultReferentialAction RefCascade]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int references u on update cascade on delete restrict );"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
@ -428,7 +428,7 @@ references t(a,b)
> [Name "u"] Nothing DefaultReferenceMatch
> RefCascade RefRestrict]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int references u on delete restrict on update cascade );"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
@ -440,7 +440,7 @@ TODO: try combinations and permutations of column constraints and
options
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int check (a>5));"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing
@ -455,18 +455,18 @@ options
GENERATED { ALWAYS | BY DEFAULT } AS IDENTITY
[ <left paren> <common sequence generator options> <right paren> ]
> ,(TestStatement SQL2011 "create table t (a int generated always as identity);"
> ,(TestStatement ansi2011 "create table t (a int generated always as identity);"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"])
> (Just $ IdentityColumnSpec GeneratedAlways []) []])
> ,(TestStatement SQL2011 "create table t (a int generated by default as identity);"
> ,(TestStatement ansi2011 "create table t (a int generated by default as identity);"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"])
> (Just $ IdentityColumnSpec GeneratedByDefault []) []])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int generated always as identity\n\
> \ ( start with 5 increment by 5 maxvalue 500 minvalue 5 cycle ));"
> $ CreateTable [Name "t"]
@ -478,7 +478,7 @@ options
> ,SGOMinValue 5
> ,SGOCycle]) []])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int generated always as identity\n\
> \ ( start with -4 no maxvalue no minvalue no cycle ));"
> $ CreateTable [Name "t"]
@ -506,7 +506,7 @@ generated always (valueexpr)
<generation expression> ::=
<left paren> <value expression> <right paren>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int, \n\
> \ a2 int generated always as (a * 2));"
> $ CreateTable [Name "t"]
@ -536,7 +536,7 @@ generated always (valueexpr)
| <implicitly typed value specification>
> ,(TestStatement SQL2011 "create table t (a int default 0);"
> ,(TestStatement ansi2011 "create table t (a int default 0);"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"])
> (Just $ DefaultClause $ NumLit "0") []])
@ -568,14 +568,14 @@ generated always (valueexpr)
<unique column list> ::=
<column name list>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int, unique (a));"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing []
> ,TableConstraintDef Nothing $ TableUniqueConstraint [Name "a"]
> ])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int, constraint a_unique unique (a));"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing []
@ -585,7 +585,7 @@ generated always (valueexpr)
todo: test permutations of column defs and table constraints
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int, b int, unique (a,b));"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing []
@ -594,7 +594,7 @@ todo: test permutations of column defs and table constraints
> TableUniqueConstraint [Name "a", Name "b"]
> ])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int, b int, primary key (a,b));"
> $ CreateTable [Name "t"]
> [TableColumnDef $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing []
@ -618,7 +618,7 @@ defintely skip
<references specification>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int, b int,\n\
> \ foreign key (a,b) references u(c,d) match full on update cascade on delete restrict );"
> $ CreateTable [Name "t"]
@ -632,7 +632,7 @@ defintely skip
> MatchFull RefCascade RefRestrict
> ])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int,\n\
> \ constraint tfku1 foreign key (a) references u);"
> $ CreateTable [Name "t"]
@ -700,7 +700,7 @@ defintely skip
<check constraint definition> ::=
CHECK <left paren> <search condition> <right paren>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int, b int, \n\
> \ check (a > b));"
> $ CreateTable [Name "t"]
@ -712,7 +712,7 @@ defintely skip
> ])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create table t (a int, b int, \n\
> \ constraint agtb check (a > b));"
> $ CreateTable [Name "t"]
@ -753,7 +753,7 @@ alter table t add column a int
alter table t add a int
alter table t add a int unique not null check (a>0)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter table t add column a int"
> $ AlterTable [Name "t"] $ AddColumnDef
> $ ColumnDef (Name "a") (TypeName [Name "int"]) Nothing []
@ -785,7 +785,7 @@ todo: more add column
SET <default clause>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter table t alter column c set default 0"
> $ AlterTable [Name "t"] $ AlterColumnSetDefault (Name "c")
> $ NumLit "0")
@ -795,7 +795,7 @@ todo: more add column
<drop column default clause> ::=
DROP DEFAULT
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter table t alter column c drop default"
> $ AlterTable [Name "t"] $ AlterColumnDropDefault (Name "c"))
@ -805,7 +805,7 @@ todo: more add column
<set column not null clause> ::=
SET NOT NULL
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter table t alter column c set not null"
> $ AlterTable [Name "t"] $ AlterColumnSetNotNull (Name "c"))
@ -814,7 +814,7 @@ todo: more add column
<drop column not null clause> ::=
DROP NOT NULL
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter table t alter column c drop not null"
> $ AlterTable [Name "t"] $ AlterColumnDropNotNull (Name "c"))
@ -833,7 +833,7 @@ todo: more add column
<alter column data type clause> ::=
SET DATA TYPE <data type>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter table t alter column c set data type int;"
> $ AlterTable [Name "t"] $
> AlterColumnSetDataType (Name "c") (TypeName [Name "int"]))
@ -932,17 +932,17 @@ included in the generated plan above
<drop column definition> ::=
DROP [ COLUMN ] <column name> <drop behavior>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter table t drop column c"
> $ AlterTable [Name "t"] $
> DropColumn (Name "c") DefaultDropBehaviour)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter table t drop c cascade"
> $ AlterTable [Name "t"] $
> DropColumn (Name "c") Cascade)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter table t drop c restrict"
> $ AlterTable [Name "t"] $
> DropColumn (Name "c") Restrict)
@ -954,13 +954,13 @@ included in the generated plan above
<add table constraint definition> ::=
ADD <table constraint definition>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter table t add constraint c unique (a,b)"
> $ AlterTable [Name "t"] $
> AddTableConstraintDef (Just [Name "c"])
> $ TableUniqueConstraint [Name "a", Name "b"])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter table t add unique (a,b)"
> $ AlterTable [Name "t"] $
> AddTableConstraintDef Nothing
@ -978,12 +978,12 @@ todo
<drop table constraint definition> ::=
DROP CONSTRAINT <constraint name> <drop behavior>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter table t drop constraint c"
> $ AlterTable [Name "t"] $
> DropTableConstraintDef [Name "c"] DefaultDropBehaviour)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter table t drop constraint c restrict"
> $ AlterTable [Name "t"] $
> DropTableConstraintDef [Name "c"] Restrict)
@ -1036,11 +1036,11 @@ defintely skip
<drop table statement> ::=
DROP TABLE <table name> <drop behavior>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "drop table t"
> $ DropTable [Name "t"] DefaultDropBehaviour)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "drop table t restrict"
> $ DropTable [Name "t"] Restrict)
@ -1082,7 +1082,7 @@ defintely skip
<view column list> ::=
<column name list>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create view v as select * from t"
> $ CreateView False [Name "v"] Nothing (makeSelect
> {qeSelectList = [(Star, Nothing)]
@ -1090,14 +1090,14 @@ defintely skip
> }) Nothing)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create recursive view v as select * from t"
> $ CreateView True [Name "v"] Nothing (makeSelect
> {qeSelectList = [(Star, Nothing)]
> ,qeFrom = [TRSimple [Name "t"]]
> }) Nothing)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create view v(a,b) as select * from t"
> $ CreateView False [Name "v"] (Just [Name "a", Name "b"])
> (makeSelect
@ -1106,21 +1106,21 @@ defintely skip
> }) Nothing)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create view v as select * from t with check option"
> $ CreateView False [Name "v"] Nothing (makeSelect
> {qeSelectList = [(Star, Nothing)]
> ,qeFrom = [TRSimple [Name "t"]]
> }) (Just DefaultCheckOption))
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create view v as select * from t with cascaded check option"
> $ CreateView False [Name "v"] Nothing (makeSelect
> {qeSelectList = [(Star, Nothing)]
> ,qeFrom = [TRSimple [Name "t"]]
> }) (Just CascadedCheckOption))
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create view v as select * from t with local check option"
> $ CreateView False [Name "v"] Nothing
> (makeSelect
@ -1135,11 +1135,11 @@ defintely skip
DROP VIEW <table name> <drop behavior>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "drop view v"
> $ DropView [Name "v"] DefaultDropBehaviour)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "drop view v cascade"
> $ DropView [Name "v"] Cascade)
@ -1156,32 +1156,32 @@ defintely skip
[ <constraint name definition> ] <check constraint definition> [
<constraint characteristics> ]
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create domain my_int int"
> $ CreateDomain [Name "my_int"]
> (TypeName [Name "int"])
> Nothing [])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create domain my_int as int"
> $ CreateDomain [Name "my_int"]
> (TypeName [Name "int"])
> Nothing [])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create domain my_int int default 0"
> $ CreateDomain [Name "my_int"]
> (TypeName [Name "int"])
> (Just (NumLit "0")) [])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create domain my_int int check (value > 5)"
> $ CreateDomain [Name "my_int"]
> (TypeName [Name "int"])
> Nothing [(Nothing
> ,BinOp (Iden [Name "value"]) [Name ">"] (NumLit "5"))])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create domain my_int int constraint gt5 check (value > 5)"
> $ CreateDomain [Name "my_int"]
> (TypeName [Name "int"])
@ -1206,7 +1206,7 @@ defintely skip
<set domain default clause> ::=
SET <default clause>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter domain my_int set default 0"
> $ AlterDomain [Name "my_int"]
> $ ADSetDefault $ NumLit "0")
@ -1217,7 +1217,7 @@ defintely skip
<drop domain default clause> ::=
DROP DEFAULT
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter domain my_int drop default"
> $ AlterDomain [Name "my_int"]
> $ ADDropDefault)
@ -1228,13 +1228,13 @@ defintely skip
<add domain constraint definition> ::=
ADD <domain constraint>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter domain my_int add check (value > 6)"
> $ AlterDomain [Name "my_int"]
> $ ADAddConstraint Nothing
> $ BinOp (Iden [Name "value"]) [Name ">"] (NumLit "6"))
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter domain my_int add constraint gt6 check (value > 6)"
> $ AlterDomain [Name "my_int"]
> $ ADAddConstraint (Just [Name "gt6"])
@ -1246,7 +1246,7 @@ defintely skip
<drop domain constraint definition> ::=
DROP CONSTRAINT <constraint name>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter domain my_int drop constraint gt6"
> $ AlterDomain [Name "my_int"]
> $ ADDropConstraint [Name "gt6"])
@ -1256,11 +1256,11 @@ defintely skip
<drop domain statement> ::=
DROP DOMAIN <domain name> <drop behavior>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "drop domain my_int"
> $ DropDomain [Name "my_int"] DefaultDropBehaviour)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "drop domain my_int cascade"
> $ DropDomain [Name "my_int"] Cascade)
@ -1332,7 +1332,7 @@ defintely skip
CHECK <left paren> <search condition> <right paren>
[ <constraint characteristics> ]
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create assertion t1_not_empty CHECK ((select count(*) from t1) > 0);"
> $ CreateAssertion [Name "t1_not_empty"]
> $ BinOp (SubQueryExpr SqSq $
@ -1347,11 +1347,11 @@ defintely skip
<drop assertion statement> ::=
DROP ASSERTION <constraint name> [ <drop behavior> ]
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "drop assertion t1_not_empty;"
> $ DropAssertion [Name "t1_not_empty"] DefaultDropBehaviour)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "drop assertion t1_not_empty cascade;"
> $ DropAssertion [Name "t1_not_empty"] Cascade)
@ -1988,16 +1988,16 @@ defintely skip
CYCLE
| NO CYCLE
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create sequence seq"
> $ CreateSequence [Name "seq"] [])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create sequence seq as bigint"
> $ CreateSequence [Name "seq"]
> [SGODataType $ TypeName [Name "bigint"]])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "create sequence seq as bigint start with 5"
> $ CreateSequence [Name "seq"]
> [SGOStartWith 5
@ -2023,17 +2023,17 @@ defintely skip
<sequence generator restart value> ::=
<signed numeric literal>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter sequence seq restart"
> $ AlterSequence [Name "seq"]
> [SGORestart Nothing])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter sequence seq restart with 5"
> $ AlterSequence [Name "seq"]
> [SGORestart $ Just 5])
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "alter sequence seq restart with 5 increment by 5"
> $ AlterSequence [Name "seq"]
> [SGORestart $ Just 5
@ -2045,11 +2045,11 @@ defintely skip
<drop sequence generator statement> ::=
DROP SEQUENCE <sequence generator name> <drop behavior>
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "drop sequence seq"
> $ DropSequence [Name "seq"] DefaultDropBehaviour)
> ,(TestStatement SQL2011
> ,(TestStatement ansi2011
> "drop sequence seq restrict"
> $ DropSequence [Name "seq"] Restrict)

2
tools/Language/SQL/SimpleSQL/TableRefs.lhs
View file

@ -9,7 +9,7 @@ expression
> tableRefTests :: TestItem
> tableRefTests = Group "tableRefTests" $ map (uncurry (TestQueryExpr SQL2011))
> tableRefTests = Group "tableRefTests" $ map (uncurry (TestQueryExpr ansi2011))
> [("select a from t"
> ,ms [TRSimple [Name "t"]])

2
tools/Language/SQL/SimpleSQL/TestTypes.lhs
View file

@ -4,7 +4,7 @@ Tests.lhs module for the 'interpreter'.
> module Language.SQL.SimpleSQL.TestTypes
> (TestItem(..)
> ,Dialect(..)) where
> ,ansi2011,mysql,postgres,oracle,sqlserver) where
> import Language.SQL.SimpleSQL.Syntax
> import Language.SQL.SimpleSQL.Lex (Token)

2
tools/Language/SQL/SimpleSQL/Tpch.lhs
View file

@ -13,7 +13,7 @@ The changes made to the official syntax are:
> tpchTests :: TestItem
> tpchTests =
> Group "parse tpch"
> $ map (ParseQueryExpr SQL2011 . snd) tpchQueries
> $ map (ParseQueryExpr ansi2011 . snd) tpchQueries
> tpchQueries :: [(String,String)]
> tpchQueries =

30
tools/Language/SQL/SimpleSQL/ValueExprs.lhs
View file

@ -23,7 +23,7 @@ Tests for parsing value expressions
> ]
> literals :: TestItem
> literals = Group "literals" $ map (uncurry (TestValueExpr SQL2011))
> literals = Group "literals" $ map (uncurry (TestValueExpr ansi2011))
> [("3", NumLit "3")
> ,("3.", NumLit "3.")
> ,("3.3", NumLit "3.3")
@ -45,27 +45,27 @@ Tests for parsing value expressions
> ]
> identifiers :: TestItem
> identifiers = Group "identifiers" $ map (uncurry (TestValueExpr SQL2011))
> identifiers = Group "identifiers" $ map (uncurry (TestValueExpr ansi2011))
> [("iden1", Iden [Name "iden1"])
> --,("t.a", Iden2 "t" "a")
> ,("\"quoted identifier\"", Iden [QName "quoted identifier"])
> ]
> star :: TestItem
> star = Group "star" $ map (uncurry (TestValueExpr SQL2011))
> star = Group "star" $ map (uncurry (TestValueExpr ansi2011))
> [("*", Star)
> --,("t.*", Star2 "t")
> --,("ROW(t.*,42)", App "ROW" [Star2 "t", NumLit "42"])
> ]
> parameter :: TestItem
> parameter = Group "parameter" $ map (uncurry (TestValueExpr SQL2011))
> parameter = Group "parameter" $ map (uncurry (TestValueExpr ansi2011))
> [("?", Parameter)
> ]
> dots :: TestItem
> dots = Group "dot" $ map (uncurry (TestValueExpr SQL2011))
> dots = Group "dot" $ map (uncurry (TestValueExpr ansi2011))
> [("t.a", Iden [Name "t",Name "a"])
> ,("t.*", BinOp (Iden [Name "t"]) [Name "."] Star)
> ,("a.b.c", Iden [Name "a",Name "b",Name "c"])
@ -73,14 +73,14 @@ Tests for parsing value expressions
> ]
> app :: TestItem
> app = Group "app" $ map (uncurry (TestValueExpr SQL2011))
> app = Group "app" $ map (uncurry (TestValueExpr ansi2011))
> [("f()", App [Name "f"] [])
> ,("f(a)", App [Name "f"] [Iden [Name "a"]])
> ,("f(a,b)", App [Name "f"] [Iden [Name "a"], Iden [Name "b"]])
> ]
> caseexp :: TestItem
> caseexp = Group "caseexp" $ map (uncurry (TestValueExpr SQL2011))
> caseexp = Group "caseexp" $ map (uncurry (TestValueExpr ansi2011))
> [("case a when 1 then 2 end"
> ,Case (Just $ Iden [Name "a"]) [([NumLit "1"]
> ,NumLit "2")] Nothing)
@ -116,7 +116,7 @@ Tests for parsing value expressions
> ,miscOps]
> binaryOperators :: TestItem
> binaryOperators = Group "binaryOperators" $ map (uncurry (TestValueExpr SQL2011))
> binaryOperators = Group "binaryOperators" $ map (uncurry (TestValueExpr ansi2011))
> [("a + b", BinOp (Iden [Name "a"]) [Name "+"] (Iden [Name "b"]))
> -- sanity check fixities
> -- todo: add more fixity checking
@ -131,7 +131,7 @@ Tests for parsing value expressions
> ]
> unaryOperators :: TestItem
> unaryOperators = Group "unaryOperators" $ map (uncurry (TestValueExpr SQL2011))
> unaryOperators = Group "unaryOperators" $ map (uncurry (TestValueExpr ansi2011))
> [("not a", PrefixOp [Name "not"] $ Iden [Name "a"])
> ,("not not a", PrefixOp [Name "not"] $ PrefixOp [Name "not"] $ Iden [Name "a"])
> ,("+a", PrefixOp [Name "+"] $ Iden [Name "a"])
@ -140,7 +140,7 @@ Tests for parsing value expressions
> casts :: TestItem
> casts = Group "operators" $ map (uncurry (TestValueExpr SQL2011))
> casts = Group "operators" $ map (uncurry (TestValueExpr ansi2011))
> [("cast('1' as int)"
> ,Cast (StringLit "1") $ TypeName [Name "int"])
@ -162,7 +162,7 @@ Tests for parsing value expressions
> ]
> subqueries :: TestItem
> subqueries = Group "unaryOperators" $ map (uncurry (TestValueExpr SQL2011))
> subqueries = Group "unaryOperators" $ map (uncurry (TestValueExpr ansi2011))
> [("exists (select a from t)", SubQueryExpr SqExists ms)
> ,("(select a from t)", SubQueryExpr SqSq ms)
@ -188,7 +188,7 @@ Tests for parsing value expressions
> }
> miscOps :: TestItem
> miscOps = Group "unaryOperators" $ map (uncurry (TestValueExpr SQL2011))
> miscOps = Group "unaryOperators" $ map (uncurry (TestValueExpr ansi2011))
> [("a in (1,2,3)"
> ,In True (Iden [Name "a"]) $ InList $ map NumLit ["1","2","3"])
@ -326,7 +326,7 @@ target_string
> ]
> aggregates :: TestItem
> aggregates = Group "aggregates" $ map (uncurry (TestValueExpr SQL2011))
> aggregates = Group "aggregates" $ map (uncurry (TestValueExpr ansi2011))
> [("count(*)",App [Name "count"] [Star])
> ,("sum(a order by a)"
@ -341,7 +341,7 @@ target_string
> ]
> windowFunctions :: TestItem
> windowFunctions = Group "windowFunctions" $ map (uncurry (TestValueExpr SQL2011))
> windowFunctions = Group "windowFunctions" $ map (uncurry (TestValueExpr ansi2011))
> [("max(a) over ()", WindowApp [Name "max"] [Iden [Name "a"]] [] [] Nothing)
> ,("count(*) over ()", WindowApp [Name "count"] [Star] [] [] Nothing)
@ -400,7 +400,7 @@ target_string
> ]
> parens :: TestItem
> parens = Group "parens" $ map (uncurry (TestValueExpr SQL2011))
> parens = Group "parens" $ map (uncurry (TestValueExpr ansi2011))
> [("(a)", Parens (Iden [Name "a"]))
> ,("(a + b)", Parens (BinOp (Iden [Name "a"]) [Name "+"] (Iden [Name "b"])))
> ]