diff --git a/Language/SQL/SimpleSQL/Parse.hs b/Language/SQL/SimpleSQL/Parse.hs index 6b23972..6776889 100644 --- a/Language/SQL/SimpleSQL/Parse.hs +++ b/Language/SQL/SimpleSQL/Parse.hs @@ -651,7 +651,11 @@ scalar expression parens, row ctor and scalar subquery parensExpr :: Parser ScalarExpr parensExpr = parens $ choice - [SubQueryExpr SqSq <$> queryExpr + -- no parens here used for nested parens expressions + -- this could be fixed to be general with some refactoring, but at + -- the moment, you can't use additional redundant parens in a + -- subqueryexpr + [SubQueryExpr SqSq <$> queryExprNoParens ,ctor <$> commaSep1 scalarExpr] where ctor [a] = Parens a @@ -1443,7 +1447,9 @@ from = label "from" (keyword_ "from" *> commaSep1 tref) nonJoinTref = label "table ref" $ choice [hidden $ parens $ choice - [TRQueryExpr <$> queryExpr + -- will be tricky to figure out how to support mixes of nested + -- query expr parens and table ref parens + [TRQueryExpr <$> queryExprNoParens ,TRParens <$> tref] ,TRLateral <$> (hidden (keyword_ "lateral") *> nonJoinTref) ,do @@ -1586,9 +1592,18 @@ and union, etc.. -} queryExpr :: Parser QueryExpr -queryExpr = label "query expr" $ E.makeExprParser qeterm qeOpTable +queryExpr = queryExpr' True +queryExprNoParens :: Parser QueryExpr +queryExprNoParens = queryExpr' False + +queryExpr' :: Bool -> Parser QueryExpr +queryExpr' allowParens = label "query expr" $ E.makeExprParser qeterm qeOpTable where - qeterm = label "query expr" (with <|> select <|> table <|> values) + qeterm + | allowParens = + label "query expr" (with <|> select <|> table <|> values <|> qeParens) + | otherwise = + label "query expr" (with <|> select <|> table <|> values) select = keyword_ "select" >> mkSelect @@ -1602,6 +1617,7 @@ queryExpr = label "query expr" $ E.makeExprParser qeterm qeOpTable values = keyword_ "values" >> Values <$> commaSep (parens (commaSep scalarExpr)) table = keyword_ "table" >> Table <$> names "table name" + qeParens = QueryExprParens <$> parens queryExpr qeOpTable = [[E.InfixL $ setOp Intersect "intersect"] diff --git a/simple-sql-parser.cabal b/simple-sql-parser.cabal index e795ee8..7f83645 100644 --- a/simple-sql-parser.cabal +++ b/simple-sql-parser.cabal @@ -75,6 +75,7 @@ Test-Suite Tests Language.SQL.SimpleSQL.Oracle, Language.SQL.SimpleSQL.QueryExprComponents, Language.SQL.SimpleSQL.QueryExprs, + Language.SQL.SimpleSQL.QueryExprParens, Language.SQL.SimpleSQL.SQL2011Queries, Language.SQL.SimpleSQL.SQL2011AccessControl, Language.SQL.SimpleSQL.SQL2011Bits, diff --git a/tests/Language/SQL/SimpleSQL/QueryExprParens.hs b/tests/Language/SQL/SimpleSQL/QueryExprParens.hs new file mode 100644 index 0000000..211fde3 --- /dev/null +++ b/tests/Language/SQL/SimpleSQL/QueryExprParens.hs @@ -0,0 +1,47 @@ + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module Language.SQL.SimpleSQL.QueryExprParens (queryExprParensTests) where + +import Language.SQL.SimpleSQL.TestTypes +import Language.SQL.SimpleSQL.Syntax +import Language.SQL.SimpleSQL.TestRunners +import Data.Text (Text) +import qualified Text.RawString.QQ as R + +queryExprParensTests :: TestItem +queryExprParensTests = Group "query expr parens" + [q "(select * from t)" $ QueryExprParens $ ms "t" + ,q "select * from t except (select * from u except select * from v)" + $ (ms "t") `sexcept` QueryExprParens (ms "u" `sexcept` ms "v") + + ,q "(select * from t except select * from u) except select * from v" + $ QueryExprParens (ms "t" `sexcept` ms "u") `sexcept` ms "v" + + ,q [R.r| +select * from t +union +with a as (select * from u) +select * from a +|] + $ ms "t" `sunion` with [("a", ms "u")] (ms "a") + + ,q [R.r| +select * from t +union +(with a as (select * from u) + select * from a) +|] + $ ms "t" `sunion` QueryExprParens (with [("a", ms "u")] (ms "a")) + ] + where + q :: HasCallStack => Text -> QueryExpr -> TestItem + q src ast = testQueryExpr ansi2011 src ast + ms t = toQueryExpr $ makeSelect + {msSelectList = [(Star,Nothing)] + ,msFrom = [TRSimple [Name Nothing t]]} + sexcept = so Except + sunion = so Union + so op a b = QueryExprSetOp a op SQDefault Respectively b + with es s = + With False (flip map es $ \(n,sn) -> (Alias (Name Nothing n) Nothing ,sn)) s \ No newline at end of file diff --git a/tests/Language/SQL/SimpleSQL/Tests.hs b/tests/Language/SQL/SimpleSQL/Tests.hs index 17a01a8..b9e5198 100644 --- a/tests/Language/SQL/SimpleSQL/Tests.hs +++ b/tests/Language/SQL/SimpleSQL/Tests.hs @@ -25,6 +25,7 @@ import Language.SQL.SimpleSQL.GroupBy import Language.SQL.SimpleSQL.Postgres import Language.SQL.SimpleSQL.QueryExprComponents import Language.SQL.SimpleSQL.QueryExprs +import Language.SQL.SimpleSQL.QueryExprParens import Language.SQL.SimpleSQL.TableRefs import Language.SQL.SimpleSQL.ScalarExprs import Language.SQL.SimpleSQL.Odbc @@ -59,6 +60,7 @@ testData = ,odbcTests ,queryExprComponentTests ,queryExprsTests + ,queryExprParensTests ,tableRefTests ,groupByTests ,fullQueriesTests