From c8d745fd2896179a30d2e9222e9536e226c016a7 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Sun, 21 Feb 2016 23:43:19 +0200
Subject: [PATCH] add support for odbc scalar exprs
---
Language/SQL/SimpleSQL/Parse.lhs | 22 ++++++++++-
Language/SQL/SimpleSQL/Pretty.lhs | 10 +++++
Language/SQL/SimpleSQL/Syntax.lhs | 14 +++++++
tools/Language/SQL/SimpleSQL/Odbc.lhs | 52 ++++++++++++++++++++++++++
tools/Language/SQL/SimpleSQL/Tests.lhs | 2 +
5 files changed, 99 insertions(+), 1 deletion(-)
create mode 100644 tools/Language/SQL/SimpleSQL/Odbc.lhs
diff --git a/Language/SQL/SimpleSQL/Parse.lhs b/Language/SQL/SimpleSQL/Parse.lhs
index 70a120b..13e0a0b 100644
--- a/Language/SQL/SimpleSQL/Parse.lhs
+++ b/Language/SQL/SimpleSQL/Parse.lhs
@@ -1104,6 +1104,25 @@ separate suffix.
> i <- names
> pure $ \v -> Collate v i
+== odbc syntax
+
+the parser supports three kinds of odbc syntax, two of which are
+scalar expressions (the other is a variation on joins)
+
+
+> odbcExpr :: Parser ValueExpr
+> odbcExpr = between (symbol "{") (symbol "}")
+> (odbcTimeLit <|> odbcFunc)
+> where
+> odbcTimeLit =
+> OdbcLiteral <$> choice [OLDate <$ keyword "d"
+> ,OLTime <$ keyword "t"
+> ,OLTimestamp <$ keyword "ts"]
+> <*> singleQuotesOnlyStringTok
+> -- todo: this parser is too general, the expr part
+> -- should be only a function call (from a whitelist of functions)
+> -- or the extract operator
+> odbcFunc = OdbcFunc <$> (keyword "fn" *> valueExpr)
== operators
@@ -1254,7 +1273,8 @@ documenting/fixing.
> ,subquery
> ,intervalLit
> ,specialOpKs
-> ,idenExpr]
+> ,idenExpr
+> ,odbcExpr]
> <?> "value expression"
expose the b expression for window frame clause range between
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index 698c383..f82e1eb 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -227,6 +227,16 @@ which have been changed to try to improve the layout of the output.
> valueExpr d (VEComment cmt v) =
> vcat $ map comment cmt ++ [valueExpr d v]
+> valueExpr _ (OdbcLiteral t s) =
+> text "{" <> lt t <+> quotes (text s) <> text "}"
+> where
+> lt OLDate = text "d"
+> lt OLTime = text "t"
+> lt OLTimestamp = text "ts"
+
+> valueExpr d (OdbcFunc e) =
+> text "{fn" <+> valueExpr d e <> text "}"
+
> unname :: Name -> String
> unname (Name Nothing n) = n
> unname (Name (Just (s,e)) n) =
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index 17cb737..98dedf9 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -19,6 +19,7 @@
> ,Frame(..)
> ,FrameRows(..)
> ,FramePos(..)
+> ,OdbcLiteralType(..)
> -- * Query expressions
> ,QueryExpr(..)
> ,makeSelect
@@ -215,6 +216,10 @@ in other places
> | MultisetQueryCtor QueryExpr
> | NextValueFor [Name]
> | VEComment [Comment] ValueExpr
+> | OdbcLiteral OdbcLiteralType String
+> -- ^ an odbc literal e.g. {d '2000-01-01'}
+> | OdbcFunc ValueExpr
+> -- ^ an odbc function call e.g. {fn CHARACTER_LENGTH('test')}
> deriving (Eq,Show,Read,Data,Typeable)
> -- | Represents an identifier name, which can be quoted or unquoted.
@@ -304,6 +309,15 @@ not sure if scalar subquery, exists and unique should be represented like this
> | UnboundedFollowing
> deriving (Eq,Show,Read,Data,Typeable)
+
+> -- | the type of an odbc literal (e.g. {d '2000-01-01'}),
+> -- correpsonding to the letter after the opening {
+> data OdbcLiteralType = OLDate
+> | OLTime
+> | OLTimestamp
+> deriving (Eq,Show,Read,Data,Typeable)
+
+
> -- | Represents a query expression, which can be:
> --
> -- * a regular select;
diff --git a/tools/Language/SQL/SimpleSQL/Odbc.lhs b/tools/Language/SQL/SimpleSQL/Odbc.lhs
new file mode 100644
index 0000000..187b8f3
--- /dev/null
+++ b/tools/Language/SQL/SimpleSQL/Odbc.lhs
@@ -0,0 +1,52 @@
+
+> module Language.SQL.SimpleSQL.Odbc (odbcTests) where
+
+> import Language.SQL.SimpleSQL.TestTypes
+> import Language.SQL.SimpleSQL.Syntax
+
+> odbcTests :: TestItem
+> odbcTests = Group "odbc" [
+> Group "datetime" [
+> e "{d '2000-01-01'}" (OdbcLiteral OLDate "2000-01-01")
+> ,e "{t '12:00:01.1'}" (OdbcLiteral OLTime "12:00:01.1")
+> ,e "{ts '2000-01-01 12:00:01.1'}"
+> (OdbcLiteral OLTimestamp "2000-01-01 12:00:01.1")
+> ]
+> ,Group "functions" [
+> e "{fn CHARACTER_LENGTH(string_exp)}"
+> $ OdbcFunc (ap "CHARACTER_LENGTH" [iden "string_exp"])
+> ,e "{fn EXTRACT(day from t)}"
+> $ OdbcFunc (SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])])
+> ,e "{fn now()}"
+> $ OdbcFunc (ap "now" [])
+> ,e "{fn CONVERT('2000-01-01', SQL_DATE)}"
+> $ OdbcFunc (ap "CONVERT"
+> [StringLit "'" "'" "2000-01-01"
+> ,iden "SQL_DATE"])
+> ,e "{fn CONVERT({fn CURDATE()}, SQL_DATE)}"
+> $ OdbcFunc (ap "CONVERT"
+> [OdbcFunc (ap "CURDATE" [])
+> ,iden "SQL_DATE"])
+> ]
+> {-,Group "outer join" [
+> ParseQueryExpr defaultParseFlags
+> "select * from {oj t1 left outer join t2 on true}"
+> $ makeSelect
+> {selSelectList = sl [si $ Star ea]
+> ,selTref = [OdbcTableRef ea (JoinTref ea (tref "t1") Unnatural LeftOuter Nothing
+> (tref "t2") (Just $ JoinOn ea (BooleanLit ea True)))]}]
+> ,Group "check parsing bugs" [
+> ParseQueryExpr defaultParseFlags
+> "select {fn CONVERT(cint,SQL_BIGINT)} from t;"
+> $ makeSelect
+> {selSelectList = sl [si $ OdbcFunc ea (App ea (name "CONVERT")
+> [ei "cint"
+> ,ei "SQL_BIGINT"])]
+> ,selTref = [tref "t"]}]-}
+> ]
+> where
+> e = TestValueExpr ansi2011 {allowOdbc = True}
+> --tsql = ParseProcSql defaultParseFlags {pfDialect=sqlServerDialect}
+> ap n = App [Name Nothing n]
+> iden n = Iden [Name Nothing n]
+
diff --git a/tools/Language/SQL/SimpleSQL/Tests.lhs b/tools/Language/SQL/SimpleSQL/Tests.lhs
index 2ab843e..84f5c66 100644
--- a/tools/Language/SQL/SimpleSQL/Tests.lhs
+++ b/tools/Language/SQL/SimpleSQL/Tests.lhs
@@ -26,6 +26,7 @@ test data to the Test.Framework tests.
> import Language.SQL.SimpleSQL.QueryExprs
> import Language.SQL.SimpleSQL.TableRefs
> import Language.SQL.SimpleSQL.ValueExprs
+> import Language.SQL.SimpleSQL.Odbc
> import Language.SQL.SimpleSQL.Tpch
> import Language.SQL.SimpleSQL.LexerTests
@@ -45,6 +46,7 @@ order on the generated documentation.
> Group "parserTest"
> [lexerTests
> ,valueExprTests
+> ,odbcTests
> ,queryExprComponentTests
> ,queryExprsTests
> ,tableRefTests