add support for quoted identifiers

Language/SQL/SimpleSQL/Fixity.lhs

@@ -73,34 +73,34 @@ the fixity code.
 > toHaskell e = case e of
 >     BinOp e0 op e1 -> HSE.InfixApp
 >                       (toHaskell e0)
->                       (HSE.QVarOp $ sym op)
+>                       (HSE.QVarOp $ sym $ name op)
 >                       (toHaskell e1)
 >     Iden {} -> str ('v':show e)
 >     StringLit {} -> str ('v':show e)
 >     NumLit {} -> str ('v':show e)
->     App n es -> HSE.App (var ('f':n)) $ ltoh es
+>     App n es -> HSE.App (var ('f':name n)) $ ltoh es
 >     Parens e0 -> HSE.Paren $ toHaskell e0
 >     IntervalLit {} -> str ('v':show e)
 >     Iden2 {} -> str ('v':show e)
 >     Star -> str ('v':show e)
 >     Star2 {} -> str ('v':show e)
 >     AggregateApp nm d es od ->
->         HSE.App (var ('a':nm))
+>         HSE.App (var ('a':name nm))
 >         $ HSE.List [str $ show (d,map snd od)
 >                    ,HSE.List $ map toHaskell es
 >                    ,HSE.List $ map (toHaskell . fst) od]
 >     WindowApp nm es pb od ->
->         HSE.App (var ('w':nm))
+>         HSE.App (var ('w':name nm))
 >         $ HSE.List [str $ show (map snd od)
 >                    ,HSE.List $ map toHaskell es
 >                    ,HSE.List $ map toHaskell pb
 >                    ,HSE.List $ map (toHaskell . fst) od]
 >     PrefixOp nm e0 ->
->         HSE.App (HSE.Var $ sym nm) (toHaskell e0)
+>         HSE.App (HSE.Var $ sym $ name nm) (toHaskell e0)
 >     PostfixOp nm e0 ->
->         HSE.App (HSE.Var $ sym ('p':nm)) (toHaskell e0)
+>         HSE.App (HSE.Var $ sym ('p':name nm)) (toHaskell e0)
 >     SpecialOp nm es ->
->         HSE.App (var ('s':nm)) $ HSE.List $ map toHaskell es
+>         HSE.App (var ('s':name nm)) $ HSE.List $ map toHaskell es
 >     -- map the two maybes to lists with either 0 or 1 element
 >     Case v ts el -> HSE.App (var "$case")
 >                     (HSE.List [ltoh $ maybeToList v
@@ -118,6 +118,9 @@ the fixity code.
 >     str = HSE.Lit . HSE.String
 >     var = HSE.Var . HSE.UnQual . HSE.Ident
 >     sym = HSE.UnQual . HSE.Symbol
+>     name n = case n of
+>        QName q -> "\"" ++ q
+>        Name m -> m
 
 
 > toSql :: HSE.Exp -> ScalarExpr
@@ -125,17 +128,17 @@ the fixity code.
 
 
 >     HSE.InfixApp e0 (HSE.QVarOp (HSE.UnQual (HSE.Symbol n))) e1 ->
->         BinOp (toSql e0) n (toSql e1)
+>         BinOp (toSql e0) (unname n) (toSql e1)
 >     HSE.Lit (HSE.String ('v':l)) -> read l
 >     HSE.App (HSE.Var (HSE.UnQual (HSE.Ident ('f':i))))
->             (HSE.List es) -> App i $ map toSql es
+>             (HSE.List es) -> App (unname i) $ map toSql es
 >     HSE.Paren e0 -> Parens $ toSql e0
 >     HSE.App (HSE.Var (HSE.UnQual (HSE.Ident ('a':i))))
 >             (HSE.List [HSE.Lit (HSE.String vs)
 >                       ,HSE.List es
 >                       ,HSE.List od]) ->
 >         let (d,dir) = read vs
->         in AggregateApp i d (map toSql es)
+>         in AggregateApp (unname i) d (map toSql es)
 >                         $ zip (map toSql od) dir
 >     HSE.App (HSE.Var (HSE.UnQual (HSE.Ident ('w':i))))
 >             (HSE.List [HSE.Lit (HSE.String vs)
@@ -143,15 +146,14 @@ the fixity code.
 >                       ,HSE.List pb
 >                       ,HSE.List od]) ->
 >         let dir = read vs
->         in WindowApp i (map toSql es)
+>         in WindowApp (unname i) (map toSql es) (map toSql pb)
->                        (map toSql pb)
 >                        $ zip (map toSql od) dir
 >     HSE.App (HSE.Var (HSE.UnQual (HSE.Symbol ('p':nm)))) e0 ->
->         PostfixOp nm $ toSql e0
+>         PostfixOp (unname nm) $ toSql e0
 >     HSE.App (HSE.Var (HSE.UnQual (HSE.Symbol nm))) e0 ->
->         PrefixOp nm $ toSql e0
+>         PrefixOp (unname nm) $ toSql e0
 >     HSE.App (HSE.Var (HSE.UnQual (HSE.Ident ('s':nm)))) (HSE.List es) ->
->         SpecialOp nm $ map toSql es
+>         SpecialOp (unname nm) $ map toSql es
 >     HSE.App (HSE.Var (HSE.UnQual (HSE.Ident "$case")))
 >             (HSE.List [v,ts,el]) ->
 >         Case (ltom v) (pairs ts) (ltom el)
@@ -172,3 +174,5 @@ the fixity code.
 >     pairs ex = err ex
 >     err :: Show a => a -> e
 >     err a = error $ "simple-sql-parser: internal fixity error " ++ show a
+>     unname ('"':nm) = QName nm
+>     unname n = Name n

Language/SQL/SimpleSQL/Parser.lhs

@@ -118,15 +118,18 @@ which parses as a typed literal
 Uses the identifierString 'lexer'. See this function for notes on
 identifiers.
 
+> name :: P Name
+> name = choice [QName <$> quotedIdentifier
+>               ,Name <$> identifierString]
+
 > identifier :: P ScalarExpr
-> identifier = Iden <$> identifierString
+> identifier = Iden <$> name
 
 Identifier with one dot in it. This should be extended to any amount
 of dots.
 
 > dottedIden :: P ScalarExpr
-> dottedIden = Iden2 <$> identifierString
+> dottedIden = Iden2 <$> name <*> (symbol "." *> name)
->                    <*> (symbol "." *> identifierString)
 
 == star
 
@@ -135,7 +138,7 @@ places as well.
 
 > star :: P ScalarExpr
 > star = choice [Star <$ symbol "*"
->               ,Star2 <$> (identifierString <* symbol "." <* symbol "*")]
+>               ,Star2 <$> (name <* symbol "." <* symbol "*")]
 
 == function application, aggregates and windows
 
@@ -150,7 +153,7 @@ aggregate([all|distinct] args [order by orderitems])
 > aggOrApp :: P ScalarExpr
 > aggOrApp =
 >     makeApp
->     <$> identifierString
+>     <$> name
 >     <*> parens ((,,) <$> try duplicates
 >                      <*> choice [commaSep scalarExpr']
 >                      <*> try (optionMaybe orderBy))
@@ -221,9 +224,9 @@ extract(id from expr)
 
 > extract :: P ScalarExpr
 > extract = try (keyword_ "extract") >>
->     parens (makeOp <$> identifierString
+>     parens (makeOp <$> name
 >                    <*> (keyword_ "from" *> scalarExpr'))
->   where makeOp n e = SpecialOp "extract" [Iden n, e]
+>   where makeOp n e = SpecialOp (Name "extract") [Iden n, e]
 
 substring(x from expr to expr)
 
@@ -235,7 +238,7 @@ todo: also support substring(x from expr)
 >                    <*> (keyword_ "from" *> scalarExpr')
 >                    <*> (keyword_ "for" *> scalarExpr')
 >                    )
->   where makeOp a b c = SpecialOp "substring" [a,b,c]
+>   where makeOp a b c = SpecialOp (Name "substring") [a,b,c]
 
 in: two variations:
 a in (expr0, expr1, ...)
@@ -267,7 +270,7 @@ and operator. This is the call to scalarExpr'' True.
 
 > betweenSuffix :: ScalarExpr -> P ScalarExpr
 > betweenSuffix e =
->     makeOp <$> opName
+>     makeOp <$> (Name <$> opName)
 >            <*> return e
 >            <*> scalarExpr'' True
 >            <*> (keyword_ "and" *> scalarExpr'' True)
@@ -367,7 +370,7 @@ The parsers:
 
 > prefixUnaryOp :: P ScalarExpr
 > prefixUnaryOp =
->     PrefixOp <$> opSymbol <*> scalarExpr'
+>     PrefixOp <$> (Name <$> opSymbol) <*> scalarExpr'
 >   where
 >     opSymbol = choice (map (try . symbol) prefixUnOpSymbolNames
 >                        ++ map (try . keyword) prefixUnOpKeywordNames)
@@ -381,7 +384,7 @@ both cases
 >     try $ choice $ map makeOp opPairs
 >   where
 >     opPairs = flip map postfixOpKeywords $ \o -> (o, words o)
->     makeOp (o,ws) = try $ PostfixOp o e <$ keywords_ ws
+>     makeOp (o,ws) = try $ PostfixOp (Name o) e <$ keywords_ ws
 >     keywords_ = try . mapM_ keyword_
 
 All the binary operators are parsed as same precedence and left
@@ -389,7 +392,7 @@ associativity. This is fixed with a separate pass over the AST.
 
 > binaryOperatorSuffix :: Bool -> ScalarExpr -> P ScalarExpr
 > binaryOperatorSuffix bExpr e0 =
->     BinOp e0 <$> opSymbol <*> factor
+>     BinOp e0 <$> (Name <$> opSymbol) <*> factor
 >   where
 >     opSymbol = choice
 >         (map (try . symbol) binOpSymbolNames
@@ -487,11 +490,11 @@ expression tree (for efficiency and code clarity).
 
 == select lists
 
-> selectItem :: P (Maybe String, ScalarExpr)
+> selectItem :: P (Maybe Name, ScalarExpr)
 > selectItem = flip (,) <$> scalarExpr <*> optionMaybe (try alias)
->   where alias = optional (try (keyword_ "as")) *> identifierString
+>   where alias = optional (try (keyword_ "as")) *> name
 
-> selectList :: P [(Maybe String,ScalarExpr)]
+> selectList :: P [(Maybe Name,ScalarExpr)]
 > selectList = commaSep1 selectItem
 
 == from
@@ -510,14 +513,14 @@ tref
 >     nonJoinTref = choice [try (TRQueryExpr <$> parens queryExpr)
 >                          ,TRParens <$> parens tref
 >                          ,TRLateral <$> (try (keyword_ "lateral") *> tref)
->                          ,try (TRFunction <$> identifierString
+>                          ,try (TRFunction <$> name
 >                                           <*> parens (commaSep scalarExpr))
->                          ,TRSimple <$> identifierString]
+>                          ,TRSimple <$> name]
 >                   >>= optionSuffix aliasSuffix
 >     aliasSuffix j =
->         let tableAlias = optional (try $ keyword_ "as") *> identifierString
+>         let tableAlias = optional (try $ keyword_ "as") *> name
 >             columnAliases = optionMaybe $ try $ parens
->                             $ commaSep1 identifierString
+>                             $ commaSep1 name
 >         in option j (TRAlias j <$> try tableAlias <*> try columnAliases)
 >     joinTrefSuffix t = (do
 >          nat <- option False $ try (True <$ try (keyword_ "natural"))
@@ -540,7 +543,7 @@ tref
 >                ,try (keyword_ "on") >>
 >                 JoinOn <$> scalarExpr
 >                ,try (keyword_ "using") >>
->                 JoinUsing <$> parens (commaSep1 identifierString)
+>                 JoinUsing <$> parens (commaSep1 name)
 >                ]
 
 == simple other parts
@@ -585,7 +588,7 @@ where, having, limit, offset).
 >     With <$> commaSep1 withQuery <*> queryExpr
 >   where
 >     withQuery =
->         (,) <$> (identifierString <* optional (try $ keyword_ "as"))
+>         (,) <$> (name <* optional (try $ keyword_ "as"))
 >             <*> parens queryExpr
 
 == query expression
@@ -706,6 +709,10 @@ sure what other places strictly need the blacklist, and in theory it
 could be tuned differently for each place the identifierString/
 identifier parsers are used to only blacklist the bare minimum.
 
+> quotedIdentifier :: P String
+> quotedIdentifier = char '"' *> manyTill anyChar (symbol_ "\"")
+
+
 String literals: limited at the moment, no escaping \' or other
 variations.
 

Language/SQL/SimpleSQL/Pretty.lhs

@@ -34,15 +34,15 @@
 >     text "interval" <+> quotes (text v)
 >     <+> text u
 >     <+> maybe empty (parens . text . show ) p
-> scalarExpr (Iden i) = text i
+> scalarExpr (Iden i) = name i
-> scalarExpr (Iden2 q i) = text q <> text "." <> text i
+> scalarExpr (Iden2 q i) = name q <> text "." <> name i
 > scalarExpr Star = text "*"
-> scalarExpr (Star2 q) = text q <> text "." <> text "*"
+> scalarExpr (Star2 q) = name q <> text "." <> text "*"
 
-> scalarExpr (App f es) = text f <> parens (commaSep (map scalarExpr es))
+> scalarExpr (App f es) = name f <> parens (commaSep (map scalarExpr es))
 
 > scalarExpr (AggregateApp f d es od) =
->     text f
+>     name f
 >     <> parens ((case d of
 >                   Just Distinct -> text "distinct"
 >                   Just All -> text "all"
@@ -51,7 +51,7 @@
 >                <+> orderBy od)
 
 > scalarExpr (WindowApp f es pb od) =
->     text f <> parens (commaSep $ map scalarExpr es)
+>     name f <> parens (commaSep $ map scalarExpr es)
 >     <+> text "over"
 >     <+> parens ((case pb of
 >                     [] -> empty
@@ -59,18 +59,19 @@
 >                           <+> nest 13 (commaSep $ map scalarExpr pb))
 >                 <+> orderBy od)
 
-> scalarExpr (SpecialOp nm [a,b,c]) | nm `elem` ["between", "not between"] =
+> scalarExpr (SpecialOp nm [a,b,c]) | nm `elem` [Name "between"
+>                                               ,Name "not between"] =
 >   sep [scalarExpr a
->       ,text nm <+> scalarExpr b
+>       ,name nm <+> scalarExpr b
->       ,nest (length nm + 1)
+>       ,nest (length (unname nm) + 1)
 >        $ text "and" <+> scalarExpr c]
 
-> scalarExpr (SpecialOp "extract" [a,n]) =
+> scalarExpr (SpecialOp (Name "extract") [a,n]) =
 >   text "extract" <> parens (scalarExpr a
 >                             <+> text "from"
 >                             <+> scalarExpr n)
 
-> scalarExpr (SpecialOp "substring" [a,s,e]) =
+> scalarExpr (SpecialOp (Name "substring") [a,s,e]) =
 >   text "substring" <> parens (scalarExpr a
 >                             <+> text "from"
 >                             <+> scalarExpr s
@@ -78,22 +79,22 @@
 >                             <+> scalarExpr e)
 
 > scalarExpr (SpecialOp nm es) =
->   text nm <+> parens (commaSep $ map scalarExpr es)
+>   name nm <+> parens (commaSep $ map scalarExpr es)
 
-> scalarExpr (PrefixOp f e) = text f <+> scalarExpr e
+> scalarExpr (PrefixOp f e) = name f <+> scalarExpr e
-> scalarExpr (PostfixOp f e) = scalarExpr e <+> text f
+> scalarExpr (PostfixOp f e) = scalarExpr e <+> name f
-> scalarExpr e@(BinOp _ op _) | op `elem` ["and", "or"] =
+> scalarExpr e@(BinOp _ op _) | op `elem` [(Name "and"), (Name "or")] =
 >     -- special case for and, or, get all the ands so we can vcat them
 >     -- nicely
 >     case ands e of
 >       (e':es) -> vcat (scalarExpr e'
->                        : map ((text op <+>) . scalarExpr) es)
+>                        : map ((name op <+>) . scalarExpr) es)
 >       [] -> empty -- shouldn't be possible
 >   where
 >     ands (BinOp a op' b) | op == op' = ands a ++ ands b
 >     ands x = [x]
 > scalarExpr (BinOp e0 f e1) =
->     scalarExpr e0 <+> text f <+> scalarExpr e1
+>     scalarExpr e0 <+> name f <+> scalarExpr e1
 
 > scalarExpr (Case t ws els) =
 >     sep $ [text "case" <+> maybe empty scalarExpr t]
@@ -132,6 +133,14 @@
 >                      InList es -> commaSep $ map scalarExpr es
 >                      InQueryExpr qe -> queryExpr qe)
 
+> unname :: Name -> String
+> unname (QName n) = "\"" ++ n ++ "\""
+> unname (Name n) = n
+
+> name :: Name -> Doc
+> name (QName n) = doubleQuotes $ text n
+> name (Name n) = text n
+
 = query expressions
 
 > queryExpr :: QueryExpr -> Doc
@@ -166,14 +175,14 @@
 >   text "with"
 >   <+> vcat [nest 5
 >             (vcat $ punctuate comma $ flip map withs $ \(n,q) ->
->              text n <+> text "as" <+> parens (queryExpr q))
+>              name n <+> text "as" <+> parens (queryExpr q))
 >            ,queryExpr qe]
 
-> selectList :: [(Maybe String, ScalarExpr)] -> Doc
+> selectList :: [(Maybe Name, ScalarExpr)] -> Doc
 > selectList is = commaSep $ map si is
 >   where
 >     si (al,e) = scalarExpr e <+> maybe empty alias al
->     alias al = text "as" <+> text al
+>     alias al = text "as" <+> name al
 
 > from :: [TableRef] -> Doc
 > from [] = empty
@@ -181,14 +190,14 @@
 >     sep [text "from"
 >         ,nest 5 $ vcat $ punctuate comma $ map tr ts]
 >   where
->     tr (TRSimple t) = text t
+>     tr (TRSimple t) = name t
 >     tr (TRLateral t) = text "lateral" <+> tr t
 >     tr (TRFunction f as) =
->         text f <> parens (commaSep $ map scalarExpr as)
+>         name f <> parens (commaSep $ map scalarExpr as)
 >     tr (TRAlias t a cs) =
 >         sep [tr t
->             ,text "as" <+> text a
+>             ,text "as" <+> name a
->              <+> maybe empty (parens . commaSep . map text) cs]
+>              <+> maybe empty (parens . commaSep . map name) cs]
 >     tr (TRParens t) = parens $ tr t
 >     tr (TRQueryExpr q) = parens $ queryExpr q
 >     tr (TRJoin t0 jt t1 jc) =
@@ -208,7 +217,7 @@
 >           ,text "join"]
 >     joinCond (Just (JoinOn e)) = text "on" <+> scalarExpr e
 >     joinCond (Just (JoinUsing es)) =
->         text "using" <+> parens (commaSep $ map text es)
+>         text "using" <+> parens (commaSep $ map name es)
 >     joinCond Nothing = empty
 >     joinCond (Just JoinNatural) = empty
 

Language/SQL/SimpleSQL/Syntax.lhs

@@ -3,6 +3,7 @@
 > module Language.SQL.SimpleSQL.Syntax
 >     (-- * Scalar expressions
 >      ScalarExpr(..)
+>     ,Name(..)
 >     ,TypeName(..)
 >     ,Duplicates(..)
 >     ,Direction(..)
@@ -44,40 +45,40 @@
 >       -- e.g. interval 3 days (3)
 >     | IntervalLit String String (Maybe Int)
 >       -- | identifier without dots
->     | Iden String
+>     | Iden Name
 >       -- | identifier with one dot
->     | Iden2 String String
+>     | Iden2 Name Name
 >       -- | star
 >     | Star
 >       -- | star with qualifier, e.g t.*
->     | Star2 String
+>     | Star2 Name
 >       -- | function application (anything that looks like c style
 >       -- function application syntactically)
->     | App String [ScalarExpr]
+>     | App Name [ScalarExpr]
 >       -- | aggregate application, which adds distinct or all, and
 >       -- order by, to regular function application
->     | AggregateApp String (Maybe Duplicates)
+>     | AggregateApp Name (Maybe Duplicates)
 >                    [ScalarExpr]
 >                    [(ScalarExpr,Direction)]
 >       -- | window application, which adds over (partition by a order
 >       -- by b) to regular function application. Explicit frames are
 >       -- not currently supported
->     | WindowApp String [ScalarExpr] [ScalarExpr] [(ScalarExpr,Direction)]
+>     | WindowApp Name [ScalarExpr] [ScalarExpr] [(ScalarExpr,Direction)]
 >       -- | Infix binary operators. This is used for symbol operators
 >       -- (a + b), keyword operators (a and b) and multiple keyword
 >       -- operators (a is similar to b)
->     | BinOp ScalarExpr String ScalarExpr
+>     | BinOp ScalarExpr Name ScalarExpr
 >       -- | Prefix unary operators. This is used for symbol
 >       -- operators, keyword operators and multiple keyword operators
->     | PrefixOp String ScalarExpr
+>     | PrefixOp Name ScalarExpr
 >       -- | Postfix unary operators. This is used for symbol
 >       -- operators, keyword operators and multiple keyword operators
->     | PostfixOp String ScalarExpr
+>     | PostfixOp Name ScalarExpr
 >       -- | Used for ternary, mixfix and other non orthodox
 >       -- operators, including the function looking calls which use
 >       -- keywords instead of commas to separate the arguments,
 >       -- e.g. substring(t from 1 to 5)
->     | SpecialOp String [ScalarExpr]
+>     | SpecialOp Name [ScalarExpr]
 >       -- | case expression. both flavours supported. Multiple
 >       -- condition when branches not currently supported (case when
 >       -- a=4,b=5 then x end)
@@ -96,6 +97,11 @@
 >     | In Bool ScalarExpr InThing
 >       deriving (Eq,Show,Read)
 
+> -- | Represents an identifier name, which can be quoted or unquoted
+> data Name = Name String
+>           | QName String
+>           deriving (Eq,Show,Read)
+
 > -- | Represents a type name, used in casts.
 > data TypeName = TypeName String deriving (Eq,Show,Read)
 
@@ -135,7 +141,7 @@
 > data QueryExpr
 >     = Select
 >       {qeDuplicates :: Duplicates
->       ,qeSelectList :: [(Maybe String,ScalarExpr)]
+>       ,qeSelectList :: [(Maybe Name,ScalarExpr)]
 >        -- ^ the column aliases and the expressions
 >       ,qeFrom :: [TableRef]
 >       ,qeWhere :: Maybe ScalarExpr
@@ -152,7 +158,7 @@
 >       ,qeCorresponding :: Corresponding
 >       ,qe2 :: QueryExpr
 >       }
->     | With [(String,QueryExpr)] QueryExpr
+>     | With [(Name,QueryExpr)] QueryExpr
 >       deriving (Eq,Show,Read)
 
 TODO: add queryexpr parens to deal with e.g.
@@ -186,17 +192,17 @@ I'm not sure if this is valid syntax or not.
 
 > -- | Represents a entry in the csv of tables in the from clause.
 > data TableRef = -- | from t
->                 TRSimple String
+>                 TRSimple Name
 >                 -- | from a join b
 >               | TRJoin TableRef JoinType TableRef (Maybe JoinCondition)
 >                 -- | from (a)
 >               | TRParens TableRef
 >                 -- | from a as b(c,d)
->               | TRAlias TableRef String (Maybe [String])
+>               | TRAlias TableRef Name (Maybe [Name])
 >                 -- | from (query expr)
 >               | TRQueryExpr QueryExpr
 >                 -- | from function(args)
->               | TRFunction String [ScalarExpr]
+>               | TRFunction Name [ScalarExpr]
 >                 -- | from lateral t
 >               | TRLateral TableRef
 >                 deriving (Eq,Show,Read)
@@ -209,6 +215,6 @@ TODO: add function table ref
 
 > -- | The join condition.
 > data JoinCondition = JoinOn ScalarExpr -- ^ on expr
->                    | JoinUsing [String] -- ^ using (column list)
+>                    | JoinUsing [Name] -- ^ using (column list)
 >                    | JoinNatural -- ^ natural join was used
 >                      deriving (Eq,Show,Read)

simple-sql-parser.cabal

@@ -1,7 +1,7 @@
 name:                simple-sql-parser
-version:             0.1.0.0
+version:             0.2.0.0
 synopsis:            A parser for SQL queries
-description:         A parser for SQL queries
+description:         A parser for SQL queries. Please see the homepage for more information <http://jakewheat.github.io/simple_sql_parser/>.
 
 homepage:            http://jakewheat.github.io/simple_sql_parser/
 license:             BSD3
@@ -63,6 +63,6 @@ Test-Suite Tests
                        Language.SQL.SimpleSQL.Tests,
                        Language.SQL.SimpleSQL.Tpch
 
-  other-extensions:    TupleSections
+  other-extensions:    TupleSections,OverloadedStrings
   default-language:    Haskell2010
   ghc-options:         -Wall

tools/Language/SQL/SimpleSQL/FullQueries.lhs

@@ -1,6 +1,7 @@
 
 Some tests for parsing full queries.
 
+> {-# LANGUAGE OverloadedStrings #-}
 > module Language.SQL.SimpleSQL.FullQueries (fullQueriesTests) where
 
 > import Language.SQL.SimpleSQL.TestTypes

tools/Language/SQL/SimpleSQL/Postgres.lhs

@@ -118,7 +118,7 @@ queries section
 
 >     ,"SELECT a AS value, b + c AS sum FROM t"
 
->     --,"SELECT a \"value\", b + c AS sum FROM t" -- quoted identifier
+>     ,"SELECT a \"value\", b + c AS sum FROM t"
 
 >     ,"SELECT DISTINCT select_list t"
 

tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs

@@ -5,6 +5,7 @@ table refs which are in a separate file.
 
 These are a few misc tests which don't fit anywhere else.
 
+> {-# LANGUAGE OverloadedStrings #-}
 > module Language.SQL.SimpleSQL.QueryExprComponents (queryExprComponentTests) where
 
 > import Language.SQL.SimpleSQL.TestTypes

tools/Language/SQL/SimpleSQL/ScalarExprs.lhs

@@ -1,6 +1,7 @@
 
 Tests for parsing scalar expressions
 
+> {-# LANGUAGE OverloadedStrings #-}
 > module Language.SQL.SimpleSQL.ScalarExprs (scalarExprTests) where
 
 > import Language.SQL.SimpleSQL.TestTypes
@@ -43,6 +44,7 @@ Tests for parsing scalar expressions
 > identifiers = Group "identifiers" $ map (uncurry TestScalarExpr)
 >     [("iden1", Iden "iden1")
 >     ,("t.a", Iden2 "t" "a")
+>     ,("\"quoted identifier\"", Iden $ QName "quoted identifier")
 >     ]
 
 > star :: TestItem

tools/Language/SQL/SimpleSQL/TableRefs.lhs

@@ -2,6 +2,7 @@
 These are the tests for parsing focusing on the from part of query
 expression
 
+> {-# LANGUAGE OverloadedStrings #-}
 > module Language.SQL.SimpleSQL.TableRefs (tableRefTests) where
 
 > import Language.SQL.SimpleSQL.TestTypes

tools/Language/SQL/SimpleSQL/TestTypes.lhs

@@ -6,6 +6,8 @@ Tests.lhs module for the 'interpreter'.
 
 > import Language.SQL.SimpleSQL.Syntax
 
+> import Data.String
+
 > data TestItem = Group String [TestItem]
 >               | TestScalarExpr String ScalarExpr
 >               | TestQueryExpr String QueryExpr
@@ -18,3 +20,7 @@ should all be TODO to convert to a testqueryexpr test.
 >               | ParseQueryExpr String
 >                 deriving (Eq,Show)
 
+hack to make the tests a bit simpler
+
+> instance IsString Name where
+>    fromString = Name

tools/RunTests.lhs

@@ -6,4 +6,3 @@
 
 > main :: IO ()
 > main = defaultMain [tests]
-