starlitcanopy/simple-sql-parser
1
Fork 0
Code Activity

fix the scalar expression operator parsing, use expression operator parsing for set operations too

Browse source
This commit is contained in:
Jake Wheat 2024-01-10 09:18:07 +00:00
parent 7a5ad6c206
commit 8cc475240b
1 changed files with 63 additions and 63 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

124
Language/SQL/SimpleSQL/Parse.hs
View file

@ -1165,38 +1165,37 @@ messages, but both of these are too important.
-} -}
opTable :: Bool -> [[E.Operator Parser ScalarExpr]] opTable :: Bool -> [[E.Operator Parser ScalarExpr]]
opTable bExpr = [] {- opTable bExpr =
[-- parse match and quantified comparisons as postfix ops [-- parse match and quantified comparisons as postfix ops
-- todo: left factor the quantified comparison with regular -- todo: left factor the quantified comparison with regular
-- binary comparison, somehow -- binary comparison, somehow
[E.Postfix $ try quantifiedComparisonSuffix [E.Postfix $ try quantifiedComparisonSuffix
,E.Postfix matchPredicateSuffix ,E.Postfix matchPredicateSuffix]
]
,[binarySym "." E.AssocLeft] ,[binarySymL "."]
,[postfix' arraySuffix ,[E.Postfix arraySuffix
,postfix' collateSuffix] ,E.Postfix collateSuffix]
,[prefixSym "+", prefixSym "-"] ,[prefixSym "+", prefixSym "-"]
,[binarySym "^" E.AssocLeft] ,[binarySymL "^"]
,[binarySym "*" E.AssocLeft ,[binarySymL "*"
,binarySym "/" E.AssocLeft ,binarySymL "/"
,binarySym "%" E.AssocLeft] ,binarySymL "%"]
,[binarySym "+" E.AssocLeft ,[binarySymL "+"
,binarySym "-" E.AssocLeft] ,binarySymL "-"]
,[binarySym "||" E.AssocRight ,[binarySymR "||"
,prefixSym "~" ,prefixSym "~"
,binarySym "&" E.AssocRight ,binarySymR "&"
,binarySym "|" E.AssocRight] ,binarySymR "|"]
,[binaryKeyword "overlaps" E.AssocNone] ,[binaryKeywordN "overlaps"]
,[binaryKeyword "like" E.AssocNone ,[binaryKeywordN "like"
-- have to use try with inSuffix because of a conflict -- have to use try with inSuffix because of a conflict
-- with 'in' in position function, and not between -- with 'in' in position function, and not between
-- between also has a try in it to deal with 'not' -- between also has a try in it to deal with 'not'
@ -1204,19 +1203,19 @@ opTable bExpr = [] {-
,E.Postfix $ try inSuffix ,E.Postfix $ try inSuffix
,E.Postfix betweenSuffix] ,E.Postfix betweenSuffix]
-- todo: figure out where to put the try? -- todo: figure out where to put the try?
++ [binaryKeywords $ makeKeywordTree ++ [binaryKeywordsN $ makeKeywordTree
["not like" ["not like"
,"is similar to" ,"is similar to"
,"is not similar to"]] ,"is not similar to"]]
++ [multisetBinOp] ++ [multisetBinOp]
,[binarySym "<" E.AssocNone ,[binarySymN "<"
,binarySym ">" E.AssocNone ,binarySymN ">"
,binarySym ">=" E.AssocNone ,binarySymN ">="
,binarySym "<=" E.AssocNone ,binarySymN "<="
,binarySym "!=" E.AssocRight ,binarySymR "!="
,binarySym "<>" E.AssocRight ,binarySymR "<>"
,binarySym "=" E.AssocRight] ,binarySymR "="]
,[postfixKeywords $ makeKeywordTree ,[postfixKeywords $ makeKeywordTree
["is null" ["is null"
@ -1227,42 +1226,44 @@ opTable bExpr = [] {-
,"is not false" ,"is not false"
,"is unknown" ,"is unknown"
,"is not unknown"]] ,"is not unknown"]]
++ [binaryKeywords $ makeKeywordTree ++ [binaryKeywordsN $ makeKeywordTree
["is distinct from" ["is distinct from"
,"is not distinct from"]] ,"is not distinct from"]]
,[prefixKeyword "not"] ,[prefixKeyword "not"]
,if bExpr then [] else [binaryKeyword "and" E.AssocLeft] ,if bExpr then [] else [binaryKeywordL "and"]
,[binaryKeyword "or" E.AssocLeft] ,[binaryKeywordL "or"]
] ]
where where
binarySym nm assoc = binary (symbol_ nm) nm assoc binarySymL name = E.InfixL (mkBinOp name <$ symbol_ name)
binaryKeyword nm assoc = binary (keyword_ nm) nm assoc binarySymR name = E.InfixR (mkBinOp name <$ symbol_ name)
binaryKeywords p = binarySymN name = E.InfixN (mkBinOp name <$ symbol_ name)
E.Infix (do binaryKeywordN name = E.InfixN (mkBinOp name <$ keyword_ name)
binaryKeywordL name = E.InfixL (mkBinOp name <$ keyword_ name)
mkBinOp nm a b = BinOp a (mkName nm) b
prefixSym name = E.Prefix (PrefixOp (mkName name) <$ symbol_ name)
prefixKeyword name = E.Prefix (PrefixOp (mkName name) <$ keyword_ name)
mkName nm = [Name Nothing nm]
binaryKeywordsN p =
E.InfixN (do
o <- try p o <- try p
pure (\a b -> BinOp a [Name Nothing $ unwords o] b)) pure (\a b -> BinOp a [Name Nothing $ T.unwords o] b))
E.AssocNone multisetBinOp = E.InfixL (do
postfixKeywords p =
postfix' $ do
o <- try p
pure $ PostfixOp [Name Nothing $ unwords o]
binary p nm assoc =
E.Infix (p >> pure (\a b -> BinOp a [Name Nothing nm] b)) assoc
multisetBinOp = E.Infix (do
keyword_ "multiset" keyword_ "multiset"
o <- choice [Union <$ keyword_ "union" o <- choice [Union <$ keyword_ "union"
,Intersect <$ keyword_ "intersect" ,Intersect <$ keyword_ "intersect"
,Except <$ keyword_ "except"] ,Except <$ keyword_ "except"]
d <- option SQDefault duplicates d <- option SQDefault duplicates
pure (\a b -> MultisetBinOp a o d b)) pure (\a b -> MultisetBinOp a o d b))
E.AssocLeft postfixKeywords p =
prefixKeyword nm = prefix (keyword_ nm) nm E.Postfix $ do
prefixSym nm = prefix (symbol_ nm) nm o <- try p
prefix p nm = prefix' (p >> pure (PrefixOp [Name Nothing nm])) pure $ PostfixOp [Name Nothing $ T.unwords o]
{-
-- hack from here -- hack from here
-- http://stackoverflow.com/questions/10475337/parsec-expr-repeated-prefix-postfix-operator-not-supported -- http://stackoverflow.com/questions/10475337/parsec-expr-repeated-prefix-postfix-operator-not-supported
-- not implemented properly yet -- not implemented properly yet
@ -1524,10 +1525,10 @@ and union, etc..
-} -}
queryExpr :: Parser QueryExpr queryExpr :: Parser QueryExpr
queryExpr = select {-choice queryExpr = E.makeExprParser qeterm qeOpTable
[with
,undefined {-chainr1-} (choice [values,table, select]) setOp]-}
where where
qeterm = with <|> select <|> table <|> values
select = keyword_ "select" >> select = keyword_ "select" >>
mkSelect mkSelect
<$> option SQDefault duplicates <$> option SQDefault duplicates
@ -1541,6 +1542,19 @@ queryExpr = select {-choice
>> Values <$> commaSep (parens (commaSep scalarExpr)) >> Values <$> commaSep (parens (commaSep scalarExpr))
table = keyword_ "table" >> Table <$> names table = keyword_ "table" >> Table <$> names
qeOpTable =
[[E.InfixL $ setOp Intersect "intersect"]
,[E.InfixL $ setOp Except "except"
,E.InfixL $ setOp Union "union"]]
setOp :: SetOperatorName -> Text -> Parser (QueryExpr -> QueryExpr -> QueryExpr)
setOp ctor opName = cq
<$> (ctor <$ keyword_ opName)
<*> option SQDefault duplicates
<*> corr
cq o d c q0 q1 = QueryExprSetOp q0 o d c q1
corr = option Respectively (Corresponding <$ keyword_ "corresponding")
{- {-
local data type to help with parsing the bit after the select list, local data type to help with parsing the bit after the select list,
called 'table expression' in the ansi sql grammar. Maybe this should called 'table expression' in the ansi sql grammar. Maybe this should
@ -1568,20 +1582,6 @@ tableExpression = mkTe <$> from
mkTe f w g h od (ofs,fe) = mkTe f w g h od (ofs,fe) =
TableExpression f w g h od ofs fe TableExpression f w g h od ofs fe
setOp :: Parser (QueryExpr -> QueryExpr -> QueryExpr)
setOp = cq
<$> setOpK
<*> option SQDefault duplicates
<*> corr
where
cq o d c q0 q1 = QueryExprSetOp q0 o d c q1
setOpK = choice [Union <$ keyword_ "union"
,Intersect <$ keyword_ "intersect"
,Except <$ keyword_ "except"]
<?> "set operator"
corr = option Respectively (Corresponding <$ keyword_ "corresponding")
{- {-
wrapper for query expr which ignores optional trailing semicolon. wrapper for query expr which ignores optional trailing semicolon.