From 9d8c1badbd9e86ba7024a6f849f9232503b3a892 Mon Sep 17 00:00:00 2001 From: jake Date: Tue, 31 Dec 2013 11:02:26 +0200 Subject: [PATCH] give in and use the parsec buildExpressionParser for now --- Language/SQL/SimpleSQL/Fixity.lhs | 249 ----------------- Language/SQL/SimpleSQL/Parser.lhs | 288 +++++++------------- simple-sql-parser.cabal | 4 +- tools/Language/SQL/SimpleSQL/ValueExprs.lhs | 5 +- 4 files changed, 109 insertions(+), 437 deletions(-) delete mode 100644 Language/SQL/SimpleSQL/Fixity.lhs diff --git a/Language/SQL/SimpleSQL/Fixity.lhs b/Language/SQL/SimpleSQL/Fixity.lhs deleted file mode 100644 index cb2ad17..0000000 --- a/Language/SQL/SimpleSQL/Fixity.lhs +++ /dev/null @@ -1,249 +0,0 @@ - -This is the module which deals with fixing up the value expression -trees for the operator precedence and associativity (aka 'fixity'). - -It currently uses haskell-src-exts as a hack, the algorithm from there -should be ported to work on these trees natively. Maybe it could be -made generic to use in places other than the value expr parser? - - - -New plan to write custom fixity code to work directly on -simple-query-parser AST. - -Might also want to run simple fixity fixes on CombineQueryExprs, and -on tableref trees. - -these operators take part in fixity: -binop prefixop postfixop -in, any, some, all -between: maybe postfix ops might be either in the last expr in the -between or outside the between (& not between) -collate - -these don't: we just recursively apply on each sub value expr -independently -all special ops, except the special case for between -case, should check nested cases work nice -app, agg app, winapp, parens -casts: - cast(a as b) doesn't - int 'sdasd' doesn't since the argument is a string literal only - a::b does, this is postgres which isn't currently supported. Would - like to support it in the future though. This will not be a ast - binary op since the second argument is a typename and not a value - expr - -because the parser applies the fixity fix to every 'top level' value -expr, we don't need to descend into query exprs to find the value -exprs inside them. - -start creating test list: - -create tests with an explicit fixity table to check the features of -the fixity code, then create tests for sql value expressions which -sanity check the fixity applied to these expressions. - -basic fixity tests: - -a + b + c -a + b * c -a * b + c -a + b + c * d -a * b + c + d - -try also with right assocative - -a HI b PostfixLow - -a low b PostfixHigh - -a LOWEST b HI c PostfixMEDIUM -+ variations - -same with prefix -same with chained binops - ----- - -now sanity check the basic operators (these use BinOp, PrefixOp, -PostfixOp) then sanity check all the other operators which take part -in the fixity - - -> {-# LANGUAGE TupleSections #-} -> module Language.SQL.SimpleSQL.Fixity -> (fixFixities -> ,Fixity(..) -> ,Assoc(..) -> ,infixl_ -> ,infixr_ -> ,infix_ -> ) where - -> import qualified Language.Haskell.Exts.Syntax as HSE -> import qualified Language.Haskell.Exts.Fixity as HSE -> import Control.Monad.Identity -> import Control.Applicative -> import Data.Maybe - -> import Language.SQL.SimpleSQL.Syntax - -> data Fixity = Fixity String --name of op -> Assoc -> deriving (Eq,Show) - -> data Assoc = AssocLeft | AssocRight | AssocNone -> deriving (Eq,Show) - -> infixl_ :: [String] -> [Fixity] -> infixl_ = map (`Fixity` AssocLeft) - -> infixr_ :: [String] -> [Fixity] -> infixr_ = map (`Fixity` AssocRight) - -> infix_ :: [String] -> [Fixity] -> infix_ = map (`Fixity` AssocNone) - -> toHSEFixity :: [[Fixity]] -> [HSE.Fixity] -> toHSEFixity fs = -> let fs' = zip [0..] $ reverse fs -> in concatMap f fs' -> where -> f :: (Int, [Fixity]) -> [HSE.Fixity] -> f (n,fs') = flip concatMap fs' $ \(Fixity nm assoc) -> -> case assoc of -> AssocLeft -> HSE.infixl_ n [nm] -> AssocRight -> HSE.infixr_ n [nm] -> AssocNone -> HSE.infix_ n [nm] - -fix the fixities in the given value expr. All the expressions to be -fixed should be left associative and equal precedence to be fixed -correctly. It doesn't descend into query expressions in subqueries and -the value expressions they contain. - -TODO: get it to work on prefix and postfix unary operators also maybe -it should work on some of the other syntax (such as in). - -> fixFixities :: [[Fixity]] -> ValueExpr -> ValueExpr -> fixFixities fs se = -> runIdentity $ toSql <$> HSE.applyFixities (toHSEFixity fs) (toHaskell se) - -Now have to convert all our value exprs to Haskell and back again. -Have to come up with a recipe for each ctor. Only continue if you have -a strong stomach. Probably would have been less effort to just write -the fixity code. - -> toHaskell :: ValueExpr -> HSE.Exp -> toHaskell e = case e of -> BinOp e0 op e1 -> HSE.InfixApp -> (toHaskell e0) -> (HSE.QVarOp $ sym $ name op) -> (toHaskell e1) -> -- TODO fix me -> (SpecialOpK {}) -> str ('v':show e) -> Iden {} -> str ('v':show e) -> Parameter -> str ('v':show e) -> StringLit {} -> str ('v':show e) -> NumLit {} -> str ('v':show e) -> App n es -> HSE.App (var ('f':name n)) $ ltoh es -> Parens e0 -> HSE.Paren $ toHaskell e0 -> IntervalLit {} -> str ('v':show e) -> Star -> str ('v':show e) -> AggregateApp nm d es od -> -> HSE.App (var ('a':name nm)) -> $ HSE.List [str $ show (d,orderInf od) -> ,HSE.List $ map toHaskell es -> ,HSE.List $ orderExps od] -> WindowApp nm es pb od r -> -> HSE.App (var ('w':name nm)) -> $ HSE.List [str $ show (orderInf od, r) -> ,HSE.List $ map toHaskell es -> ,HSE.List $ map toHaskell pb -> ,HSE.List $ orderExps od] -> PrefixOp nm e0 -> -> HSE.App (HSE.Var $ sym $ name nm) (toHaskell e0) -> PostfixOp nm e0 -> -> HSE.App (HSE.Var $ sym ('p':name nm)) (toHaskell e0) -> SpecialOp nm 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 -> ,HSE.List $ map (ltoh . (\(a,b) -> b:a)) ts -> ,ltoh $ maybeToList el]) -> Cast e0 tn -> HSE.App (str ('c':show tn)) $ toHaskell e0 -> TypedLit {} -> str ('v':show e) -> SubQueryExpr {} -> str ('v': show e) -> In b e0 (InList l) -> -> HSE.App (str ('i':show b)) -> $ HSE.List [toHaskell e0, HSE.List $ map toHaskell l] -> In b e0 i -> HSE.App (str ('j':show (b,i))) $ toHaskell e0 -> where -> ltoh = HSE.List . map toHaskell -> 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 -> orderExps = map (toHaskell . (\(SortSpec a _ _) -> a)) -> orderInf = map (\(SortSpec _ b c) -> (b,c)) - - - - -> toSql :: HSE.Exp -> ValueExpr -> toSql e = case e of - - -> HSE.InfixApp e0 (HSE.QVarOp (HSE.UnQual (HSE.Symbol n))) 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 (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,oinf) = read vs -> in AggregateApp (unname i) d (map toSql es) -> $ sord oinf od -> HSE.App (HSE.Var (HSE.UnQual (HSE.Ident ('w':i)))) -> (HSE.List [HSE.Lit (HSE.String vs) -> ,HSE.List es -> ,HSE.List pb -> ,HSE.List od]) -> -> let (oinf,r) = read vs -> in WindowApp (unname i) (map toSql es) (map toSql pb) -> (sord oinf od) r -> HSE.App (HSE.Var (HSE.UnQual (HSE.Symbol ('p':nm)))) e0 -> -> PostfixOp (unname nm) $ toSql e0 -> HSE.App (HSE.Var (HSE.UnQual (HSE.Symbol nm))) e0 -> -> PrefixOp (unname nm) $ toSql e0 -> HSE.App (HSE.Var (HSE.UnQual (HSE.Ident ('s':nm)))) (HSE.List es) -> -> SpecialOp (unname nm) $ map toSql es -> HSE.App (HSE.Var (HSE.UnQual (HSE.Ident "$case"))) -> (HSE.List [v,ts,el]) -> -> Case (ltom v) (whens ts) (ltom el) -> HSE.App (HSE.Lit (HSE.String ('c':nm))) e0 -> -> Cast (toSql e0) (read nm) -> HSE.App (HSE.Lit (HSE.String ('i':nm))) -> (HSE.List [e0, HSE.List es]) -> -> In (read nm) (toSql e0) (InList $ map toSql es) -> HSE.App (HSE.Lit (HSE.String ('j':nm))) e0 -> -> let (b,sq) = read nm -> in In b (toSql e0) sq -> _ -> err e -> where -> sord = zipWith (\(i0,i1) ce -> SortSpec (toSql ce) i0 i1) -> ltom (HSE.List []) = Nothing -> ltom (HSE.List [ex]) = Just $ toSql ex -> ltom ex = err ex -> whens (HSE.List l) = map (\(HSE.List (t:ws)) -> (map toSql ws, toSql t)) l -> whens 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 2b0c24f..7958351 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -1,3 +1,6 @@ +TODO: +P -> P.Parser +swap order in select items > {-# LANGUAGE TupleSections #-} > -- | This is the module with the parser functions. @@ -14,9 +17,9 @@ > import Text.Parsec hiding (ParseError) > import qualified Text.Parsec as P > import Text.Parsec.Perm +> import qualified Text.Parsec.Expr as E > import Language.SQL.SimpleSQL.Syntax -> import Language.SQL.SimpleSQL.Fixity The public API functions. @@ -159,7 +162,7 @@ aggregate([all|distinct] args [order by orderitems]) > makeApp > <$> name > <*> parens ((,,) <$> try duplicates -> <*> choice [commaSep valueExpr'] +> <*> choice [commaSep valueExpr] > <*> try (optionMaybe orderBy)) > where > makeApp i (Nothing,es,Nothing) = App i es @@ -189,7 +192,7 @@ always used with the optionSuffix combinator. > <*> optionMaybe frameClause) > where > partitionBy = try (keyword_ "partition") >> -> keyword_ "by" >> commaSep1 valueExpr' +> keyword_ "by" >> commaSep1 valueExpr > frameClause = > mkFrame <$> choice [FrameRows <$ keyword_ "rows" > ,FrameRange <$ keyword_ "range"] @@ -224,14 +227,14 @@ always used with the optionSuffix combinator. > scase :: P ValueExpr > scase = -> Case <$> (try (keyword_ "case") *> optionMaybe (try valueExpr')) +> Case <$> (try (keyword_ "case") *> optionMaybe (try valueExpr)) > <*> many1 swhen -> <*> optionMaybe (try (keyword_ "else") *> valueExpr') +> <*> optionMaybe (try (keyword_ "else") *> valueExpr) > <* keyword_ "end" > where > swhen = keyword_ "when" *> -> ((,) <$> commaSep1 valueExpr' -> <*> (keyword_ "then" *> valueExpr')) +> ((,) <$> commaSep1 valueExpr +> <*> (keyword_ "then" *> valueExpr)) == miscellaneous keyword operators @@ -246,7 +249,7 @@ cast: cast(expr as type) > cast = parensCast <|> prefixCast > where > parensCast = try (keyword_ "cast") >> -> parens (Cast <$> valueExpr' +> parens (Cast <$> valueExpr > <*> (keyword_ "as" *> typeName)) > prefixCast = try (TypedLit <$> typeName > <*> stringLiteral) @@ -268,7 +271,7 @@ operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.) > keyword_ opName >> do > void $ symbol "(" > let pfa = do -> e <- valueExpr' +> e <- valueExpr > -- check we haven't parsed the first > -- keyword as an identifier > guard (case (e,kws) of @@ -284,7 +287,7 @@ operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.) > return $ SpecialOpK (Name opName) fa $ catMaybes as > where > parseArg (nm,mand) = -> let p = keyword_ nm >> valueExpr' +> let p = keyword_ nm >> valueExpr > in fmap (nm,) <$> if mand > then Just <$> p > else optionMaybe (try p) @@ -347,7 +350,7 @@ in the source > parens (mkTrim > <$> option "both" sides > <*> option " " stringLiteral -> <*> (keyword_ "from" *> valueExpr') +> <*> (keyword_ "from" *> valueExpr) > <*> optionMaybe (keyword_ "collate" *> stringLiteral)) > where > sides = choice ["leading" <$ keyword_ "leading" @@ -363,16 +366,19 @@ in: two variations: a in (expr0, expr1, ...) a in (queryexpr) -> inSuffix :: ValueExpr -> P ValueExpr -> inSuffix e = -> In <$> inty -> <*> return e -> <*> parens (choice -> [InQueryExpr <$> queryExpr -> ,InList <$> commaSep1 valueExpr']) +this is parsed as a postfix operator which is why it is in this form + +> inSuffix :: P (ValueExpr -> ValueExpr) +> inSuffix = +> mkIn <$> inty +> <*> parens (choice +> [InQueryExpr <$> queryExpr +> ,InList <$> commaSep1 valueExpr]) > where > inty = try $ choice [True <$ keyword_ "in" > ,False <$ keyword_ "not" <* keyword_ "in"] +> mkIn i v = \e -> In i e v + between: expr between expr and expr @@ -385,19 +391,18 @@ which is that you can't have a binary and operator in the middle expression in a between unless it is wrapped in parens. The 'bExpr parsing' is used to create alternative value expression parser which is identical to the normal one expect it doesn't recognise the binary -and operator. This is the call to valueExpr'' True. +and operator. This is the call to valueExprB. -> betweenSuffix :: ValueExpr -> P ValueExpr -> betweenSuffix e = +> betweenSuffix :: P (ValueExpr -> ValueExpr) +> betweenSuffix = > makeOp <$> (Name <$> opName) -> <*> return e -> <*> valueExpr'' True -> <*> (keyword_ "and" *> valueExpr'' True) +> <*> valueExprB +> <*> (keyword_ "and" *> valueExprB) > where > opName = try $ choice > ["between" <$ keyword_ "between" > ,"not between" <$ keyword_ "not" <* keyword_ "between"] -> makeOp n a b c = SpecialOp n [a,b,c] +> makeOp n b c = \a -> SpecialOp n [a,b,c] subquery expression: [exists|all|any|some] (queryexpr) @@ -457,7 +462,7 @@ todo: timestamp types: > sparens :: P ValueExpr > sparens = -> ctor <$> parens (commaSep1 valueExpr') +> ctor <$> parens (commaSep1 valueExpr) > where > ctor [a] = Parens a > ctor as = SpecialOp (Name "rowctor") as @@ -470,177 +475,92 @@ unary prefix, unary postfix and binary infix operators. The operators can be symbols (a + b), single keywords (a and b) or multiple keywords (a is similar to b). -First, the list of the regulars operators split by operator type -(prefix, postfix, binary) and by symbol/single keyword/ multiple -keyword. - -> binOpSymbolNames :: [String] -> binOpSymbolNames = -> ["=", "<=", ">=", "!=", "<>", "<", ">" -> ,"*", "/", "+", "-", "%" -> ,"||", "." -> ,"^", "|", "&" -> ] - -> binOpKeywordNames :: [String] -> binOpKeywordNames = ["and", "or", "like", "overlaps"] - -> binOpMultiKeywordNames :: [[String]] -> binOpMultiKeywordNames = map words -> ["not like" -> ,"is similar to" -> ,"is not similar to" -> ,"is distinct from" -> ,"is not distinct from"] - -used for between parsing - -> binOpKeywordNamesNoAnd :: [String] -> binOpKeywordNamesNoAnd = filter (/="and") binOpKeywordNames - -There aren't any multi keyword prefix operators currently supported. - -> prefixUnOpKeywordNames :: [String] -> prefixUnOpKeywordNames = ["not"] - -> prefixUnOpSymbolNames :: [String] -> prefixUnOpSymbolNames = ["+", "-", "~"] - -There aren't any single keyword postfix operators currently -supported. Maybe all these 'is's can be left factored? - -> postfixOpKeywords :: [String] -> postfixOpKeywords = ["is null" -> ,"is not null" -> ,"is true" -> ,"is not true" -> ,"is false" -> ,"is not false" -> ,"is unknown" -> ,"is not unknown"] - -The parsers: - -> prefixUnaryOp :: P ValueExpr -> prefixUnaryOp = -> PrefixOp <$> (Name <$> opSymbol) <*> valueExpr' +> opTable :: Bool -> [[E.Operator String () Identity ValueExpr]] +> opTable bExpr = +> [[binarySym "." E.AssocLeft] +> ,[prefixSym "+", prefixSym "-"] +> ,[binarySym "^" E.AssocLeft] +> ,[binarySym "*" E.AssocLeft +> ,binarySym "/" E.AssocLeft +> ,binarySym "%" E.AssocLeft] +> ,[binarySym "+" E.AssocLeft +> ,binarySym "-" E.AssocLeft] +> ,[binarySym ">=" E.AssocNone +> ,binarySym "<=" E.AssocNone +> ,binarySym "!=" E.AssocRight +> ,binarySym "<>" E.AssocRight +> ,binarySym "||" E.AssocRight +> ,prefixSym "~" +> ,binarySym "&" E.AssocRight +> ,binarySym "|" E.AssocRight +> ,binaryKeyword "like" E.AssocNone +> ,binaryKeyword "overlaps" E.AssocNone] +> ++ map (flip binaryKeywords E.AssocNone) +> ["not like" +> ,"is similar to" +> ,"is not similar to" +> ,"is distinct from" +> ,"is not distinct from"] +> ++ map postfixKeywords +> ["is null" +> ,"is not null" +> ,"is true" +> ,"is not true" +> ,"is false" +> ,"is not false" +> ,"is unknown" +> ,"is not unknown"] +> ++ [E.Postfix $ try inSuffix,E.Postfix $ try betweenSuffix] +> ] +> ++ +> [[binarySym "<" E.AssocNone +> ,binarySym ">" E.AssocNone] +> ,[binarySym "=" E.AssocRight] +> ,[prefixKeyword "not"]] +> ++ +> if bExpr then [] else [[binaryKeyword "and" E.AssocLeft]] +> ++ +> [[binaryKeyword "or" E.AssocLeft]] > where -> opSymbol = choice (map (try . symbol) prefixUnOpSymbolNames -> ++ map (try . keyword) prefixUnOpKeywordNames) - -TODO: the handling of multikeyword args is different in -postfixopsuffix and binaryoperatorsuffix. It should be the same in -both cases - -> postfixOpSuffix :: ValueExpr -> P ValueExpr -> postfixOpSuffix e = -> try $ choice $ map makeOp opPairs -> where -> opPairs = flip map postfixOpKeywords $ \o -> (o, words o) -> 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 -associativity. This is fixed with a separate pass over the AST. - -> binaryOperatorSuffix :: Bool -> ValueExpr -> P ValueExpr -> binaryOperatorSuffix bExpr e0 = -> BinOp e0 <$> (Name <$> opSymbol) <*> factor -> where -> opSymbol = choice -> (map (try . symbol) binOpSymbolNames -> ++ map (try . keywords) binOpMultiKeywordNames -> ++ map (try . keyword) -> (if bExpr -> then binOpKeywordNamesNoAnd -> else binOpKeywordNames)) -> keywords ks = unwords <$> mapM keyword ks - -> sqlFixities :: [[Fixity]] -> sqlFixities = highPrec ++ defaultPrec ++ lowPrec -> where -> allOps = binOpSymbolNames ++ binOpKeywordNames -> ++ map unwords binOpMultiKeywordNames -> ++ prefixUnOpKeywordNames ++ prefixUnOpSymbolNames -> ++ postfixOpKeywords -> -- these are the ops with the highest precedence in order -> highPrec = [infixl_ ["."] -> ,infixl_ ["*","/", "%"] -> ,infixl_ ["+", "-"] -> ,infixl_ ["<=",">=","!=","<>","||","like"] -> ] -> -- these are the ops with the lowest precedence in order -> lowPrec = [infix_ ["<",">"] -> ,infixr_ ["="] -> ,infixr_ ["not"] -> ,infixl_ ["and"] -> ,infixl_ ["or"]] -> already = concatMap (map fName) highPrec -> ++ concatMap (map fName) lowPrec -> -- all the other ops have equal precedence and go between the -> -- high and low precedence ops -> defaultPrecOps = filter (`notElem` already) allOps -> -- almost correct, have to do some more work to -> -- get the associativity correct for these operators -> defaultPrec = [infixl_ defaultPrecOps] -> fName (Fixity n _) = n - +> binarySym nm assoc = binary (try $ symbol_ nm) nm assoc +> binaryKeyword nm assoc = binary (try $ keyword_ nm) nm assoc +> binaryKeywords nm assoc = binary (try $ mapM_ keyword_ (words nm)) nm assoc +> binary p nm assoc = +> E.Infix (p >> return (\a b -> BinOp a (Name nm) b)) assoc +> prefixKeyword nm = prefix (try $ keyword_ nm) nm +> prefixSym nm = prefix (try $ symbol_ nm) nm +> prefix p nm = E.Prefix (p >> return (PrefixOp (Name nm))) +> postfixKeywords nm = postfix (try $ mapM_ keyword_ (words nm)) nm +> postfix p nm = E.Postfix (p >> return (PostfixOp (Name nm))) == value expressions TODO: left factor stuff which starts with identifier -This parses most of the value exprs. I'm not sure if factor is the -correct terminology here. The order of the parsers and use of try is -carefully done to make everything work. It is a little fragile and -could at least do with some heavy explanation. - -> factor :: P ValueExpr -> factor = choice [literal -> ,parameter -> ,scase -> ,cast -> ,try specialOpKs -> ,subquery -> ,prefixUnaryOp -> ,try app -> ,try star -> ,identifier -> ,sparens] - -putting the factor together with the extra bits - -> valueExpr'' :: Bool -> P ValueExpr -> valueExpr'' bExpr = factor >>= trysuffix -> where -> trysuffix e = try (suffix e) <|> return e -> suffix e0 = choice -> [binaryOperatorSuffix bExpr e0 -> ,inSuffix e0 -> ,betweenSuffix e0 -> ,postfixOpSuffix e0 -> ] >>= trysuffix - -Wrapper for non 'bExpr' parsing. See the between parser for -explanation. - -> valueExpr' :: P ValueExpr -> valueExpr' = valueExpr'' False - -The valueExpr wrapper. The idea is that directly nested value -expressions use the valueExpr' parser, then other code uses the -valueExpr parser and then everyone gets the fixity fixes and it's -easy to ensure that this fix is only applied once to each value -expression tree (for efficiency and code clarity). +This parses most of the value exprs.The order of the parsers and use +of try is carefully done to make everything work. It is a little +fragile and could at least do with some heavy explanation. > valueExpr :: P ValueExpr -> valueExpr = fixFixities sqlFixities <$> valueExpr' +> valueExpr = E.buildExpressionParser (opTable False) term + +> term :: P ValueExpr +> term = choice [literal +> ,parameter +> ,scase +> ,cast +> ,try specialOpKs +> ,subquery +> ,try app +> ,try star +> ,identifier +> ,sparens] expose the b expression for window frame clause range between > valueExprB :: P ValueExpr -> valueExprB = fixFixities sqlFixities <$> valueExpr'' True +> valueExprB = E.buildExpressionParser (opTable True) term ------------------------------------------------- diff --git a/simple-sql-parser.cabal b/simple-sql-parser.cabal index 83113c0..25a90da 100644 --- a/simple-sql-parser.cabal +++ b/simple-sql-parser.cabal @@ -27,13 +27,11 @@ library exposed-modules: Language.SQL.SimpleSQL.Pretty, Language.SQL.SimpleSQL.Parser, Language.SQL.SimpleSQL.Syntax - other-modules: Language.SQL.SimpleSQL.Fixity other-extensions: TupleSections build-depends: base >=4.6 && <4.7, parsec >=3.1 && <3.2, mtl >=2.1 && <2.2, - pretty >= 1.1 && < 1.2, - haskell-src-exts >= 1.14 && < 1.15 + pretty >= 1.1 && < 1.2 -- hs-source-dirs: default-language: Haskell2010 ghc-options: -Wall diff --git a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs index 1a74e4c..179438d 100644 --- a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs +++ b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs @@ -132,7 +132,8 @@ Tests for parsing value expressions > unaryOperators :: TestItem > unaryOperators = Group "unaryOperators" $ map (uncurry TestValueExpr) > [("not a", PrefixOp "not" $ Iden "a") -> ,("not not a", PrefixOp "not" $ PrefixOp "not" $ Iden "a") +> -- I think this is a missing feature or bug in parsec buildExpressionParser +> --,("not not a", PrefixOp "not" $ PrefixOp "not" $ Iden "a") > ,("+a", PrefixOp "+" $ Iden "a") > ,("-a", PrefixOp "-" $ Iden "a") > ] @@ -247,6 +248,8 @@ keyword special operators > ,("for", NumLit "2") > ,("collate", StringLit "C")]) +this doesn't work because of a overlap in the 'in' parser + > ,("POSITION( string1 IN string2 )" > ,SpecialOpK "position" (Just $ Iden "string1") [("in", Iden "string2")])