diff --git a/Language/SQL/SimpleSQL/Dialect.lhs b/Language/SQL/SimpleSQL/Dialect.lhs new file mode 100644 index 0000000..e3e0c99 --- /dev/null +++ b/Language/SQL/SimpleSQL/Dialect.lhs @@ -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 diff --git a/Language/SQL/SimpleSQL/Lex.lhs b/Language/SQL/SimpleSQL/Lex.lhs index 4a09d3d..b8a9346 100644 --- a/Language/SQL/SimpleSQL/Lex.lhs +++ b/Language/SQL/SimpleSQL/Lex.lhs @@ -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. diff --git a/Language/SQL/SimpleSQL/Parse.lhs b/Language/SQL/SimpleSQL/Parse.lhs index e1018ef..525153a 100644 --- a/Language/SQL/SimpleSQL/Parse.lhs +++ b/Language/SQL/SimpleSQL/Parse.lhs @@ -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 diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 58fb4cc..9b9502a 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -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 diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index 8399d2a..0bbbb9c 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -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 diff --git a/simple-sql-parser.cabal b/simple-sql-parser.cabal index f05352f..4ca27eb 100644 --- a/simple-sql-parser.cabal +++ b/simple-sql-parser.cabal @@ -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, diff --git a/tools/Language/SQL/SimpleSQL/FullQueries.lhs b/tools/Language/SQL/SimpleSQL/FullQueries.lhs index 6b1bbe8..af7daa5 100644 --- a/tools/Language/SQL/SimpleSQL/FullQueries.lhs +++ b/tools/Language/SQL/SimpleSQL/FullQueries.lhs @@ -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)] diff --git a/tools/Language/SQL/SimpleSQL/GroupBy.lhs b/tools/Language/SQL/SimpleSQL/GroupBy.lhs index 340b5c5..5b5e7e6 100644 --- a/tools/Language/SQL/SimpleSQL/GroupBy.lhs +++ b/tools/Language/SQL/SimpleSQL/GroupBy.lhs @@ -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" diff --git a/tools/Language/SQL/SimpleSQL/LexerTests.lhs b/tools/Language/SQL/SimpleSQL/LexerTests.lhs index d91c808..4103d6a 100644 --- a/tools/Language/SQL/SimpleSQL/LexerTests.lhs +++ b/tools/Language/SQL/SimpleSQL/LexerTests.lhs @@ -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"]) > ] diff --git a/tools/Language/SQL/SimpleSQL/MySQL.lhs b/tools/Language/SQL/SimpleSQL/MySQL.lhs index cdaf7e5..6c53eb6 100644 --- a/tools/Language/SQL/SimpleSQL/MySQL.lhs +++ b/tools/Language/SQL/SimpleSQL/MySQL.lhs @@ -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 diff --git a/tools/Language/SQL/SimpleSQL/Postgres.lhs b/tools/Language/SQL/SimpleSQL/Postgres.lhs index 209f522..5a596be 100644 --- a/tools/Language/SQL/SimpleSQL/Postgres.lhs +++ b/tools/Language/SQL/SimpleSQL/Postgres.lhs @@ -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 diff --git a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs index 7427bc3..ec82dbf 100644 --- a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs +++ b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs @@ -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"]) > ] diff --git a/tools/Language/SQL/SimpleSQL/QueryExprs.lhs b/tools/Language/SQL/SimpleSQL/QueryExprs.lhs index f7eaf4d..f2213e2 100644 --- a/tools/Language/SQL/SimpleSQL/QueryExprs.lhs +++ b/tools/Language/SQL/SimpleSQL/QueryExprs.lhs @@ -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]) diff --git a/tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs b/tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs index bf0a3da..7de2f06 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs @@ -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 ::= CREATE ROLE [ WITH ADMIN ] -> ,(TestStatement SQL2011 +> ,(TestStatement ansi2011 > "create role rolee" > $ CreateRole (Name "rolee")) @@ -233,16 +233,16 @@ functions, etc., by argument types since they can be overloaded ::= -> ,(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 -> ,(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 ::= -> ,(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) diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Bits.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Bits.lhs index dc76b90..685820d 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011Bits.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011Bits.lhs @@ -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! ::= -> ,(TestStatement SQL2011 +> ,(TestStatement ansi2011 > "savepoint difficult_bit" > $ Savepoint $ Name "difficult_bit") @@ -87,7 +87,7 @@ BEGIN is not in the standard! ::= RELEASE SAVEPOINT -> ,(TestStatement SQL2011 +> ,(TestStatement ansi2011 > "release savepoint difficult_bit" > $ ReleaseSavepoint $ Name "difficult_bit") @@ -97,11 +97,11 @@ BEGIN is not in the standard! ::= 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! ::= TO SAVEPOINT -> ,(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") diff --git a/tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.lhs b/tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.lhs index a30490d..3c2149a 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011DataManipulation.lhs @@ -108,18 +108,18 @@ Section 14 in Foundation [ [ AS ] ] [ WHERE ] -> (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 ::= -> ,(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 ] -> ,(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) diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs index fd444bb..50a0767 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs @@ -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 -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 @@ -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 @@ -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 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) ::=
| @@ -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 . > 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 . > 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
. > 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]}) diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs index 145c9a4..65655f0 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs @@ -20,7 +20,7 @@ This module covers the tests for parsing schema and DDL statements. [ ] [ ... ] -> (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
@@ -94,7 +94,7 @@ add schema element support: [ WITH ] [ ON COMMIT
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 [ ] -> ,(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) ::= -> ,(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) | -> ,(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) ::= -> ,(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 -> ,(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 -> ,(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 -> ,(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 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 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 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 ::= SET 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 ] -> ,(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
-> ,(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 CONSTRAINT -> ,(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
-> ,(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 ::= -> ,(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
-> ,(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 [ ] [ ] -> ,(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 -> ,(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 DEFAULT -> ,(TestStatement SQL2011 +> ,(TestStatement ansi2011 > "alter domain my_int drop default" > $ AlterDomain [Name "my_int"] > $ ADDropDefault) @@ -1228,13 +1228,13 @@ defintely skip ::= ADD -> ,(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 CONSTRAINT -> ,(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 -> ,(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 [ ] -> ,(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 [ ] -> ,(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 ::= -> ,(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 -> ,(TestStatement SQL2011 +> ,(TestStatement ansi2011 > "drop sequence seq" > $ DropSequence [Name "seq"] DefaultDropBehaviour) -> ,(TestStatement SQL2011 +> ,(TestStatement ansi2011 > "drop sequence seq restrict" > $ DropSequence [Name "seq"] Restrict) diff --git a/tools/Language/SQL/SimpleSQL/TableRefs.lhs b/tools/Language/SQL/SimpleSQL/TableRefs.lhs index 55d4e81..cdd5b5a 100644 --- a/tools/Language/SQL/SimpleSQL/TableRefs.lhs +++ b/tools/Language/SQL/SimpleSQL/TableRefs.lhs @@ -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"]]) diff --git a/tools/Language/SQL/SimpleSQL/TestTypes.lhs b/tools/Language/SQL/SimpleSQL/TestTypes.lhs index 010c63b..0022a14 100644 --- a/tools/Language/SQL/SimpleSQL/TestTypes.lhs +++ b/tools/Language/SQL/SimpleSQL/TestTypes.lhs @@ -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) diff --git a/tools/Language/SQL/SimpleSQL/Tpch.lhs b/tools/Language/SQL/SimpleSQL/Tpch.lhs index 9b2c051..45e8d9a 100644 --- a/tools/Language/SQL/SimpleSQL/Tpch.lhs +++ b/tools/Language/SQL/SimpleSQL/Tpch.lhs @@ -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 = diff --git a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs index 86e5c7a..a39b05f 100644 --- a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs +++ b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs @@ -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"]))) > ]