diff --git a/Language/SQL/SimpleSQL/Fixity.lhs b/Language/SQL/SimpleSQL/Fixity.lhs index eb214e6..8101d1f 100644 --- a/Language/SQL/SimpleSQL/Fixity.lhs +++ b/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) -> (map toSql pb) +> in WindowApp (unname i) (map toSql es) (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 diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index e6f0b77..f9373c9 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/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 -> <*> (symbol "." *> identifierString) +> dottedIden = Iden2 <$> name <*> (symbol "." *> name) == 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. diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 12791cb..8c2e656 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/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 (Iden2 q i) = text q <> text "." <> text i +> scalarExpr (Iden i) = name 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 -> ,nest (length nm + 1) +> ,name nm <+> scalarExpr b +> ,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 (PostfixOp f e) = scalarExpr e <+> text f -> scalarExpr e@(BinOp _ op _) | op `elem` ["and", "or"] = +> scalarExpr (PrefixOp f e) = name f <+> scalarExpr e +> scalarExpr (PostfixOp f e) = scalarExpr e <+> name f +> 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 -> <+> maybe empty (parens . commaSep . map text) cs] +> ,text "as" <+> name a +> <+> 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 diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index bb55330..a47cd27 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/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) diff --git a/simple-sql-parser.cabal b/simple-sql-parser.cabal index cbec849..a6fd138 100644 --- a/simple-sql-parser.cabal +++ b/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 . 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 diff --git a/tools/Language/SQL/SimpleSQL/FullQueries.lhs b/tools/Language/SQL/SimpleSQL/FullQueries.lhs index 9f29769..2aaf4e7 100644 --- a/tools/Language/SQL/SimpleSQL/FullQueries.lhs +++ b/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 diff --git a/tools/Language/SQL/SimpleSQL/Postgres.lhs b/tools/Language/SQL/SimpleSQL/Postgres.lhs index 198630e..8610bb9 100644 --- a/tools/Language/SQL/SimpleSQL/Postgres.lhs +++ b/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" diff --git a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs index c4107ff..7a061b0 100644 --- a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs +++ b/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 diff --git a/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs b/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs index 7a2a114..d5bf901 100644 --- a/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs +++ b/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 diff --git a/tools/Language/SQL/SimpleSQL/TableRefs.lhs b/tools/Language/SQL/SimpleSQL/TableRefs.lhs index 17884c0..6aa2968 100644 --- a/tools/Language/SQL/SimpleSQL/TableRefs.lhs +++ b/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 diff --git a/tools/Language/SQL/SimpleSQL/TestTypes.lhs b/tools/Language/SQL/SimpleSQL/TestTypes.lhs index f8711dc..5e7fa47 100644 --- a/tools/Language/SQL/SimpleSQL/TestTypes.lhs +++ b/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 diff --git a/tools/RunTests.lhs b/tools/RunTests.lhs index f8f916f..560079a 100644 --- a/tools/RunTests.lhs +++ b/tools/RunTests.lhs @@ -6,4 +6,3 @@ > main :: IO () > main = defaultMain [tests] -