add support for quoted identifiers
This commit is contained in:
Jake Wheat
parent
045f2be825
commit
4330b3d7e0
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
|
||||
Some tests for parsing full queries.
|
||||
|
||||
> {-# LANGUAGE OverloadedStrings #-}
|
||||
> module Language.SQL.SimpleSQL.FullQueries (fullQueriesTests) where
|
||||
|
||||
> import Language.SQL.SimpleSQL.TestTypes
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -6,4 +6,3 @@
|
|||
|
||||
> main :: IO ()
|
||||
> main = defaultMain [tests]
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue