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

start on dialect prototype code

Browse source
This commit is contained in:
Jake Wheat 2014-06-27 12:19:15 +03:00
parent 7914898cc8
commit 7d63c8f8e5
18 changed files with 207 additions and 129 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
Language/SQL/SimpleSQL/Parser.lhs
View file

@ -204,11 +204,13 @@ fixing them in the syntax but leaving them till the semantic checking
= Public API = Public API
> -- | Parses a query expr, trailing semicolon optional. > -- | Parses a query expr, trailing semicolon optional.
> parseQueryExpr :: FilePath > parseQueryExpr :: Dialect
> -- ^ filename to use in errors > -- ^ dialect of SQL to use
> -> FilePath
> -- ^ filename to use in error messages
> -> Maybe (Int,Int) > -> Maybe (Int,Int)
> -- ^ line number and column number of the first character > -- ^ line number and column number of the first character
> -- in the source (to use in errors) > -- in the source to use in error messages
> -> String > -> String
> -- ^ the SQL source to parse > -- ^ the SQL source to parse
> -> Either ParseError QueryExpr > -> Either ParseError QueryExpr
@ -216,22 +218,26 @@ fixing them in the syntax but leaving them till the semantic checking
> -- | Parses a list of query expressions, with semi colons between > -- | Parses a list of query expressions, with semi colons between
> -- them. The final semicolon is optional. > -- them. The final semicolon is optional.
> parseQueryExprs :: FilePath > parseQueryExprs :: Dialect
> -- ^ filename to use in errors > -- ^ dialect of SQL to use
> -> FilePath
> -- ^ filename to use in error messages
> -> Maybe (Int,Int) > -> Maybe (Int,Int)
> -- ^ line number and column number of the first character > -- ^ line number and column number of the first character
> -- in the source (to use in errors) > -- in the source to use in error messages
> -> String > -> String
> -- ^ the SQL source to parse > -- ^ the SQL source to parse
> -> Either ParseError [QueryExpr] > -> Either ParseError [QueryExpr]
> parseQueryExprs = wrapParse queryExprs > parseQueryExprs = wrapParse queryExprs
> -- | Parses a value expression. > -- | Parses a value expression.
> parseValueExpr :: FilePath > parseValueExpr :: Dialect
> -- ^ filename to use in errors > -- ^ dialect of SQL to use
> -> FilePath
> -- ^ filename to use in error messages
> -> Maybe (Int,Int) > -> Maybe (Int,Int)
> -- ^ line number and column number of the first character > -- ^ line number and column number of the first character
> -- in the source (to use in errors) > -- in the source to use in error messages
> -> String > -> String
> -- ^ the SQL source to parse > -- ^ the SQL source to parse
> -> Either ParseError ValueExpr > -> Either ParseError ValueExpr
@ -245,11 +251,12 @@ checks the parser parses all the input using eof
converts the error return to the nice wrapper converts the error return to the nice wrapper
> wrapParse :: Parser a > wrapParse :: Parser a
> -> Dialect
> -> FilePath > -> FilePath
> -> Maybe (Int,Int) > -> Maybe (Int,Int)
> -> String > -> String
> -> Either ParseError a > -> Either ParseError a
> wrapParse parser f p src = > wrapParse parser _ f p src =
> either (Left . convParseError src) Right > either (Left . convParseError src) Right
> $ parse (setPos p *> whitespace *> parser <* eof) f src > $ parse (setPos p *> whitespace *> parser <* eof) f src
> where > where
@ -296,7 +303,12 @@ u&"example quoted"
> name :: Parser Name > name :: Parser Name
> name = choice [QName <$> quotedIdentifier > name = choice [QName <$> quotedIdentifier
> ,UQName <$> uquotedIdentifier > ,UQName <$> uquotedIdentifier
> ,Name <$> identifierBlacklist blacklist] > ,Name <$> identifierBlacklist blacklist
> ,dqName]
> where
> dqName = lexeme (DQName "`" "`"
> <$> (char '`'
> *> manyTill anyChar (char '`')))
todo: replace (:[]) with a named function all over todo: replace (:[]) with a named function all over
@ -1289,10 +1301,13 @@ allows offset and fetch in either order
> ,keyword_ "row"]) > ,keyword_ "row"])
> fetch :: Parser ValueExpr > fetch :: Parser ValueExpr
> fetch = fs *> valueExpr <* ro > fetch = fetchFirst <|> limit
> where > where
> fetchFirst = fs *> valueExpr <* ro
> fs = makeKeywordTree ["fetch first", "fetch next"] > fs = makeKeywordTree ["fetch first", "fetch next"]
> ro = makeKeywordTree ["rows only", "row only"] > ro = makeKeywordTree ["rows only", "row only"]
> -- todo: not in ansi sql dialect
> limit = keyword_ "limit" *> valueExpr
== common table expressions == common table expressions
@ -1971,4 +1986,6 @@ means).
> ,"within" > ,"within"
> ,"without" > ,"without"
> --,"year" > --,"year"
> -- added for mysql dialect, todo: make dialect specific lists
> ,"limit"
> ] > ]

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

@ -19,17 +19,17 @@ which have been changed to try to improve the layout of the output.
> import Data.List (intercalate) > import Data.List (intercalate)
> -- | Convert a query expr ast to concrete syntax. > -- | Convert a query expr ast to concrete syntax.
> prettyQueryExpr :: QueryExpr -> String > prettyQueryExpr :: Dialect -> QueryExpr -> String
> prettyQueryExpr = render . queryExpr > prettyQueryExpr _ = render . queryExpr
> -- | Convert a value expr ast to concrete syntax. > -- | Convert a value expr ast to concrete syntax.
> prettyValueExpr :: ValueExpr -> String > prettyValueExpr :: Dialect -> ValueExpr -> String
> prettyValueExpr = render . valueExpr > prettyValueExpr _ = render . valueExpr
> -- | Convert a list of query exprs to concrete syntax. A semi colon > -- | Convert a list of query exprs to concrete syntax. A semi colon
> -- is inserted after each query expr. > -- is inserted after each query expr.
> prettyQueryExprs :: [QueryExpr] -> String > prettyQueryExprs :: Dialect -> [QueryExpr] -> String
> prettyQueryExprs = render . vcat . map ((<> text ";\n") . queryExpr) > prettyQueryExprs _ = render . vcat . map ((<> text ";\n") . queryExpr)
= value expressions = value expressions
@ -248,6 +248,7 @@ which have been changed to try to improve the layout of the output.
> name (UQName n) = > name (UQName n) =
> text "U&" <> doubleQuotes (text $ doubleUpDoubleQuotes n) > text "U&" <> doubleQuotes (text $ doubleUpDoubleQuotes n)
> name (Name n) = text n > name (Name n) = text n
> name (DQName s e n) = text s <> text n <> text e
> names :: [Name] -> Doc > names :: [Name] -> Doc
> names ns = hcat $ punctuate (text ".") $ map name ns > names ns = hcat $ punctuate (text ".") $ map name ns

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

@ -30,6 +30,8 @@
> ,TableRef(..) > ,TableRef(..)
> ,JoinType(..) > ,JoinType(..)
> ,JoinCondition(..) > ,JoinCondition(..)
> -- * dialect
> ,Dialect(..)
> ) where > ) where
> import Data.Data > import Data.Data
@ -165,6 +167,8 @@
> data Name = Name String > data Name = Name String
> | QName String > | QName String
> | UQName String > | UQName String
> | DQName String String String
> -- ^ dialect quoted name, the fields are start quote, end quote and the string itself, e.g. `something` is parsed to DQName "`" "`" "something, and $a$ test $a$ is parsed to DQName "$a$" "$a" " test "
> deriving (Eq,Show,Read,Data,Typeable) > deriving (Eq,Show,Read,Data,Typeable)
> -- | Represents a type name, used in casts. > -- | Represents a type name, used in casts.
@ -372,3 +376,10 @@ I'm not sure if this is valid syntax or not.
> data JoinCondition = JoinOn ValueExpr -- ^ on expr > data JoinCondition = JoinOn ValueExpr -- ^ on expr
> | JoinUsing [Name] -- ^ using (column list) > | JoinUsing [Name] -- ^ using (column list)
> deriving (Eq,Show,Read,Data,Typeable) > 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)

7
TODO
View file

@ -1,8 +1,13 @@
work on reasonable subset of sql which is similar to the current work on reasonable subset of sql which is similar to the current
subset and smaller than the complete 2011 target subset and smaller than the complete 2011 target
prototype for dialect handling prototype for dialect handling, todo:
add test which test for failure
test that mysql specific syntax fails on ansi mode
and that the ansi equivalents of the mysql specific syntax which
has been implemented fail in mysql mode
position annotation position annotation
simple stuff for error message and pretty printing monitoring
work on the new refactoring of the parser work on the new refactoring of the parser
create a new module for generic combinators create a new module for generic combinators

5
changelog
View file

@ -1,8 +1,9 @@
If you need help updating to a new version of simple-sql-parser, If you need help updating to a new version of simple-sql-parser,
please email jakewheatmail@gmail.com or use the github bug tracker, please email jakewheatmail@gmail.com or use the github bug tracker,
https://github.com/JakeWheat/simple-sql-parser/issues. https://github.com/JakeWheat/simple-sql-parser/issues.
0.4.1 (unreleased)
0.4.0 (updated to dbd48baaa1d1bce3d0d0139b8ffe55370fabe672) simple demonstration of how dialects could be handled internally
0.4.0 (commit 7914898cc8f07bbaf8358d208469392346341964)
now targets SQL:2011 now targets SQL:2011
update to ghc 7.8.2 update to ghc 7.8.2
remove dependency on haskell-src-exts remove dependency on haskell-src-exts

3
simple-sql-parser.cabal
View file

@ -1,5 +1,5 @@
name: simple-sql-parser name: simple-sql-parser
version: 0.4.0 version: 0.4.1
synopsis: A parser for SQL queries synopsis: A parser for SQL queries
description: A parser for SQL queries. Parses most SQL:2011 description: A parser for SQL queries. Parses most SQL:2011
@ -64,6 +64,7 @@ Test-Suite Tests
Language.SQL.SimpleSQL.ErrorMessages, Language.SQL.SimpleSQL.ErrorMessages,
Language.SQL.SimpleSQL.FullQueries, Language.SQL.SimpleSQL.FullQueries,
Language.SQL.SimpleSQL.GroupBy, Language.SQL.SimpleSQL.GroupBy,
Language.SQL.SimpleSQL.MySQL,
Language.SQL.SimpleSQL.Postgres, Language.SQL.SimpleSQL.Postgres,
Language.SQL.SimpleSQL.QueryExprComponents, Language.SQL.SimpleSQL.QueryExprComponents,
Language.SQL.SimpleSQL.QueryExprs, Language.SQL.SimpleSQL.QueryExprs,

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

@ -8,7 +8,7 @@ Some tests for parsing full queries.
> fullQueriesTests :: TestItem > fullQueriesTests :: TestItem
> fullQueriesTests = Group "queries" $ map (uncurry TestQueryExpr) > fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr SQL2011))
> [("select count(*) from t" > [("select count(*) from t"
> ,makeSelect > ,makeSelect
> {qeSelectList = [(App [Name "count"] [Star], Nothing)] > {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 :: TestItem
> simpleGroupBy = Group "simpleGroupBy" $ map (uncurry TestQueryExpr) > simpleGroupBy = Group "simpleGroupBy" $ map (uncurry (TestQueryExpr SQL2011))
> [("select a,sum(b) from t group by a" > [("select a,sum(b) from t group by a"
> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing) > ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)
> ,(App [Name "sum"] [Iden [Name "b"]],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). sure which sql version they were introduced, 1999 or 2003 I think).
> newGroupBy :: TestItem > newGroupBy :: TestItem
> newGroupBy = Group "newGroupBy" $ map (uncurry TestQueryExpr) > newGroupBy = Group "newGroupBy" $ map (uncurry (TestQueryExpr SQL2011))
> [("select * from t group by ()", ms [GroupingParens []]) > [("select * from t group by ()", ms [GroupingParens []])
> ,("select * from t group by grouping sets ((), (a))" > ,("select * from t group by grouping sets ((), (a))"
> ,ms [GroupingSets [GroupingParens [] > ,ms [GroupingSets [GroupingParens []
@ -53,7 +53,7 @@ sure which sql version they were introduced, 1999 or 2003 I think).
> ,qeGroupBy = g} > ,qeGroupBy = g}
> randomGroupBy :: TestItem > randomGroupBy :: TestItem
> randomGroupBy = Group "randomGroupBy" $ map ParseQueryExpr > randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr SQL2011)
> ["select * from t GROUP BY a" > ["select * from t GROUP BY a"
> ,"select * from t GROUP BY GROUPING SETS((a))" > ,"select * from t GROUP BY GROUPING SETS((a))"
> ,"select * from t GROUP BY a,b,c" > ,"select * from t GROUP BY a,b,c"

36
tools/Language/SQL/SimpleSQL/MySQL.lhs Normal file
View file

@ -0,0 +1,36 @@
Tests for mysql dialect parsing
> module Language.SQL.SimpleSQL.MySQL (mySQLTests) where
> import Language.SQL.SimpleSQL.TestTypes
> import Language.SQL.SimpleSQL.Syntax
> mySQLTests :: TestItem
> mySQLTests = Group "mysql dialect"
> [backtickQuotes
> ,limit]
backtick quotes
limit syntax
[LIMIT {[offset,] row_count | row_count OFFSET offset}]
> backtickQuotes :: TestItem
> backtickQuotes = Group "backtickQuotes" $ map (uncurry (TestValueExpr MySQL))
> [("`test`", Iden [DQName "`" "`" "test"])
> ]
> limit :: TestItem
> limit = Group "queries" $ map (uncurry (TestQueryExpr MySQL))
> [("select * from t limit 5"
> ,sel {qeFetchFirst = Just (NumLit "5")}
> )
> ]
> where
> sel = makeSelect
> {qeSelectList = [(Star, Nothing)]
> ,qeFrom = [TRSimple [Name "t"]]
> }

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

@ -6,10 +6,9 @@ revisited when the dialect support is added.
> module Language.SQL.SimpleSQL.Postgres (postgresTests) where > module Language.SQL.SimpleSQL.Postgres (postgresTests) where
> import Language.SQL.SimpleSQL.TestTypes > import Language.SQL.SimpleSQL.TestTypes
> --import Language.SQL.SimpleSQL.Syntax
> postgresTests :: TestItem > postgresTests :: TestItem
> postgresTests = Group "postgresTests" $ map ParseQueryExpr > postgresTests = Group "postgresTests" $ map (ParseQueryExpr SQL2011)
lexical syntax section 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 :: TestItem
> duplicates = Group "duplicates" $ map (uncurry TestQueryExpr) > duplicates = Group "duplicates" $ map (uncurry (TestQueryExpr SQL2011))
> [("select a from t" ,ms SQDefault) > [("select a from t" ,ms SQDefault)
> ,("select all a from t" ,ms All) > ,("select all a from t" ,ms All)
> ,("select distinct a from t", ms Distinct) > ,("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"]]} > ,qeFrom = [TRSimple [Name "t"]]}
> selectLists :: TestItem > selectLists :: TestItem
> selectLists = Group "selectLists" $ map (uncurry TestQueryExpr) > selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr SQL2011))
> [("select 1", > [("select 1",
> makeSelect {qeSelectList = [(NumLit "1",Nothing)]}) > makeSelect {qeSelectList = [(NumLit "1",Nothing)]})
@ -73,7 +73,7 @@ These are a few misc tests which don't fit anywhere else.
> ] > ]
> whereClause :: TestItem > whereClause :: TestItem
> whereClause = Group "whereClause" $ map (uncurry TestQueryExpr) > whereClause = Group "whereClause" $ map (uncurry (TestQueryExpr SQL2011))
> [("select a from t where a = 5" > [("select a from t where a = 5"
> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)] > ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)]
> ,qeFrom = [TRSimple [Name "t"]] > ,qeFrom = [TRSimple [Name "t"]]
@ -81,7 +81,7 @@ These are a few misc tests which don't fit anywhere else.
> ] > ]
> having :: TestItem > having :: TestItem
> having = Group "having" $ map (uncurry TestQueryExpr) > having = Group "having" $ map (uncurry (TestQueryExpr SQL2011))
> [("select a,sum(b) from t group by a having sum(b) > 5" > [("select a,sum(b) from t group by a having sum(b) > 5"
> ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing) > ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)
> ,(App [Name "sum"] [Iden [Name "b"]],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 :: TestItem
> orderBy = Group "orderBy" $ map (uncurry TestQueryExpr) > orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr SQL2011))
> [("select a from t order by a" > [("select a from t order by a"
> ,ms [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault]) > ,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} > ,qeOrderBy = o}
> offsetFetch :: TestItem > offsetFetch :: TestItem
> offsetFetch = Group "offsetFetch" $ map (uncurry TestQueryExpr) > offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr SQL2011))
> [-- ansi standard > [-- ansi standard
> ("select a from t offset 5 rows fetch next 10 rows only" > ("select a from t offset 5 rows fetch next 10 rows only"
> ,ms (Just $ NumLit "5") (Just $ NumLit "10")) > ,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} > ,qeFetchFirst = l}
> combos :: TestItem > combos :: TestItem
> combos = Group "combos" $ map (uncurry TestQueryExpr) > combos = Group "combos" $ map (uncurry (TestQueryExpr SQL2011))
> [("select a from t union select b from u" > [("select a from t union select b from u"
> ,CombineQueryExpr ms1 Union SQDefault Respectively ms2) > ,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 :: TestItem
> withQueries = Group "with queries" $ map (uncurry TestQueryExpr) > withQueries = Group "with queries" $ map (uncurry (TestQueryExpr SQL2011))
> [("with u as (select a from t) select a from u" > [("with u as (select a from t) select a from u"
> ,With False [(Alias (Name "u") Nothing, ms1)] ms2) > ,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" > ms3 = ms "a" "x"
> values :: TestItem > values :: TestItem
> values = Group "values" $ map (uncurry TestQueryExpr) > values = Group "values" $ map (uncurry (TestQueryExpr SQL2011))
> [("values (1,2),(3,4)" > [("values (1,2),(3,4)"
> ,Values [[NumLit "1", NumLit "2"] > ,Values [[NumLit "1", NumLit "2"]
> ,[NumLit "3", NumLit "4"]]) > ,[NumLit "3", NumLit "4"]])
> ] > ]
> tables :: TestItem > tables :: TestItem
> tables = Group "tables" $ map (uncurry TestQueryExpr) > tables = Group "tables" $ map (uncurry (TestQueryExpr SQL2011))
> [("table tbl", Table [Name "tbl"]) > [("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 > import Language.SQL.SimpleSQL.Syntax
> queryExprsTests :: TestItem > queryExprsTests :: TestItem
> queryExprsTests = Group "query exprs" $ map (uncurry TestQueryExprs) > queryExprsTests = Group "query exprs" $ map (uncurry (TestQueryExprs SQL2011))
> [("select 1",[ms]) > [("select 1",[ms])
> ,("select 1;",[ms]) > ,("select 1;",[ms])
> ,("select 1;select 1",[ms,ms]) > ,("select 1;select 1",[ms,ms])

96
tools/Language/SQL/SimpleSQL/SQL2011.lhs
View file

@ -482,7 +482,7 @@ Specify a non-null value.
> characterStringLiterals :: TestItem > characterStringLiterals :: TestItem
> characterStringLiterals = Group "character string literals" > characterStringLiterals = Group "character string literals"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("'a regular string literal'" > [("'a regular string literal'"
> ,StringLit "a regular string literal") > ,StringLit "a regular string literal")
> ,("'something' ' some more' 'and more'" > ,("'something' ' some more' 'and more'"
@ -510,7 +510,7 @@ character set allows them.
> nationalCharacterStringLiterals :: TestItem > nationalCharacterStringLiterals :: TestItem
> nationalCharacterStringLiterals = Group "national character string literals" > nationalCharacterStringLiterals = Group "national character string literals"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("N'something'", CSStringLit "N" "something") > [("N'something'", CSStringLit "N" "something")
> ,("n'something'", CSStringLit "n" "something") > ,("n'something'", CSStringLit "n" "something")
> ] > ]
@ -527,7 +527,7 @@ character set allows them.
> unicodeCharacterStringLiterals :: TestItem > unicodeCharacterStringLiterals :: TestItem
> unicodeCharacterStringLiterals = Group "unicode character string literals" > unicodeCharacterStringLiterals = Group "unicode character string literals"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("U&'something'", CSStringLit "U&" "something") > [("U&'something'", CSStringLit "U&" "something")
> ,("u&'something' escape =" > ,("u&'something' escape ="
> ,Escape (CSStringLit "u&" "something") '=') > ,Escape (CSStringLit "u&" "something") '=')
@ -546,7 +546,7 @@ TODO: unicode escape
> binaryStringLiterals :: TestItem > binaryStringLiterals :: TestItem
> binaryStringLiterals = Group "binary string literals" > binaryStringLiterals = Group "binary string literals"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [--("B'101010'", CSStringLit "B" "101010") > [--("B'101010'", CSStringLit "B" "101010")
> ("X'7f7f7f'", CSStringLit "X" "7f7f7f") > ("X'7f7f7f'", CSStringLit "X" "7f7f7f")
> ,("X'7f7f7f' escape z", Escape (CSStringLit "X" "7f7f7f") 'z') > ,("X'7f7f7f' escape z", Escape (CSStringLit "X" "7f7f7f") 'z')
@ -576,7 +576,7 @@ TODO: unicode escape
> numericLiterals :: TestItem > numericLiterals :: TestItem
> numericLiterals = Group "numeric literals" > numericLiterals = Group "numeric literals"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("11", NumLit "11") > [("11", NumLit "11")
> ,("11.11", NumLit "11.11") > ,("11.11", NumLit "11.11")
@ -682,7 +682,7 @@ TODO: unicode escape
> intervalLiterals :: TestItem > intervalLiterals :: TestItem
> intervalLiterals = Group "intervalLiterals literals" > intervalLiterals = Group "intervalLiterals literals"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("interval '1'", TypedLit (TypeName [Name "interval"]) "1") > [("interval '1'", TypedLit (TypeName [Name "interval"]) "1")
> ,("interval '1' day" > ,("interval '1' day"
> ,IntervalLit Nothing "1" (Itf "day" Nothing) Nothing) > ,IntervalLit Nothing "1" (Itf "day" Nothing) Nothing)
@ -705,7 +705,7 @@ TODO: unicode escape
> booleanLiterals :: TestItem > booleanLiterals :: TestItem
> booleanLiterals = Group "boolean literals" > booleanLiterals = Group "boolean literals"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("true", Iden [Name "true"]) > [("true", Iden [Name "true"])
> ,("false", Iden [Name "false"]) > ,("false", Iden [Name "false"])
> ,("unknown", Iden [Name "unknown"]) > ,("unknown", Iden [Name "unknown"])
@ -725,7 +725,7 @@ Specify names.
> identifiers :: TestItem > identifiers :: TestItem
> identifiers = Group "identifiers" > identifiers = Group "identifiers"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("test",Iden [Name "test"]) > [("test",Iden [Name "test"])
> ,("_test",Iden [Name "_test"]) > ,("_test",Iden [Name "_test"])
> ,("t1",Iden [Name "t1"]) > ,("t1",Iden [Name "t1"])
@ -1166,7 +1166,7 @@ Now test each variation in both cast expression and typed literal
expression expression
> typeNameTests :: TestItem > typeNameTests :: TestItem
> typeNameTests = Group "type names" $ map (uncurry TestValueExpr) > typeNameTests = Group "type names" $ map (uncurry (TestValueExpr SQL2011))
> $ concatMap makeTests typeNames > $ concatMap makeTests typeNames
> where > where
> makeTests (ctn, stn) = > makeTests (ctn, stn) =
@ -1184,7 +1184,7 @@ Define a field of a row type.
> fieldDefinition :: TestItem > fieldDefinition :: TestItem
> fieldDefinition = Group "field definition" > fieldDefinition = Group "field definition"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("cast('(1,2)' as row(a int,b char))" > [("cast('(1,2)' as row(a int,b char))"
> ,Cast (StringLit "(1,2)") > ,Cast (StringLit "(1,2)")
> $ RowTypeName [(Name "a", TypeName [Name "int"]) > $ RowTypeName [(Name "a", TypeName [Name "int"])
@ -1264,7 +1264,7 @@ Specify a value that is syntactically self-delimited.
> parenthesizedValueExpression :: TestItem > parenthesizedValueExpression :: TestItem
> parenthesizedValueExpression = Group "parenthesized value expression" > parenthesizedValueExpression = Group "parenthesized value expression"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("(3)", Parens (NumLit "3")) > [("(3)", Parens (NumLit "3"))
> ,("((3))", Parens $ Parens (NumLit "3")) > ,("((3))", Parens $ Parens (NumLit "3"))
> ] > ]
@ -1300,7 +1300,7 @@ Specify one or more values, host parameters, SQL parameters, dynamic parameters,
> generalValueSpecification :: TestItem > generalValueSpecification :: TestItem
> generalValueSpecification = Group "general value specification" > generalValueSpecification = Group "general value specification"
> $ map (uncurry TestValueExpr) $ > $ map (uncurry (TestValueExpr SQL2011)) $
> map mkIden ["CURRENT_DEFAULT_TRANSFORM_GROUP" > map mkIden ["CURRENT_DEFAULT_TRANSFORM_GROUP"
> ,"CURRENT_PATH" > ,"CURRENT_PATH"
> ,"CURRENT_ROLE" > ,"CURRENT_ROLE"
@ -1354,7 +1354,7 @@ TODO: add the missing bits
> parameterSpecification :: TestItem > parameterSpecification :: TestItem
> parameterSpecification = Group "parameter specification" > parameterSpecification = Group "parameter specification"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [(":hostparam", HostParameter "hostparam" Nothing) > [(":hostparam", HostParameter "hostparam" Nothing)
> ,(":hostparam indicator :another_host_param" > ,(":hostparam indicator :another_host_param"
> ,HostParameter "hostparam" $ Just "another_host_param") > ,HostParameter "hostparam" $ Just "another_host_param")
@ -1391,7 +1391,7 @@ Specify a value whose data type is to be inferred from its context.
> contextuallyTypedValueSpecification :: TestItem > contextuallyTypedValueSpecification :: TestItem
> contextuallyTypedValueSpecification = > contextuallyTypedValueSpecification =
> Group "contextually typed value specification" > Group "contextually typed value specification"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("null", Iden [Name "null"]) > [("null", Iden [Name "null"])
> ,("array[]", Array (Iden [Name "array"]) []) > ,("array[]", Array (Iden [Name "array"]) [])
> ,("multiset[]", MultisetCtor []) > ,("multiset[]", MultisetCtor [])
@ -1409,7 +1409,7 @@ Disambiguate a <period>-separated chain of identifiers.
> identifierChain :: TestItem > identifierChain :: TestItem
> identifierChain = Group "identifier chain" > identifierChain = Group "identifier chain"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("a.b", Iden [Name "a",Name "b"])] > [("a.b", Iden [Name "a",Name "b"])]
== 6.7 <column reference> == 6.7 <column reference>
@ -1423,7 +1423,7 @@ Reference a column.
> columnReference :: TestItem > columnReference :: TestItem
> columnReference = Group "column reference" > columnReference = Group "column reference"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("module.a.b", Iden [Name "module",Name "a",Name "b"])] > [("module.a.b", Iden [Name "module",Name "a",Name "b"])]
== 6.8 <SQL parameter reference> == 6.8 <SQL parameter reference>
@ -1446,7 +1446,7 @@ Specify a value derived by the application of a function to an argument.
> setFunctionSpecification :: TestItem > setFunctionSpecification :: TestItem
> setFunctionSpecification = Group "set function specification" > setFunctionSpecification = Group "set function specification"
> $ map (uncurry TestQueryExpr) > $ map (uncurry (TestQueryExpr SQL2011))
> [("SELECT SalesQuota, SUM(SalesYTD) TotalSalesYTD,\n\ > [("SELECT SalesQuota, SUM(SalesYTD) TotalSalesYTD,\n\
> \ GROUPING(SalesQuota) AS Grouping\n\ > \ GROUPING(SalesQuota) AS Grouping\n\
> \FROM Sales.SalesPerson\n\ > \FROM Sales.SalesPerson\n\
@ -1647,7 +1647,7 @@ Specify a data conversion.
> castSpecification :: TestItem > castSpecification :: TestItem
> castSpecification = Group "cast specification" > castSpecification = Group "cast specification"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("cast(a as int)" > [("cast(a as int)"
> ,Cast (Iden [Name "a"]) (TypeName [Name "int"])) > ,Cast (Iden [Name "a"]) (TypeName [Name "int"]))
> ] > ]
@ -1661,7 +1661,7 @@ Return the next value of a sequence generator.
> nextValueExpression :: TestItem > nextValueExpression :: TestItem
> nextValueExpression = Group "next value expression" > nextValueExpression = Group "next value expression"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("next value for a.b", NextValueFor [Name "a", Name "b"]) > [("next value for a.b", NextValueFor [Name "a", Name "b"])
> ] > ]
@ -1674,7 +1674,7 @@ Reference a field of a row value.
> fieldReference :: TestItem > fieldReference :: TestItem
> fieldReference = Group "field reference" > fieldReference = Group "field reference"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("f(something).a" > [("f(something).a"
> ,BinOp (App [Name "f"] [Iden [Name "something"]]) > ,BinOp (App [Name "f"] [Iden [Name "something"]])
> [Name "."] > [Name "."]
@ -1798,7 +1798,7 @@ Return an element of an array.
> arrayElementReference :: TestItem > arrayElementReference :: TestItem
> arrayElementReference = Group "array element reference" > arrayElementReference = Group "array element reference"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("something[3]" > [("something[3]"
> ,Array (Iden [Name "something"]) [NumLit "3"]) > ,Array (Iden [Name "something"]) [NumLit "3"])
> ,("(something(a))[x]" > ,("(something(a))[x]"
@ -1821,7 +1821,7 @@ Return the sole element of a multiset of one element.
> multisetElementReference :: TestItem > multisetElementReference :: TestItem
> multisetElementReference = Group "multisetElementReference" > multisetElementReference = Group "multisetElementReference"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("element(something)" > [("element(something)"
> ,App [Name "element"] [Iden [Name "something"]]) > ,App [Name "element"] [Iden [Name "something"]])
> ] > ]
@ -1871,7 +1871,7 @@ Specify a numeric value.
> numericValueExpression :: TestItem > numericValueExpression :: TestItem
> numericValueExpression = Group "numeric value expression" > numericValueExpression = Group "numeric value expression"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("a + b", binOp "+") > [("a + b", binOp "+")
> ,("a - b", binOp "-") > ,("a - b", binOp "-")
> ,("a * b", binOp "*") > ,("a * b", binOp "*")
@ -2328,7 +2328,7 @@ Specify a boolean value.
> booleanValueExpression :: TestItem > booleanValueExpression :: TestItem
> booleanValueExpression = Group "booleab value expression" > booleanValueExpression = Group "booleab value expression"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("a or b", BinOp a [Name "or"] b) > [("a or b", BinOp a [Name "or"] b)
> ,("a and b", BinOp a [Name "and"] b) > ,("a and b", BinOp a [Name "and"] b)
> ,("not a", PrefixOp [Name "not"] a) > ,("not a", PrefixOp [Name "not"] a)
@ -2403,7 +2403,7 @@ Specify construction of an array.
> arrayValueConstructor :: TestItem > arrayValueConstructor :: TestItem
> arrayValueConstructor = Group "array value constructor" > arrayValueConstructor = Group "array value constructor"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("array[1,2,3]" > [("array[1,2,3]"
> ,Array (Iden [Name "array"]) > ,Array (Iden [Name "array"])
> [NumLit "1", NumLit "2", NumLit "3"]) > [NumLit "1", NumLit "2", NumLit "3"])
@ -2441,7 +2441,7 @@ Specify a multiset value.
> multisetValueExpression :: TestItem > multisetValueExpression :: TestItem
> multisetValueExpression = Group "multiset value expression" > multisetValueExpression = Group "multiset value expression"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("a multiset union b" > [("a multiset union b"
> ,MultisetBinOp (Iden [Name "a"]) Union SQDefault (Iden [Name "b"])) > ,MultisetBinOp (Iden [Name "a"]) Union SQDefault (Iden [Name "b"]))
> ,("a multiset union all b" > ,("a multiset union all b"
@ -2468,7 +2468,7 @@ Specify a function yielding a value of a multiset type.
> multisetValueFunction :: TestItem > multisetValueFunction :: TestItem
> multisetValueFunction = Group "multiset value function" > multisetValueFunction = Group "multiset value function"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("set(a)", App [Name "set"] [Iden [Name "a"]]) > [("set(a)", App [Name "set"] [Iden [Name "a"]])
> ] > ]
@ -2496,7 +2496,7 @@ Specify construction of a multiset.
> multisetValueConstructor :: TestItem > multisetValueConstructor :: TestItem
> multisetValueConstructor = Group "multiset value constructor" > multisetValueConstructor = Group "multiset value constructor"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("multiset[a,b,c]", MultisetCtor[Iden [Name "a"] > [("multiset[a,b,c]", MultisetCtor[Iden [Name "a"]
> ,Iden [Name "b"], Iden [Name "c"]]) > ,Iden [Name "b"], Iden [Name "c"]])
> ,("multiset(select * from t)", MultisetQueryCtor qe) > ,("multiset(select * from t)", MultisetQueryCtor qe)
@ -2574,7 +2574,7 @@ Specify a value or list of values to be constructed into a row.
> rowValueConstructor :: TestItem > rowValueConstructor :: TestItem
> rowValueConstructor = Group "row value constructor" > rowValueConstructor = Group "row value constructor"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("(a,b)" > [("(a,b)"
> ,SpecialOp [Name "rowctor"] [Iden [Name "a"], Iden [Name "b"]]) > ,SpecialOp [Name "rowctor"] [Iden [Name "a"], Iden [Name "b"]])
> ,("row(1)",App [Name "row"] [NumLit "1"]) > ,("row(1)",App [Name "row"] [NumLit "1"])
@ -2625,7 +2625,7 @@ Specify a set of <row value expression>s to be constructed into a table.
> tableValueConstructor :: TestItem > tableValueConstructor :: TestItem
> tableValueConstructor = Group "table value constructor" > tableValueConstructor = Group "table value constructor"
> $ map (uncurry TestQueryExpr) > $ map (uncurry (TestQueryExpr SQL2011))
> [("values (1,2), (a+b,(select count(*) from t));" > [("values (1,2), (a+b,(select count(*) from t));"
> ,Values [[NumLit "1", NumLit "2"] > ,Values [[NumLit "1", NumLit "2"]
> ,[BinOp (Iden [Name "a"]) [Name "+"] > ,[BinOp (Iden [Name "a"]) [Name "+"]
@ -2660,7 +2660,7 @@ Specify a table derived from one or more tables.
> fromClause :: TestItem > fromClause :: TestItem
> fromClause = Group "fromClause" > fromClause = Group "fromClause"
> $ map (uncurry TestQueryExpr) > $ map (uncurry (TestQueryExpr SQL2011))
> [("select * from tbl1,tbl2" > [("select * from tbl1,tbl2"
> ,makeSelect > ,makeSelect
> {qeSelectList = [(Star, Nothing)] > {qeSelectList = [(Star, Nothing)]
@ -2675,7 +2675,7 @@ Reference a table.
> tableReference :: TestItem > tableReference :: TestItem
> tableReference = Group "table reference" > tableReference = Group "table reference"
> $ map (uncurry TestQueryExpr) > $ map (uncurry (TestQueryExpr SQL2011))
> [("select * from t", sel) > [("select * from t", sel)
<table reference> ::= <table factor> | <joined table> <table reference> ::= <table factor> | <joined table>
@ -2856,7 +2856,7 @@ Specify a table derived from a Cartesian product, inner join, or outer join.
> joinedTable :: TestItem > joinedTable :: TestItem
> joinedTable = Group "joined table" > joinedTable = Group "joined table"
> $ map (uncurry TestQueryExpr) > $ map (uncurry (TestQueryExpr SQL2011))
> [("select * from a cross join b" > [("select * from a cross join b"
> ,sel $ TRJoin a False JCross b Nothing) > ,sel $ TRJoin a False JCross b Nothing)
> ,("select * from a join b on true" > ,("select * from a join b on true"
@ -2913,7 +2913,7 @@ the result of the preceding <from clause>.
> whereClause :: TestItem > whereClause :: TestItem
> whereClause = Group "where clause" > whereClause = Group "where clause"
> $ map (uncurry TestQueryExpr) > $ map (uncurry (TestQueryExpr SQL2011))
> [("select * from t where a = 5" > [("select * from t where a = 5"
> ,makeSelect > ,makeSelect
> {qeSelectList = [(Star,Nothing)] > {qeSelectList = [(Star,Nothing)]
@ -2973,7 +2973,7 @@ clause> to the result of the previously specified clause.
> groupByClause :: TestItem > groupByClause :: TestItem
> groupByClause = Group "group by clause" > groupByClause = Group "group by clause"
> $ map (uncurry TestQueryExpr) > $ map (uncurry (TestQueryExpr SQL2011))
> [("select a,sum(x) from t group by a" > [("select a,sum(x) from t group by a"
> ,qe [SimpleGroup $ Iden [Name "a"]]) > ,qe [SimpleGroup $ Iden [Name "a"]])
> ,("select a,sum(x) from t group by a collate c" > ,("select a,sum(x) from t group by a collate c"
@ -3021,7 +3021,7 @@ not satisfy a <search condition>.
> havingClause :: TestItem > havingClause :: TestItem
> havingClause = Group "having clause" > havingClause = Group "having clause"
> $ map (uncurry TestQueryExpr) > $ map (uncurry (TestQueryExpr SQL2011))
> [("select a,sum(x) from t group by a having sum(x) > 1000" > [("select a,sum(x) from t group by a having sum(x) > 1000"
> ,makeSelect > ,makeSelect
> {qeSelectList = [(Iden [Name "a"], Nothing) > {qeSelectList = [(Iden [Name "a"], Nothing)
@ -3144,7 +3144,7 @@ Specify a table derived from the result of a <table expression>.
> querySpecification :: TestItem > querySpecification :: TestItem
> querySpecification = Group "query specification" > querySpecification = Group "query specification"
> $ map (uncurry TestQueryExpr) > $ map (uncurry (TestQueryExpr SQL2011))
> [("select a from t",qe) > [("select a from t",qe)
> ,("select all a from t",qe {qeSetQuantifier = All}) > ,("select all a from t",qe {qeSetQuantifier = All})
> ,("select distinct a from t",qe {qeSetQuantifier = Distinct}) > ,("select distinct a from t",qe {qeSetQuantifier = Distinct})
@ -3212,7 +3212,7 @@ Specify a table.
> setOpQueryExpression :: TestItem > setOpQueryExpression :: TestItem
> setOpQueryExpression= Group "set operation query expression" > setOpQueryExpression= Group "set operation query expression"
> $ map (uncurry TestQueryExpr) > $ map (uncurry (TestQueryExpr SQL2011))
> -- todo: complete setop query expression tests > -- todo: complete setop query expression tests
> [{-("select * from t union select * from t" > [{-("select * from t union select * from t"
> ,undefined) > ,undefined)
@ -3249,7 +3249,7 @@ everywhere
> explicitTableQueryExpression :: TestItem > explicitTableQueryExpression :: TestItem
> explicitTableQueryExpression= Group "explicit table query expression" > explicitTableQueryExpression= Group "explicit table query expression"
> $ map (uncurry TestQueryExpr) > $ map (uncurry (TestQueryExpr SQL2011))
> [("table t", Table [Name "t"]) > [("table t", Table [Name "t"])
> ] > ]
@ -3271,7 +3271,7 @@ everywhere
> orderOffsetFetchQueryExpression :: TestItem > orderOffsetFetchQueryExpression :: TestItem
> orderOffsetFetchQueryExpression = Group "order, offset, fetch query expression" > orderOffsetFetchQueryExpression = Group "order, offset, fetch query expression"
> $ map (uncurry TestQueryExpr) > $ map (uncurry (TestQueryExpr SQL2011))
> [-- todo: finish tests for order offset and fetch > [-- todo: finish tests for order offset and fetch
> ("select a from t order by a" > ("select a from t order by a"
> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"]) > ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])
@ -3428,7 +3428,7 @@ Specify a comparison of two row values.
> comparisonPredicates :: TestItem > comparisonPredicates :: TestItem
> comparisonPredicates = Group "comparison predicates" > comparisonPredicates = Group "comparison predicates"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> $ map mkOp ["=", "<>", "<", ">", "<=", ">="] > $ map mkOp ["=", "<>", "<", ">", "<=", ">="]
> ++ [("ROW(a) = ROW(b)" > ++ [("ROW(a) = ROW(b)"
> ,BinOp (App [Name "ROW"] [a]) > ,BinOp (App [Name "ROW"] [a])
@ -3632,7 +3632,7 @@ Specify a quantified comparison.
> quantifiedComparisonPredicate :: TestItem > quantifiedComparisonPredicate :: TestItem
> quantifiedComparisonPredicate = Group "quantified comparison predicate" > quantifiedComparisonPredicate = Group "quantified comparison predicate"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("a = any (select * from t)" > [("a = any (select * from t)"
> ,QuantifiedComparison (Iden [Name "a"]) [Name "="] CPAny qe) > ,QuantifiedComparison (Iden [Name "a"]) [Name "="] CPAny qe)
@ -3659,7 +3659,7 @@ Specify a test for a non-empty set.
> existsPredicate :: TestItem > existsPredicate :: TestItem
> existsPredicate = Group "exists predicate" > existsPredicate = Group "exists predicate"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("exists(select * from t where a = 4)" > [("exists(select * from t where a = 4)"
> ,SubQueryExpr SqExists > ,SubQueryExpr SqExists
> $ makeSelect > $ makeSelect
@ -3678,7 +3678,7 @@ Specify a test for the absence of duplicate rows.
> uniquePredicate :: TestItem > uniquePredicate :: TestItem
> uniquePredicate = Group "unique predicate" > uniquePredicate = Group "unique predicate"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("unique(select * from t where a = 4)" > [("unique(select * from t where a = 4)"
> ,SubQueryExpr SqUnique > ,SubQueryExpr SqUnique
> $ makeSelect > $ makeSelect
@ -3714,7 +3714,7 @@ Specify a test for matching rows.
> matchPredicate :: TestItem > matchPredicate :: TestItem
> matchPredicate = Group "match predicate" > matchPredicate = Group "match predicate"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("a match (select a from t)" > [("a match (select a from t)"
> ,Match (Iden [Name "a"]) False qe) > ,Match (Iden [Name "a"]) False qe)
> ,("(a,b) match (select a,b from t)" > ,("(a,b) match (select a,b from t)"
@ -4066,7 +4066,7 @@ Specify a default collation.
> collateClause :: TestItem > collateClause :: TestItem
> collateClause = Group "collate clause" > collateClause = Group "collate clause"
> $ map (uncurry TestValueExpr) > $ map (uncurry (TestValueExpr SQL2011))
> [("a collate my_collation" > [("a collate my_collation"
> ,Collate (Iden [Name "a"]) [Name "my_collation"])] > ,Collate (Iden [Name "a"]) [Name "my_collation"])]
@ -4177,7 +4177,7 @@ Specify a value computed from a collection of rows.
> aggregateFunction :: TestItem > aggregateFunction :: TestItem
> aggregateFunction = Group "aggregate function" > aggregateFunction = Group "aggregate function"
> $ map (uncurry TestValueExpr) $ > $ map (uncurry (TestValueExpr SQL2011)) $
> [("count(*)",App [Name "count"] [Star]) > [("count(*)",App [Name "count"] [Star])
> ,("count(*) filter (where something > 5)" > ,("count(*) filter (where something > 5)"
> ,AggregateApp [Name "count"] SQDefault [Star] [] fil) > ,AggregateApp [Name "count"] SQDefault [Star] [] fil)
@ -4272,7 +4272,7 @@ Specify a sort order.
> sortSpecificationList :: TestItem > sortSpecificationList :: TestItem
> sortSpecificationList = Group "sort specification list" > sortSpecificationList = Group "sort specification list"
> $ map (uncurry TestQueryExpr) > $ map (uncurry (TestQueryExpr SQL2011))
> [("select * from t order by a" > [("select * from t order by a"
> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"]) > ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])
> DirDefault NullsOrderDefault]}) > DirDefault NullsOrderDefault]})

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

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

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

@ -2,18 +2,20 @@
This is the types used to define the tests as pure data. See the This is the types used to define the tests as pure data. See the
Tests.lhs module for the 'interpreter'. Tests.lhs module for the 'interpreter'.
> module Language.SQL.SimpleSQL.TestTypes where > module Language.SQL.SimpleSQL.TestTypes
> (TestItem(..)
> ,Dialect(..)) where
> import Language.SQL.SimpleSQL.Syntax > import Language.SQL.SimpleSQL.Syntax
> data TestItem = Group String [TestItem] > data TestItem = Group String [TestItem]
> | TestValueExpr String ValueExpr > | TestValueExpr Dialect String ValueExpr
> | TestQueryExpr String QueryExpr > | TestQueryExpr Dialect String QueryExpr
> | TestQueryExprs String [QueryExpr] > | TestQueryExprs Dialect String [QueryExpr]
this just checks the sql parses without error, mostly just a this just checks the sql parses without error, mostly just a
intermediate when I'm too lazy to write out the parsed AST. These intermediate when I'm too lazy to write out the parsed AST. These
should all be TODO to convert to a testqueryexpr test. should all be TODO to convert to a testqueryexpr test.
> | ParseQueryExpr String > | ParseQueryExpr Dialect String
> deriving (Eq,Show) > deriving (Eq,Show)

45
tools/Language/SQL/SimpleSQL/Tests.lhs
View file

@ -30,6 +30,8 @@ test data to the Test.Framework tests.
> import Language.SQL.SimpleSQL.SQL2011 > import Language.SQL.SimpleSQL.SQL2011
> import Language.SQL.SimpleSQL.MySQL
Order the tests to start from the simplest first. This is also the Order the tests to start from the simplest first. This is also the
order on the generated documentation. order on the generated documentation.
@ -45,6 +47,7 @@ order on the generated documentation.
> ,postgresTests > ,postgresTests
> ,tpchTests > ,tpchTests
> ,sql2011Tests > ,sql2011Tests
> ,mySQLTests
> ] > ]
> tests :: Test.Framework.Test > tests :: Test.Framework.Test
@ -56,29 +59,30 @@ order on the generated documentation.
> itemToTest :: TestItem -> Test.Framework.Test > itemToTest :: TestItem -> Test.Framework.Test
> itemToTest (Group nm ts) = > itemToTest (Group nm ts) =
> testGroup nm $ map itemToTest ts > testGroup nm $ map itemToTest ts
> itemToTest (TestValueExpr str expected) = > itemToTest (TestValueExpr d str expected) =
> toTest parseValueExpr prettyValueExpr str expected > toTest parseValueExpr prettyValueExpr d str expected
> itemToTest (TestQueryExpr str expected) = > itemToTest (TestQueryExpr d str expected) =
> toTest parseQueryExpr prettyQueryExpr str expected > toTest parseQueryExpr prettyQueryExpr d str expected
> itemToTest (TestQueryExprs str expected) = > itemToTest (TestQueryExprs d str expected) =
> toTest parseQueryExprs prettyQueryExprs str expected > toTest parseQueryExprs prettyQueryExprs d str expected
> itemToTest (ParseQueryExpr str) = > itemToTest (ParseQueryExpr d str) =
> toPTest parseQueryExpr prettyQueryExpr str > toPTest parseQueryExpr prettyQueryExpr d str
> toTest :: (Eq a, Show a) => > toTest :: (Eq a, Show a) =>
> (String -> Maybe (Int,Int) -> String -> Either ParseError a) > (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
> -> (a -> String) > -> (Dialect -> a -> String)
> -> Dialect
> -> String > -> String
> -> a > -> a
> -> Test.Framework.Test > -> Test.Framework.Test
> toTest parser pp str expected = testCase str $ do > toTest parser pp d str expected = testCase str $ do
> let egot = parser "" Nothing str > let egot = parser d "" Nothing str
> case egot of > case egot of
> Left e -> H.assertFailure $ peFormattedError e > Left e -> H.assertFailure $ peFormattedError e
> Right got -> do > Right got -> do
> H.assertEqual "" expected got > H.assertEqual "" expected got
> let str' = pp got > let str' = pp d got
> let egot' = parser "" Nothing str' > let egot' = parser d "" Nothing str'
> case egot' of > case egot' of
> Left e' -> H.assertFailure $ "pp roundtrip" > Left e' -> H.assertFailure $ "pp roundtrip"
> ++ "\n" ++ str' > ++ "\n" ++ str'
@ -88,17 +92,18 @@ order on the generated documentation.
> expected got' > expected got'
> toPTest :: (Eq a, Show a) => > toPTest :: (Eq a, Show a) =>
> (String -> Maybe (Int,Int) -> String -> Either ParseError a) > (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
> -> (a -> String) > -> (Dialect -> a -> String)
> -> Dialect
> -> String > -> String
> -> Test.Framework.Test > -> Test.Framework.Test
> toPTest parser pp str = testCase str $ do > toPTest parser pp d str = testCase str $ do
> let egot = parser "" Nothing str > let egot = parser d "" Nothing str
> case egot of > case egot of
> Left e -> H.assertFailure $ peFormattedError e > Left e -> H.assertFailure $ peFormattedError e
> Right got -> do > Right got -> do
> let str' = pp got > let str' = pp d got
> let egot' = parser "" Nothing str' > let egot' = parser d "" Nothing str'
> case egot' of > case egot' of
> Left e' -> H.assertFailure $ "pp roundtrip " > Left e' -> H.assertFailure $ "pp roundtrip "
> ++ "\n" ++ str' ++ "\n" > ++ "\n" ++ str' ++ "\n"

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

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

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

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