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