From a4d91b3e44ef71ebf179db3c51e1370b237242e7 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Mon, 15 Feb 2016 20:33:37 +0200
Subject: [PATCH] add support for odbc symbols: {} in lexer

---
 Language/SQL/SimpleSQL/Dialect.lhs          | 15 +++++++++------
 Language/SQL/SimpleSQL/Lex.lhs              | 18 ++++++++++++++----
 Language/SQL/SimpleSQL/Syntax.lhs           |  2 +-
 tools/Language/SQL/SimpleSQL/LexerTests.lhs |  9 +++++----
 tools/Language/SQL/SimpleSQL/TestTypes.lhs  |  3 ++-
 5 files changed, 31 insertions(+), 16 deletions(-)

diff --git a/Language/SQL/SimpleSQL/Dialect.lhs b/Language/SQL/SimpleSQL/Dialect.lhs
index 4a85f97..8551662 100644
--- a/Language/SQL/SimpleSQL/Dialect.lhs
+++ b/Language/SQL/SimpleSQL/Dialect.lhs
@@ -27,25 +27,28 @@ hack for now, later will expand to flags on a feature by feature basis
 
 > -- | Used to set the dialect used for parsing and pretty printing,
 > -- very unfinished at the moment.
-> data Dialect = Dialect {diSyntaxFlavour :: SyntaxFlavour}
+> data Dialect = Dialect {diSyntaxFlavour :: SyntaxFlavour
+>                        ,allowOdbc :: Bool}
 >                deriving (Eq,Show,Read,Data,Typeable)
 
 > -- | ansi sql 2011 dialect
 > ansi2011 :: Dialect
-> ansi2011 = Dialect ANSI2011
+> ansi2011 = Dialect ANSI2011 False
 
 > -- | mysql dialect
 > mysql :: Dialect
-> mysql = Dialect MySQL
+> mysql = Dialect MySQL False
 
 > -- | postgresql dialect
 > postgres :: Dialect
-> postgres = Dialect Postgres
+> postgres = Dialect Postgres False
 
 > -- | oracle dialect
 > oracle :: Dialect
-> oracle = Dialect Oracle
+> oracle = Dialect Oracle False
 
 > -- | microsoft sql server dialect
 > sqlserver :: Dialect
-> sqlserver = Dialect SQLServer
+> sqlserver = Dialect SQLServer False
+
+
diff --git a/Language/SQL/SimpleSQL/Lex.lhs b/Language/SQL/SimpleSQL/Lex.lhs
index 20aa175..cccb7b7 100644
--- a/Language/SQL/SimpleSQL/Lex.lhs
+++ b/Language/SQL/SimpleSQL/Lex.lhs
@@ -375,7 +375,11 @@ A multiple-character operator name cannot end in + or -, unless the name also co
 >    -- symbol because this is the least complex way to do it
 >    otherSymbol = many1 (char '.') :
 >                  (map (try . string) ["::", ":="]
->                   ++ map (string . (:[])) "[],;():")
+>                   ++ map (string . (:[])) "[],;():"
+>                   ++ if allowOdbc d
+>                      then [string "{", string "}"]
+>                      else []
+>                  )
 
 exception char is one of:
 ~ ! @ # % ^ & | ` ?
@@ -433,7 +437,10 @@ which allows the last character of a multi character symbol to be + or
 >    Symbol <$> choice (otherSymbol ++ regularOp)
 >  where
 >    otherSymbol = many1 (char '.') :
->                  map (string . (:[])) ",;():?"
+>                  (map (string . (:[])) ",;():?"
+>                   ++ if allowOdbc d
+>                      then [string "{", string "}"]
+>                      else [])
 
 try is used because most of the first characters of the two character
 symbols can also be part of a single character symbol
@@ -444,11 +451,14 @@ symbols can also be part of a single character symbol
 >                    choice ["||" <$ char '|' <* notFollowedBy (char '|')
 >                           ,return "|"]]
 
-> symbol _ =
+> symbol d =
 >    Symbol <$> choice (otherSymbol ++ regularOp)
 >  where
 >    otherSymbol = many1 (char '.') :
->                  map (string . (:[])) "[],;():?"
+>                  (map (string . (:[])) "[],;():?"
+>                   ++ if allowOdbc d
+>                      then [string "{", string "}"]
+>                      else [])
 
 try is used because most of the first characters of the two character
 symbols can also be part of a single character symbol
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index 626b17e..f43ba58 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -56,7 +56,7 @@
 >     ,AdminOptionFor(..)
 >     ,GrantOptionFor(..)
 >      -- * Dialects
->     ,Dialect
+>     ,Dialect(allowOdbc)
 >     ,ansi2011
 >     ,mysql
 >     ,postgres
diff --git a/tools/Language/SQL/SimpleSQL/LexerTests.lhs b/tools/Language/SQL/SimpleSQL/LexerTests.lhs
index bdcf9a8..39709b9 100644
--- a/tools/Language/SQL/SimpleSQL/LexerTests.lhs
+++ b/tools/Language/SQL/SimpleSQL/LexerTests.lhs
@@ -303,10 +303,11 @@ the + or -.
 
 > odbcLexerTests :: TestItem
 > odbcLexerTests = Group "odbcLexTests" $
->     [ LexTest sqlserver {- {odbc = True} -} s t | (s,t) <-
->     [--("{}", [Symbol "{", Symbol "}"])
->     ]
->     ]
+>     [ LexTest sqlserver {allowOdbc = True} s t | (s,t) <-
+>     [("{}", [Symbol "{", Symbol "}"])
+>     ]]
+>     ++ [LexFails sqlserver "{"
+>        ,LexFails sqlserver "}"]
 
 > combos :: [a] -> Int -> [[a]]
 > combos _ 0 = [[]]
diff --git a/tools/Language/SQL/SimpleSQL/TestTypes.lhs b/tools/Language/SQL/SimpleSQL/TestTypes.lhs
index b9cb4bc..6d1c720 100644
--- a/tools/Language/SQL/SimpleSQL/TestTypes.lhs
+++ b/tools/Language/SQL/SimpleSQL/TestTypes.lhs
@@ -4,7 +4,8 @@ Tests.lhs module for the 'interpreter'.
 
 > module Language.SQL.SimpleSQL.TestTypes
 >     (TestItem(..)
->     ,ansi2011,mysql,postgres,oracle,sqlserver) where
+>     ,ansi2011,mysql,postgres,oracle,sqlserver
+>     ,allowOdbc) where
 
 > import Language.SQL.SimpleSQL.Syntax
 > import Language.SQL.SimpleSQL.Lex (Token)