start on dialect prototype code
This commit is contained in:
Jake Wheat
parent
7914898cc8
commit
7d63c8f8e5
|
|
@ -204,11 +204,13 @@ fixing them in the syntax but leaving them till the semantic checking
|
|||
= Public API
|
||||
|
||||
> -- | Parses a query expr, trailing semicolon optional.
|
||||
> parseQueryExpr :: FilePath
|
||||
> -- ^ filename to use in errors
|
||||
> parseQueryExpr :: Dialect
|
||||
> -- ^ dialect of SQL to use
|
||||
> -> FilePath
|
||||
> -- ^ filename to use in error messages
|
||||
> -> Maybe (Int,Int)
|
||||
> -- ^ 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
|
||||
> -- ^ the SQL source to parse
|
||||
> -> 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
|
||||
> -- them. The final semicolon is optional.
|
||||
> parseQueryExprs :: FilePath
|
||||
> -- ^ filename to use in errors
|
||||
> parseQueryExprs :: Dialect
|
||||
> -- ^ dialect of SQL to use
|
||||
> -> FilePath
|
||||
> -- ^ filename to use in error messages
|
||||
> -> Maybe (Int,Int)
|
||||
> -- ^ 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
|
||||
> -- ^ the SQL source to parse
|
||||
> -> Either ParseError [QueryExpr]
|
||||
> parseQueryExprs = wrapParse queryExprs
|
||||
|
||||
> -- | Parses a value expression.
|
||||
> parseValueExpr :: FilePath
|
||||
> -- ^ filename to use in errors
|
||||
> parseValueExpr :: Dialect
|
||||
> -- ^ dialect of SQL to use
|
||||
> -> FilePath
|
||||
> -- ^ filename to use in error messages
|
||||
> -> Maybe (Int,Int)
|
||||
> -- ^ 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
|
||||
> -- ^ the SQL source to parse
|
||||
> -> Either ParseError ValueExpr
|
||||
|
|
@ -245,11 +251,12 @@ checks the parser parses all the input using eof
|
|||
converts the error return to the nice wrapper
|
||||
|
||||
> wrapParse :: Parser a
|
||||
> -> Dialect
|
||||
> -> FilePath
|
||||
> -> Maybe (Int,Int)
|
||||
> -> String
|
||||
> -> Either ParseError a
|
||||
> wrapParse parser f p src =
|
||||
> wrapParse parser _ f p src =
|
||||
> either (Left . convParseError src) Right
|
||||
> $ parse (setPos p *> whitespace *> parser <* eof) f src
|
||||
> where
|
||||
|
|
@ -296,7 +303,12 @@ u&"example quoted"
|
|||
> name :: Parser Name
|
||||
> name = choice [QName <$> quotedIdentifier
|
||||
> ,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
|
||||
|
||||
|
|
@ -1289,10 +1301,13 @@ allows offset and fetch in either order
|
|||
> ,keyword_ "row"])
|
||||
|
||||
> fetch :: Parser ValueExpr
|
||||
> fetch = fs *> valueExpr <* ro
|
||||
> fetch = fetchFirst <|> limit
|
||||
> where
|
||||
> fetchFirst = fs *> valueExpr <* ro
|
||||
> fs = makeKeywordTree ["fetch first", "fetch next"]
|
||||
> ro = makeKeywordTree ["rows only", "row only"]
|
||||
> -- todo: not in ansi sql dialect
|
||||
> limit = keyword_ "limit" *> valueExpr
|
||||
|
||||
== common table expressions
|
||||
|
||||
|
|
@ -1971,4 +1986,6 @@ means).
|
|||
> ,"within"
|
||||
> ,"without"
|
||||
> --,"year"
|
||||
> -- added for mysql dialect, todo: make dialect specific lists
|
||||
> ,"limit"
|
||||
> ]
|
||||
|
|
|
|||
|
|
@ -19,17 +19,17 @@ which have been changed to try to improve the layout of the output.
|
|||
> import Data.List (intercalate)
|
||||
|
||||
> -- | Convert a query expr ast to concrete syntax.
|
||||
> prettyQueryExpr :: QueryExpr -> String
|
||||
> prettyQueryExpr = render . queryExpr
|
||||
> prettyQueryExpr :: Dialect -> QueryExpr -> String
|
||||
> prettyQueryExpr _ = render . queryExpr
|
||||
|
||||
> -- | Convert a value expr ast to concrete syntax.
|
||||
> prettyValueExpr :: ValueExpr -> String
|
||||
> prettyValueExpr = render . valueExpr
|
||||
> prettyValueExpr :: Dialect -> ValueExpr -> String
|
||||
> prettyValueExpr _ = render . valueExpr
|
||||
|
||||
> -- | Convert a list of query exprs to concrete syntax. A semi colon
|
||||
> -- is inserted after each query expr.
|
||||
> prettyQueryExprs :: [QueryExpr] -> String
|
||||
> prettyQueryExprs = render . vcat . map ((<> text ";\n") . queryExpr)
|
||||
> prettyQueryExprs :: Dialect -> [QueryExpr] -> String
|
||||
> prettyQueryExprs _ = render . vcat . map ((<> text ";\n") . queryExpr)
|
||||
|
||||
= value expressions
|
||||
|
||||
|
|
@ -248,6 +248,7 @@ which have been changed to try to improve the layout of the output.
|
|||
> name (UQName n) =
|
||||
> text "U&" <> doubleQuotes (text $ doubleUpDoubleQuotes n)
|
||||
> name (Name n) = text n
|
||||
> name (DQName s e n) = text s <> text n <> text e
|
||||
|
||||
> names :: [Name] -> Doc
|
||||
> names ns = hcat $ punctuate (text ".") $ map name ns
|
||||
|
|
|
|||
|
|
@ -30,6 +30,8 @@
|
|||
> ,TableRef(..)
|
||||
> ,JoinType(..)
|
||||
> ,JoinCondition(..)
|
||||
> -- * dialect
|
||||
> ,Dialect(..)
|
||||
> ) where
|
||||
|
||||
> import Data.Data
|
||||
|
|
@ -165,6 +167,8 @@
|
|||
> data Name = Name String
|
||||
> | QName 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)
|
||||
|
||||
> -- | 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
|
||||
> | JoinUsing [Name] -- ^ using (column list)
|
||||
> 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
7
TODO
|
|
@ -1,8 +1,13 @@
|
|||
work on reasonable subset of sql which is similar to the current
|
||||
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
|
||||
|
||||
simple stuff for error message and pretty printing monitoring
|
||||
|
||||
work on the new refactoring of the parser
|
||||
create a new module for generic combinators
|
||||
|
|
|
|||
|
|
@ -1,8 +1,9 @@
|
|||
If you need help updating to a new version of simple-sql-parser,
|
||||
please email jakewheatmail@gmail.com or use the github bug tracker,
|
||||
https://github.com/JakeWheat/simple-sql-parser/issues.
|
||||
|
||||
0.4.0 (updated to dbd48baaa1d1bce3d0d0139b8ffe55370fabe672)
|
||||
0.4.1 (unreleased)
|
||||
simple demonstration of how dialects could be handled internally
|
||||
0.4.0 (commit 7914898cc8f07bbaf8358d208469392346341964)
|
||||
now targets SQL:2011
|
||||
update to ghc 7.8.2
|
||||
remove dependency on haskell-src-exts
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
name: simple-sql-parser
|
||||
version: 0.4.0
|
||||
version: 0.4.1
|
||||
synopsis: A parser for SQL queries
|
||||
|
||||
description: A parser for SQL queries. Parses most SQL:2011
|
||||
|
|
@ -64,6 +64,7 @@ Test-Suite Tests
|
|||
Language.SQL.SimpleSQL.ErrorMessages,
|
||||
Language.SQL.SimpleSQL.FullQueries,
|
||||
Language.SQL.SimpleSQL.GroupBy,
|
||||
Language.SQL.SimpleSQL.MySQL,
|
||||
Language.SQL.SimpleSQL.Postgres,
|
||||
Language.SQL.SimpleSQL.QueryExprComponents,
|
||||
Language.SQL.SimpleSQL.QueryExprs,
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ Some tests for parsing full queries.
|
|||
|
||||
|
||||
> fullQueriesTests :: TestItem
|
||||
> fullQueriesTests = Group "queries" $ map (uncurry TestQueryExpr)
|
||||
> fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("select count(*) from t"
|
||||
> ,makeSelect
|
||||
> {qeSelectList = [(App [Name "count"] [Star], Nothing)]
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ Here are the tests for the group by component of query exprs
|
|||
> ]
|
||||
|
||||
> simpleGroupBy :: TestItem
|
||||
> simpleGroupBy = Group "simpleGroupBy" $ map (uncurry TestQueryExpr)
|
||||
> simpleGroupBy = Group "simpleGroupBy" $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("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)
|
||||
> newGroupBy = Group "newGroupBy" $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("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
|
||||
> randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr SQL2011)
|
||||
> ["select * from t GROUP BY a"
|
||||
> ,"select * from t GROUP BY GROUPING SETS((a))"
|
||||
> ,"select * from t GROUP BY a,b,c"
|
||||
|
|
|
|||
36
tools/Language/SQL/SimpleSQL/MySQL.lhs
Normal file
36
tools/Language/SQL/SimpleSQL/MySQL.lhs
Normal 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"]]
|
||||
> }
|
||||
|
|
@ -6,10 +6,9 @@ revisited when the dialect support is added.
|
|||
> module Language.SQL.SimpleSQL.Postgres (postgresTests) where
|
||||
|
||||
> import Language.SQL.SimpleSQL.TestTypes
|
||||
> --import Language.SQL.SimpleSQL.Syntax
|
||||
|
||||
> postgresTests :: TestItem
|
||||
> postgresTests = Group "postgresTests" $ map ParseQueryExpr
|
||||
> postgresTests = Group "postgresTests" $ map (ParseQueryExpr SQL2011)
|
||||
|
||||
lexical syntax section
|
||||
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ These are a few misc tests which don't fit anywhere else.
|
|||
|
||||
|
||||
> duplicates :: TestItem
|
||||
> duplicates = Group "duplicates" $ map (uncurry TestQueryExpr)
|
||||
> duplicates = Group "duplicates" $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("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)
|
||||
> selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("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)
|
||||
> whereClause = Group "whereClause" $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("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)
|
||||
> having = Group "having" $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("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)
|
||||
> orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("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)
|
||||
> offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [-- 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)
|
||||
> combos = Group "combos" $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("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)
|
||||
> withQueries = Group "with queries" $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("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)
|
||||
> values = Group "values" $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("values (1,2),(3,4)"
|
||||
> ,Values [[NumLit "1", NumLit "2"]
|
||||
> ,[NumLit "3", NumLit "4"]])
|
||||
> ]
|
||||
|
||||
> tables :: TestItem
|
||||
> tables = Group "tables" $ map (uncurry TestQueryExpr)
|
||||
> tables = Group "tables" $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("table tbl", Table [Name "tbl"])
|
||||
> ]
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ query expressions from one string.
|
|||
> import Language.SQL.SimpleSQL.Syntax
|
||||
|
||||
> 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;select 1",[ms,ms])
|
||||
|
|
|
|||
|
|
@ -482,7 +482,7 @@ Specify a non-null value.
|
|||
|
||||
> characterStringLiterals :: TestItem
|
||||
> characterStringLiterals = Group "character string literals"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("'a regular string literal'"
|
||||
> ,StringLit "a regular string literal")
|
||||
> ,("'something' ' some more' 'and more'"
|
||||
|
|
@ -510,7 +510,7 @@ character set allows them.
|
|||
|
||||
> nationalCharacterStringLiterals :: TestItem
|
||||
> nationalCharacterStringLiterals = Group "national character string literals"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("N'something'", CSStringLit "N" "something")
|
||||
> ,("n'something'", CSStringLit "n" "something")
|
||||
> ]
|
||||
|
|
@ -527,7 +527,7 @@ character set allows them.
|
|||
|
||||
> unicodeCharacterStringLiterals :: TestItem
|
||||
> unicodeCharacterStringLiterals = Group "unicode character string literals"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("U&'something'", CSStringLit "U&" "something")
|
||||
> ,("u&'something' escape ="
|
||||
> ,Escape (CSStringLit "u&" "something") '=')
|
||||
|
|
@ -546,7 +546,7 @@ TODO: unicode escape
|
|||
|
||||
> binaryStringLiterals :: TestItem
|
||||
> binaryStringLiterals = Group "binary string literals"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [--("B'101010'", CSStringLit "B" "101010")
|
||||
> ("X'7f7f7f'", CSStringLit "X" "7f7f7f")
|
||||
> ,("X'7f7f7f' escape z", Escape (CSStringLit "X" "7f7f7f") 'z')
|
||||
|
|
@ -576,7 +576,7 @@ TODO: unicode escape
|
|||
|
||||
> numericLiterals :: TestItem
|
||||
> numericLiterals = Group "numeric literals"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("11", NumLit "11")
|
||||
> ,("11.11", NumLit "11.11")
|
||||
|
||||
|
|
@ -682,7 +682,7 @@ TODO: unicode escape
|
|||
|
||||
> intervalLiterals :: TestItem
|
||||
> intervalLiterals = Group "intervalLiterals literals"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("interval '1'", TypedLit (TypeName [Name "interval"]) "1")
|
||||
> ,("interval '1' day"
|
||||
> ,IntervalLit Nothing "1" (Itf "day" Nothing) Nothing)
|
||||
|
|
@ -705,7 +705,7 @@ TODO: unicode escape
|
|||
|
||||
> booleanLiterals :: TestItem
|
||||
> booleanLiterals = Group "boolean literals"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("true", Iden [Name "true"])
|
||||
> ,("false", Iden [Name "false"])
|
||||
> ,("unknown", Iden [Name "unknown"])
|
||||
|
|
@ -725,7 +725,7 @@ Specify names.
|
|||
|
||||
> identifiers :: TestItem
|
||||
> identifiers = Group "identifiers"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("test",Iden [Name "test"])
|
||||
> ,("_test",Iden [Name "_test"])
|
||||
> ,("t1",Iden [Name "t1"])
|
||||
|
|
@ -1166,7 +1166,7 @@ Now test each variation in both cast expression and typed literal
|
|||
expression
|
||||
|
||||
> typeNameTests :: TestItem
|
||||
> typeNameTests = Group "type names" $ map (uncurry TestValueExpr)
|
||||
> typeNameTests = Group "type names" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> $ concatMap makeTests typeNames
|
||||
> where
|
||||
> makeTests (ctn, stn) =
|
||||
|
|
@ -1184,7 +1184,7 @@ Define a field of a row type.
|
|||
|
||||
> fieldDefinition :: TestItem
|
||||
> fieldDefinition = Group "field definition"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("cast('(1,2)' as row(a int,b char))"
|
||||
> ,Cast (StringLit "(1,2)")
|
||||
> $ RowTypeName [(Name "a", TypeName [Name "int"])
|
||||
|
|
@ -1264,7 +1264,7 @@ Specify a value that is syntactically self-delimited.
|
|||
|
||||
> parenthesizedValueExpression :: TestItem
|
||||
> parenthesizedValueExpression = Group "parenthesized value expression"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("(3)", 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 = Group "general value specification"
|
||||
> $ map (uncurry TestValueExpr) $
|
||||
> $ map (uncurry (TestValueExpr SQL2011)) $
|
||||
> map mkIden ["CURRENT_DEFAULT_TRANSFORM_GROUP"
|
||||
> ,"CURRENT_PATH"
|
||||
> ,"CURRENT_ROLE"
|
||||
|
|
@ -1354,7 +1354,7 @@ TODO: add the missing bits
|
|||
|
||||
> parameterSpecification :: TestItem
|
||||
> parameterSpecification = Group "parameter specification"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [(":hostparam", HostParameter "hostparam" Nothing)
|
||||
> ,(":hostparam indicator :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 =
|
||||
> Group "contextually typed value specification"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("null", Iden [Name "null"])
|
||||
> ,("array[]", Array (Iden [Name "array"]) [])
|
||||
> ,("multiset[]", MultisetCtor [])
|
||||
|
|
@ -1409,7 +1409,7 @@ Disambiguate a <period>-separated chain of identifiers.
|
|||
|
||||
> identifierChain :: TestItem
|
||||
> identifierChain = Group "identifier chain"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("a.b", Iden [Name "a",Name "b"])]
|
||||
|
||||
== 6.7 <column reference>
|
||||
|
|
@ -1423,7 +1423,7 @@ Reference a column.
|
|||
|
||||
> columnReference :: TestItem
|
||||
> columnReference = Group "column reference"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("module.a.b", Iden [Name "module",Name "a",Name "b"])]
|
||||
|
||||
== 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 = Group "set function specification"
|
||||
> $ map (uncurry TestQueryExpr)
|
||||
> $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("SELECT SalesQuota, SUM(SalesYTD) TotalSalesYTD,\n\
|
||||
> \ GROUPING(SalesQuota) AS Grouping\n\
|
||||
> \FROM Sales.SalesPerson\n\
|
||||
|
|
@ -1647,7 +1647,7 @@ Specify a data conversion.
|
|||
|
||||
> castSpecification :: TestItem
|
||||
> castSpecification = Group "cast specification"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("cast(a as int)"
|
||||
> ,Cast (Iden [Name "a"]) (TypeName [Name "int"]))
|
||||
> ]
|
||||
|
|
@ -1661,7 +1661,7 @@ Return the next value of a sequence generator.
|
|||
|
||||
> nextValueExpression :: TestItem
|
||||
> nextValueExpression = Group "next value expression"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("next value for a.b", NextValueFor [Name "a", Name "b"])
|
||||
> ]
|
||||
|
||||
|
|
@ -1674,7 +1674,7 @@ Reference a field of a row value.
|
|||
|
||||
> fieldReference :: TestItem
|
||||
> fieldReference = Group "field reference"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("f(something).a"
|
||||
> ,BinOp (App [Name "f"] [Iden [Name "something"]])
|
||||
> [Name "."]
|
||||
|
|
@ -1798,7 +1798,7 @@ Return an element of an array.
|
|||
|
||||
> arrayElementReference :: TestItem
|
||||
> arrayElementReference = Group "array element reference"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("something[3]"
|
||||
> ,Array (Iden [Name "something"]) [NumLit "3"])
|
||||
> ,("(something(a))[x]"
|
||||
|
|
@ -1821,7 +1821,7 @@ Return the sole element of a multiset of one element.
|
|||
|
||||
> multisetElementReference :: TestItem
|
||||
> multisetElementReference = Group "multisetElementReference"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("element(something)"
|
||||
> ,App [Name "element"] [Iden [Name "something"]])
|
||||
> ]
|
||||
|
|
@ -1871,7 +1871,7 @@ Specify a numeric value.
|
|||
|
||||
> numericValueExpression :: TestItem
|
||||
> numericValueExpression = Group "numeric value expression"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("a + b", binOp "+")
|
||||
> ,("a - b", binOp "-")
|
||||
> ,("a * b", binOp "*")
|
||||
|
|
@ -2328,7 +2328,7 @@ Specify a boolean value.
|
|||
|
||||
> booleanValueExpression :: TestItem
|
||||
> booleanValueExpression = Group "booleab value expression"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("a or b", BinOp a [Name "or"] b)
|
||||
> ,("a and b", BinOp a [Name "and"] b)
|
||||
> ,("not a", PrefixOp [Name "not"] a)
|
||||
|
|
@ -2403,7 +2403,7 @@ Specify construction of an array.
|
|||
|
||||
> arrayValueConstructor :: TestItem
|
||||
> arrayValueConstructor = Group "array value constructor"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("array[1,2,3]"
|
||||
> ,Array (Iden [Name "array"])
|
||||
> [NumLit "1", NumLit "2", NumLit "3"])
|
||||
|
|
@ -2441,7 +2441,7 @@ Specify a multiset value.
|
|||
|
||||
> multisetValueExpression :: TestItem
|
||||
> multisetValueExpression = Group "multiset value expression"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("a multiset union b"
|
||||
> ,MultisetBinOp (Iden [Name "a"]) Union SQDefault (Iden [Name "b"]))
|
||||
> ,("a multiset union all b"
|
||||
|
|
@ -2468,7 +2468,7 @@ Specify a function yielding a value of a multiset type.
|
|||
|
||||
> multisetValueFunction :: TestItem
|
||||
> multisetValueFunction = Group "multiset value function"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("set(a)", App [Name "set"] [Iden [Name "a"]])
|
||||
> ]
|
||||
|
||||
|
|
@ -2496,7 +2496,7 @@ Specify construction of a multiset.
|
|||
|
||||
> multisetValueConstructor :: TestItem
|
||||
> multisetValueConstructor = Group "multiset value constructor"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("multiset[a,b,c]", MultisetCtor[Iden [Name "a"]
|
||||
> ,Iden [Name "b"], Iden [Name "c"]])
|
||||
> ,("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 = Group "row value constructor"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("(a,b)"
|
||||
> ,SpecialOp [Name "rowctor"] [Iden [Name "a"], Iden [Name "b"]])
|
||||
> ,("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 = Group "table value constructor"
|
||||
> $ map (uncurry TestQueryExpr)
|
||||
> $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("values (1,2), (a+b,(select count(*) from t));"
|
||||
> ,Values [[NumLit "1", NumLit "2"]
|
||||
> ,[BinOp (Iden [Name "a"]) [Name "+"]
|
||||
|
|
@ -2660,7 +2660,7 @@ Specify a table derived from one or more tables.
|
|||
|
||||
> fromClause :: TestItem
|
||||
> fromClause = Group "fromClause"
|
||||
> $ map (uncurry TestQueryExpr)
|
||||
> $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("select * from tbl1,tbl2"
|
||||
> ,makeSelect
|
||||
> {qeSelectList = [(Star, Nothing)]
|
||||
|
|
@ -2675,7 +2675,7 @@ Reference a table.
|
|||
|
||||
> tableReference :: TestItem
|
||||
> tableReference = Group "table reference"
|
||||
> $ map (uncurry TestQueryExpr)
|
||||
> $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("select * from t", sel)
|
||||
|
||||
<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 = Group "joined table"
|
||||
> $ map (uncurry TestQueryExpr)
|
||||
> $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("select * from a cross join b"
|
||||
> ,sel $ TRJoin a False JCross b Nothing)
|
||||
> ,("select * from a join b on true"
|
||||
|
|
@ -2913,7 +2913,7 @@ the result of the preceding <from clause>.
|
|||
|
||||
> whereClause :: TestItem
|
||||
> whereClause = Group "where clause"
|
||||
> $ map (uncurry TestQueryExpr)
|
||||
> $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("select * from t where a = 5"
|
||||
> ,makeSelect
|
||||
> {qeSelectList = [(Star,Nothing)]
|
||||
|
|
@ -2973,7 +2973,7 @@ clause> to the result of the previously specified clause.
|
|||
|
||||
> groupByClause :: TestItem
|
||||
> groupByClause = Group "group by clause"
|
||||
> $ map (uncurry TestQueryExpr)
|
||||
> $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("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"
|
||||
|
|
@ -3021,7 +3021,7 @@ not satisfy a <search condition>.
|
|||
|
||||
> havingClause :: TestItem
|
||||
> havingClause = Group "having clause"
|
||||
> $ map (uncurry TestQueryExpr)
|
||||
> $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("select a,sum(x) from t group by a having sum(x) > 1000"
|
||||
> ,makeSelect
|
||||
> {qeSelectList = [(Iden [Name "a"], Nothing)
|
||||
|
|
@ -3144,7 +3144,7 @@ Specify a table derived from the result of a <table expression>.
|
|||
|
||||
> querySpecification :: TestItem
|
||||
> querySpecification = Group "query specification"
|
||||
> $ map (uncurry TestQueryExpr)
|
||||
> $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("select a from t",qe)
|
||||
> ,("select all a from t",qe {qeSetQuantifier = All})
|
||||
> ,("select distinct a from t",qe {qeSetQuantifier = Distinct})
|
||||
|
|
@ -3212,7 +3212,7 @@ Specify a table.
|
|||
|
||||
> setOpQueryExpression :: TestItem
|
||||
> setOpQueryExpression= Group "set operation query expression"
|
||||
> $ map (uncurry TestQueryExpr)
|
||||
> $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> -- todo: complete setop query expression tests
|
||||
> [{-("select * from t union select * from t"
|
||||
> ,undefined)
|
||||
|
|
@ -3249,7 +3249,7 @@ everywhere
|
|||
|
||||
> explicitTableQueryExpression :: TestItem
|
||||
> explicitTableQueryExpression= Group "explicit table query expression"
|
||||
> $ map (uncurry TestQueryExpr)
|
||||
> $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("table t", Table [Name "t"])
|
||||
> ]
|
||||
|
||||
|
|
@ -3271,7 +3271,7 @@ everywhere
|
|||
|
||||
> orderOffsetFetchQueryExpression :: TestItem
|
||||
> orderOffsetFetchQueryExpression = Group "order, offset, fetch query expression"
|
||||
> $ map (uncurry TestQueryExpr)
|
||||
> $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [-- todo: finish tests for order offset and fetch
|
||||
> ("select a from t order by a"
|
||||
> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])
|
||||
|
|
@ -3428,7 +3428,7 @@ Specify a comparison of two row values.
|
|||
|
||||
> comparisonPredicates :: TestItem
|
||||
> comparisonPredicates = Group "comparison predicates"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> $ map mkOp ["=", "<>", "<", ">", "<=", ">="]
|
||||
> ++ [("ROW(a) = ROW(b)"
|
||||
> ,BinOp (App [Name "ROW"] [a])
|
||||
|
|
@ -3632,7 +3632,7 @@ Specify a quantified comparison.
|
|||
|
||||
> quantifiedComparisonPredicate :: TestItem
|
||||
> quantifiedComparisonPredicate = Group "quantified comparison predicate"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
|
||||
> [("a = any (select * from t)"
|
||||
> ,QuantifiedComparison (Iden [Name "a"]) [Name "="] CPAny qe)
|
||||
|
|
@ -3659,7 +3659,7 @@ Specify a test for a non-empty set.
|
|||
|
||||
> existsPredicate :: TestItem
|
||||
> existsPredicate = Group "exists predicate"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("exists(select * from t where a = 4)"
|
||||
> ,SubQueryExpr SqExists
|
||||
> $ makeSelect
|
||||
|
|
@ -3678,7 +3678,7 @@ Specify a test for the absence of duplicate rows.
|
|||
|
||||
> uniquePredicate :: TestItem
|
||||
> uniquePredicate = Group "unique predicate"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("unique(select * from t where a = 4)"
|
||||
> ,SubQueryExpr SqUnique
|
||||
> $ makeSelect
|
||||
|
|
@ -3714,7 +3714,7 @@ Specify a test for matching rows.
|
|||
|
||||
> matchPredicate :: TestItem
|
||||
> matchPredicate = Group "match predicate"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("a match (select a from t)"
|
||||
> ,Match (Iden [Name "a"]) False qe)
|
||||
> ,("(a,b) match (select a,b from t)"
|
||||
|
|
@ -4066,7 +4066,7 @@ Specify a default collation.
|
|||
|
||||
> collateClause :: TestItem
|
||||
> collateClause = Group "collate clause"
|
||||
> $ map (uncurry TestValueExpr)
|
||||
> $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("a collate 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 = Group "aggregate function"
|
||||
> $ map (uncurry TestValueExpr) $
|
||||
> $ map (uncurry (TestValueExpr SQL2011)) $
|
||||
> [("count(*)",App [Name "count"] [Star])
|
||||
> ,("count(*) filter (where something > 5)"
|
||||
> ,AggregateApp [Name "count"] SQDefault [Star] [] fil)
|
||||
|
|
@ -4272,7 +4272,7 @@ Specify a sort order.
|
|||
|
||||
> sortSpecificationList :: TestItem
|
||||
> sortSpecificationList = Group "sort specification list"
|
||||
> $ map (uncurry TestQueryExpr)
|
||||
> $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("select * from t order by a"
|
||||
> ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])
|
||||
> DirDefault NullsOrderDefault]})
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ expression
|
|||
|
||||
|
||||
> tableRefTests :: TestItem
|
||||
> tableRefTests = Group "tableRefTests" $ map (uncurry TestQueryExpr)
|
||||
> tableRefTests = Group "tableRefTests" $ map (uncurry (TestQueryExpr SQL2011))
|
||||
> [("select a from t"
|
||||
> ,ms [TRSimple [Name "t"]])
|
||||
|
||||
|
|
|
|||
|
|
@ -2,18 +2,20 @@
|
|||
This is the types used to define the tests as pure data. See the
|
||||
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
|
||||
|
||||
> data TestItem = Group String [TestItem]
|
||||
> | TestValueExpr String ValueExpr
|
||||
> | TestQueryExpr String QueryExpr
|
||||
> | TestQueryExprs String [QueryExpr]
|
||||
> | TestValueExpr Dialect String ValueExpr
|
||||
> | TestQueryExpr Dialect String QueryExpr
|
||||
> | TestQueryExprs Dialect String [QueryExpr]
|
||||
|
||||
this just checks the sql parses without error, mostly just a
|
||||
intermediate when I'm too lazy to write out the parsed AST. These
|
||||
should all be TODO to convert to a testqueryexpr test.
|
||||
|
||||
> | ParseQueryExpr String
|
||||
> | ParseQueryExpr Dialect String
|
||||
> deriving (Eq,Show)
|
||||
|
|
|
|||
|
|
@ -30,6 +30,8 @@ test data to the Test.Framework tests.
|
|||
|
||||
> import Language.SQL.SimpleSQL.SQL2011
|
||||
|
||||
> import Language.SQL.SimpleSQL.MySQL
|
||||
|
||||
Order the tests to start from the simplest first. This is also the
|
||||
order on the generated documentation.
|
||||
|
||||
|
|
@ -45,6 +47,7 @@ order on the generated documentation.
|
|||
> ,postgresTests
|
||||
> ,tpchTests
|
||||
> ,sql2011Tests
|
||||
> ,mySQLTests
|
||||
> ]
|
||||
|
||||
> tests :: Test.Framework.Test
|
||||
|
|
@ -56,29 +59,30 @@ order on the generated documentation.
|
|||
> itemToTest :: TestItem -> Test.Framework.Test
|
||||
> itemToTest (Group nm ts) =
|
||||
> testGroup nm $ map itemToTest ts
|
||||
> itemToTest (TestValueExpr str expected) =
|
||||
> toTest parseValueExpr prettyValueExpr str expected
|
||||
> itemToTest (TestQueryExpr str expected) =
|
||||
> toTest parseQueryExpr prettyQueryExpr str expected
|
||||
> itemToTest (TestQueryExprs str expected) =
|
||||
> toTest parseQueryExprs prettyQueryExprs str expected
|
||||
> itemToTest (ParseQueryExpr str) =
|
||||
> toPTest parseQueryExpr prettyQueryExpr str
|
||||
> itemToTest (TestValueExpr d str expected) =
|
||||
> toTest parseValueExpr prettyValueExpr d str expected
|
||||
> itemToTest (TestQueryExpr d str expected) =
|
||||
> toTest parseQueryExpr prettyQueryExpr d str expected
|
||||
> itemToTest (TestQueryExprs d str expected) =
|
||||
> toTest parseQueryExprs prettyQueryExprs d str expected
|
||||
> itemToTest (ParseQueryExpr d str) =
|
||||
> toPTest parseQueryExpr prettyQueryExpr d str
|
||||
|
||||
> toTest :: (Eq a, Show a) =>
|
||||
> (String -> Maybe (Int,Int) -> String -> Either ParseError a)
|
||||
> -> (a -> String)
|
||||
> (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
|
||||
> -> (Dialect -> a -> String)
|
||||
> -> Dialect
|
||||
> -> String
|
||||
> -> a
|
||||
> -> Test.Framework.Test
|
||||
> toTest parser pp str expected = testCase str $ do
|
||||
> let egot = parser "" Nothing str
|
||||
> toTest parser pp d str expected = testCase str $ do
|
||||
> let egot = parser d "" Nothing str
|
||||
> case egot of
|
||||
> Left e -> H.assertFailure $ peFormattedError e
|
||||
> Right got -> do
|
||||
> H.assertEqual "" expected got
|
||||
> let str' = pp got
|
||||
> let egot' = parser "" Nothing str'
|
||||
> let str' = pp d got
|
||||
> let egot' = parser d "" Nothing str'
|
||||
> case egot' of
|
||||
> Left e' -> H.assertFailure $ "pp roundtrip"
|
||||
> ++ "\n" ++ str'
|
||||
|
|
@ -88,17 +92,18 @@ order on the generated documentation.
|
|||
> expected got'
|
||||
|
||||
> toPTest :: (Eq a, Show a) =>
|
||||
> (String -> Maybe (Int,Int) -> String -> Either ParseError a)
|
||||
> -> (a -> String)
|
||||
> (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
|
||||
> -> (Dialect -> a -> String)
|
||||
> -> Dialect
|
||||
> -> String
|
||||
> -> Test.Framework.Test
|
||||
> toPTest parser pp str = testCase str $ do
|
||||
> let egot = parser "" Nothing str
|
||||
> toPTest parser pp d str = testCase str $ do
|
||||
> let egot = parser d "" Nothing str
|
||||
> case egot of
|
||||
> Left e -> H.assertFailure $ peFormattedError e
|
||||
> Right got -> do
|
||||
> let str' = pp got
|
||||
> let egot' = parser "" Nothing str'
|
||||
> let str' = pp d got
|
||||
> let egot' = parser d "" Nothing str'
|
||||
> case egot' of
|
||||
> Left e' -> H.assertFailure $ "pp roundtrip "
|
||||
> ++ "\n" ++ str' ++ "\n"
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ The changes made to the official syntax are:
|
|||
> tpchTests :: TestItem
|
||||
> tpchTests =
|
||||
> Group "parse tpch"
|
||||
> $ map (ParseQueryExpr . snd) tpchQueries
|
||||
> $ map (ParseQueryExpr SQL2011 . snd) tpchQueries
|
||||
|
||||
> tpchQueries :: [(String,String)]
|
||||
> tpchQueries =
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ Tests for parsing value expressions
|
|||
> ]
|
||||
|
||||
> literals :: TestItem
|
||||
> literals = Group "literals" $ map (uncurry TestValueExpr)
|
||||
> literals = Group "literals" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("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)
|
||||
> identifiers = Group "identifiers" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("iden1", Iden [Name "iden1"])
|
||||
> --,("t.a", Iden2 "t" "a")
|
||||
> ,("\"quoted identifier\"", Iden [QName "quoted identifier"])
|
||||
> ]
|
||||
|
||||
> star :: TestItem
|
||||
> star = Group "star" $ map (uncurry TestValueExpr)
|
||||
> star = Group "star" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("*", Star)
|
||||
> --,("t.*", Star2 "t")
|
||||
> --,("ROW(t.*,42)", App "ROW" [Star2 "t", NumLit "42"])
|
||||
> ]
|
||||
|
||||
> parameter :: TestItem
|
||||
> parameter = Group "parameter" $ map (uncurry TestValueExpr)
|
||||
> parameter = Group "parameter" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("?", Parameter)
|
||||
> ]
|
||||
|
||||
|
||||
> dots :: TestItem
|
||||
> dots = Group "dot" $ map (uncurry TestValueExpr)
|
||||
> dots = Group "dot" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("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)
|
||||
> app = Group "app" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("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)
|
||||
> caseexp = Group "caseexp" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("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)
|
||||
> binaryOperators = Group "binaryOperators" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("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)
|
||||
> unaryOperators = Group "unaryOperators" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("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)
|
||||
> casts = Group "operators" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("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)
|
||||
> subqueries = Group "unaryOperators" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("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)
|
||||
> miscOps = Group "unaryOperators" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("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)
|
||||
> aggregates = Group "aggregates" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("count(*)",App [Name "count"] [Star])
|
||||
|
||||
> ,("sum(a order by a)"
|
||||
|
|
@ -341,7 +341,7 @@ target_string
|
|||
> ]
|
||||
|
||||
> 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)
|
||||
> ,("count(*) over ()", WindowApp [Name "count"] [Star] [] [] Nothing)
|
||||
|
||||
|
|
@ -400,7 +400,7 @@ target_string
|
|||
> ]
|
||||
|
||||
> parens :: TestItem
|
||||
> parens = Group "parens" $ map (uncurry TestValueExpr)
|
||||
> parens = Group "parens" $ map (uncurry (TestValueExpr SQL2011))
|
||||
> [("(a)", Parens (Iden [Name "a"]))
|
||||
> ,("(a + b)", Parens (BinOp (Iden [Name "a"]) [Name "+"] (Iden [Name "b"])))
|
||||
> ]
|
||||
|
|
|
|||
Loading…
Reference in a new issue