From 6cb842fba0376bf984fa227e1e7ce32ecb306fc1 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <ls-contractor@proda.ai>
Date: Wed, 17 Mar 2021 20:18:52 +0000
Subject: [PATCH 1/8] Make `keyword` more efficient by first-char early-abort

---
 library/PostgresqlSyntax/Parsing.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/library/PostgresqlSyntax/Parsing.hs b/library/PostgresqlSyntax/Parsing.hs
index 94b5d03..9f4dff4 100644
--- a/library/PostgresqlSyntax/Parsing.hs
+++ b/library/PostgresqlSyntax/Parsing.hs
@@ -60,6 +60,7 @@ import qualified Text.Megaparsec.Char.Lexer    as MegaparsecLexer
 import qualified PostgresqlSyntax.KeywordSet   as KeywordSet
 import qualified PostgresqlSyntax.Predicate    as Predicate
 import qualified PostgresqlSyntax.Validation   as Validation
+import qualified Data.Char                     as Char
 import qualified Data.Text                     as Text
 import qualified Data.List.NonEmpty            as NonEmpty
 import qualified Text.Builder                  as TextBuilder
@@ -2122,7 +2123,14 @@ anyKeyword = parse $ Megaparsec.label "keyword" $ do
   return (Text.toLower (Text.cons _firstChar _remainder))
 
 {-| Expected keyword -}
-keyword a = mfilter (a ==) anyKeyword
+-- keyword a = mfilter (a ==) anyKeyword
+keyword a = parse $ Megaparsec.label "keyword" $ do
+  _firstChar <- Megaparsec.satisfy Predicate.firstIdentifierChar
+  guard (Char.toLower _firstChar == Text.head a)
+  _remainder <- Megaparsec.takeWhileP Nothing Predicate.notFirstIdentifierChar
+  let r = Text.toLower (Text.cons _firstChar _remainder)
+  guard (r == a)
+  return r
 
 {-|
 Consume a keyphrase, ignoring case and types of spaces between words.

From 29a552f8ca0e1ff641da381b66de290287d3b6f9 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <ls-contractor@proda.ai>
Date: Thu, 18 Mar 2021 18:07:16 +0000
Subject: [PATCH 2/8] Add indentation to prepare next refactoring

hopefully makes the history easier to consume
---
 library/PostgresqlSyntax/Parsing.hs | 162 ++++++++++++++--------------
 1 file changed, 82 insertions(+), 80 deletions(-)

diff --git a/library/PostgresqlSyntax/Parsing.hs b/library/PostgresqlSyntax/Parsing.hs
index 9f4dff4..ec24bc6 100644
--- a/library/PostgresqlSyntax/Parsing.hs
+++ b/library/PostgresqlSyntax/Parsing.hs
@@ -1073,86 +1073,88 @@ customizedAExpr cExpr = suffixRec base suffix where
     , CExprAExpr <$> cExpr
     ]
   suffix a = asum
-    [ do
-      space1
-      b <- wrapToHead subqueryOp
-      space1
-      c <- wrapToHead subType
-      space
-      d <- Left <$> wrapToHead selectWithParens <|> Right <$> inParens aExpr
-      return (SubqueryAExpr a b c d)
-    , typecastExpr a TypecastAExpr
-    , CollateAExpr a
-      <$> (space1 *> keyword "collate" *> space1 *> endHead *> anyName)
-    , AtTimeZoneAExpr a
-      <$> (space1 *> keyphrase "at time zone" *> space1 *> endHead *> aExpr)
-    , symbolicBinOpExpr a aExpr SymbolicBinOpAExpr
-    , SuffixQualOpAExpr a <$> (space *> qualOp)
-    , AndAExpr a <$> (space1 *> keyword "and" *> space1 *> endHead *> aExpr)
-    , OrAExpr a <$> (space1 *> keyword "or" *> space1 *> endHead *> aExpr)
-    , do
-      space1
-      b <- trueIfPresent (keyword "not" *> space1)
-      c <- asum
-        [ LikeVerbalExprBinOp <$ keyword "like"
-        , IlikeVerbalExprBinOp <$ keyword "ilike"
-        , SimilarToVerbalExprBinOp <$ keyphrase "similar to"
-        ]
-      space1
-      endHead
-      d <- aExpr
-      e <- optional (space1 *> keyword "escape" *> space1 *> endHead *> aExpr)
-      return (VerbalExprBinOpAExpr a b c d e)
-    , do
-      space1
-      keyword "is"
-      space1
-      endHead
-      b <- trueIfPresent (keyword "not" *> space1)
-      c <- asum
-        [ NullAExprReversableOp <$ keyword "null"
-        , TrueAExprReversableOp <$ keyword "true"
-        , FalseAExprReversableOp <$ keyword "false"
-        , UnknownAExprReversableOp <$ keyword "unknown"
-        , DistinctFromAExprReversableOp
-          <$> (  keyword "distinct"
-              *> space1
-              *> keyword "from"
-              *> space1
-              *> endHead
-              *> aExpr
-              )
-        , OfAExprReversableOp
-          <$> (keyword "of" *> space1 *> endHead *> inParens typeList)
-        , DocumentAExprReversableOp <$ keyword "document"
-        ]
-      return (ReversableOpAExpr a b c)
-    , do
-      space1
-      b <- trueIfPresent (keyword "not" *> space1)
-      keyword "between"
-      space1
-      endHead
-      c <- asum
-        [ BetweenSymmetricAExprReversableOp <$ (keyword "symmetric" *> space1)
-        , BetweenAExprReversableOp True <$ (keyword "asymmetric" *> space1)
-        , pure (BetweenAExprReversableOp False)
-        ]
-      d <- bExpr
-      space1
-      keyword "and"
-      space1
-      e <- aExpr
-      return (ReversableOpAExpr a b (c d e))
-    , do
-      space1
-      b <- trueIfPresent (keyword "not" *> space1)
-      keyword "in"
-      space
-      c <- InAExprReversableOp <$> inExpr
-      return (ReversableOpAExpr a b c)
-    , IsnullAExpr a <$ (space1 *> keyword "isnull")
-    , NotnullAExpr a <$ (space1 *> keyword "notnull")
+    [ asum
+      [ do
+        space1
+        b <- wrapToHead subqueryOp
+        space1
+        c <- wrapToHead subType
+        space
+        d <- Left <$> wrapToHead selectWithParens <|> Right <$> inParens aExpr
+        return (SubqueryAExpr a b c d)
+      , typecastExpr a TypecastAExpr
+      , CollateAExpr a
+        <$> (space1 *> keyword "collate" *> space1 *> endHead *> anyName)
+      , AtTimeZoneAExpr a
+        <$> (space1 *> keyphrase "at time zone" *> space1 *> endHead *> aExpr)
+      , symbolicBinOpExpr a aExpr SymbolicBinOpAExpr
+      , SuffixQualOpAExpr a <$> (space *> qualOp)
+      , AndAExpr a <$> (space1 *> keyword "and" *> space1 *> endHead *> aExpr)
+      , OrAExpr a <$> (space1 *> keyword "or" *> space1 *> endHead *> aExpr)
+      , do
+        space1
+        b <- trueIfPresent (keyword "not" *> space1)
+        c <- asum
+          [ LikeVerbalExprBinOp <$ keyword "like"
+          , IlikeVerbalExprBinOp <$ keyword "ilike"
+          , SimilarToVerbalExprBinOp <$ keyphrase "similar to"
+          ]
+        space1
+        endHead
+        d <- aExpr
+        e <- optional (space1 *> keyword "escape" *> space1 *> endHead *> aExpr)
+        return (VerbalExprBinOpAExpr a b c d e)
+      , do
+        space1
+        keyword "is"
+        space1
+        endHead
+        b <- trueIfPresent (keyword "not" *> space1)
+        c <- asum
+          [ NullAExprReversableOp <$ keyword "null"
+          , TrueAExprReversableOp <$ keyword "true"
+          , FalseAExprReversableOp <$ keyword "false"
+          , UnknownAExprReversableOp <$ keyword "unknown"
+          , DistinctFromAExprReversableOp
+            <$> (  keyword "distinct"
+                *> space1
+                *> keyword "from"
+                *> space1
+                *> endHead
+                *> aExpr
+                )
+          , OfAExprReversableOp
+            <$> (keyword "of" *> space1 *> endHead *> inParens typeList)
+          , DocumentAExprReversableOp <$ keyword "document"
+          ]
+        return (ReversableOpAExpr a b c)
+      , do
+        space1
+        b <- trueIfPresent (keyword "not" *> space1)
+        keyword "between"
+        space1
+        endHead
+        c <- asum
+          [ BetweenSymmetricAExprReversableOp <$ (keyword "symmetric" *> space1)
+          , BetweenAExprReversableOp True <$ (keyword "asymmetric" *> space1)
+          , pure (BetweenAExprReversableOp False)
+          ]
+        d <- bExpr
+        space1
+        keyword "and"
+        space1
+        e <- aExpr
+        return (ReversableOpAExpr a b (c d e))
+      , do
+        space1
+        b <- trueIfPresent (keyword "not" *> space1)
+        keyword "in"
+        space
+        c <- InAExprReversableOp <$> inExpr
+        return (ReversableOpAExpr a b c)
+      , IsnullAExpr a <$ (space1 *> keyword "isnull")
+      , NotnullAExpr a <$ (space1 *> keyword "notnull")
+      ]
     ]
 
 bExpr = customizedBExpr cExpr

From cbf2fc5f3b57170110452abfcbf37b67dbfab12e Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <ls-contractor@proda.ai>
Date: Thu, 18 Mar 2021 18:16:39 +0000
Subject: [PATCH 3/8] Factor out common space1 prefix in parser

---
 library/PostgresqlSyntax/Parsing.hs | 29 +++++++++++++----------------
 1 file changed, 13 insertions(+), 16 deletions(-)

diff --git a/library/PostgresqlSyntax/Parsing.hs b/library/PostgresqlSyntax/Parsing.hs
index ec24bc6..a059284 100644
--- a/library/PostgresqlSyntax/Parsing.hs
+++ b/library/PostgresqlSyntax/Parsing.hs
@@ -1073,26 +1073,22 @@ customizedAExpr cExpr = suffixRec base suffix where
     , CExprAExpr <$> cExpr
     ]
   suffix a = asum
-    [ asum
+    [ typecastExpr a TypecastAExpr
+    , symbolicBinOpExpr a aExpr SymbolicBinOpAExpr
+    , space1 *> asum
       [ do
-        space1
         b <- wrapToHead subqueryOp
         space1
         c <- wrapToHead subType
         space
         d <- Left <$> wrapToHead selectWithParens <|> Right <$> inParens aExpr
         return (SubqueryAExpr a b c d)
-      , typecastExpr a TypecastAExpr
-      , CollateAExpr a
-        <$> (space1 *> keyword "collate" *> space1 *> endHead *> anyName)
+      , CollateAExpr a <$> (keyword "collate" *> space1 *> endHead *> anyName)
       , AtTimeZoneAExpr a
-        <$> (space1 *> keyphrase "at time zone" *> space1 *> endHead *> aExpr)
-      , symbolicBinOpExpr a aExpr SymbolicBinOpAExpr
-      , SuffixQualOpAExpr a <$> (space *> qualOp)
-      , AndAExpr a <$> (space1 *> keyword "and" *> space1 *> endHead *> aExpr)
-      , OrAExpr a <$> (space1 *> keyword "or" *> space1 *> endHead *> aExpr)
+        <$> (keyphrase "at time zone" *> space1 *> endHead *> aExpr)
+      , AndAExpr a <$> (keyword "and" *> space1 *> endHead *> aExpr)
+      , OrAExpr a <$> (keyword "or" *> space1 *> endHead *> aExpr)
       , do
-        space1
         b <- trueIfPresent (keyword "not" *> space1)
         c <- asum
           [ LikeVerbalExprBinOp <$ keyword "like"
@@ -1105,7 +1101,6 @@ customizedAExpr cExpr = suffixRec base suffix where
         e <- optional (space1 *> keyword "escape" *> space1 *> endHead *> aExpr)
         return (VerbalExprBinOpAExpr a b c d e)
       , do
-        space1
         keyword "is"
         space1
         endHead
@@ -1129,7 +1124,6 @@ customizedAExpr cExpr = suffixRec base suffix where
           ]
         return (ReversableOpAExpr a b c)
       , do
-        space1
         b <- trueIfPresent (keyword "not" *> space1)
         keyword "between"
         space1
@@ -1146,15 +1140,18 @@ customizedAExpr cExpr = suffixRec base suffix where
         e <- aExpr
         return (ReversableOpAExpr a b (c d e))
       , do
-        space1
         b <- trueIfPresent (keyword "not" *> space1)
         keyword "in"
         space
         c <- InAExprReversableOp <$> inExpr
         return (ReversableOpAExpr a b c)
-      , IsnullAExpr a <$ (space1 *> keyword "isnull")
-      , NotnullAExpr a <$ (space1 *> keyword "notnull")
+      , IsnullAExpr a <$ (keyword "isnull")
+      , NotnullAExpr a <$ (keyword "notnull")
       ]
+    , SuffixQualOpAExpr a <$> (space *> qualOp)
+      -- TODO SuffixQualOpAExpr has a common prefix with SubqueryAExpr
+      -- so for now we rely on the order of the parsers here, which works well
+      -- enough.
     ]
 
 bExpr = customizedBExpr cExpr

From 2e742aaf4bbf09e253740fd52a3b24227c143b2a Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <ls-contractor@proda.ai>
Date: Thu, 18 Mar 2021 18:18:14 +0000
Subject: [PATCH 4/8] Improve nested parens performance

---
 library/PostgresqlSyntax/Parsing.hs | 38 ++++++++++++++++++++---------
 1 file changed, 27 insertions(+), 11 deletions(-)

diff --git a/library/PostgresqlSyntax/Parsing.hs b/library/PostgresqlSyntax/Parsing.hs
index a059284..3449dc9 100644
--- a/library/PostgresqlSyntax/Parsing.hs
+++ b/library/PostgresqlSyntax/Parsing.hs
@@ -358,7 +358,7 @@ selectWithParens = inParens
 selectNoParens = withSelectNoParens <|> simpleSelectNoParens
 
 sharedSelectNoParens _with = do
-  _select     <- selectClause
+  _select     <- selectClauseNoParens
   _sort       <- optional (space1 *> sortClause)
   _limit      <- optional (space1 *> selectLimit)
   _forLocking <- optional (space1 *> forLockingClause)
@@ -384,6 +384,10 @@ selectClause = suffixRec base suffix where
   base = asum [Right <$> selectWithParens, Left <$> baseSimpleSelect]
   suffix a = Left <$> extensionSimpleSelect a
 
+selectClauseNoParens = suffixRec base suffix where
+  base = Left <$> baseSimpleSelect
+  suffix a = Left <$> extensionSimpleSelect a
+
 baseSimpleSelect = asum
   [ do
     keyword "select"
@@ -1190,8 +1194,21 @@ customizedCExpr columnref = asum
   [ ParamCExpr <$> (char '$' *> decimal <* endHead) <*> optional
     (space *> indirection)
   , CaseCExpr <$> caseExpr
-  , ImplicitRowCExpr <$> implicitRow
   , ExplicitRowCExpr <$> explicitRow
+  , char '(' *> space *> asum
+    [ do
+      a <- selectNoParens <* endHead <* space <* char ')'
+      b <- optional (space *> indirection)
+      return (SelectWithParensCExpr (NoParensSelectWithParens a) b)
+    , do
+      a <- aExpr
+      endHead
+      asum
+        [ ImplicitRowCExpr <$> implicitRowTail a
+        , InParensCExpr a
+          <$> (space *> char ')' *> optional (space *> indirection))
+        ]
+    ]
   , inParensWithClause (keyword "grouping")
                        (GroupingCExpr <$> sep1 commaSeparator aExpr)
   , keyword "exists" *> space *> (ExistsCExpr <$> selectWithParens)
@@ -1202,13 +1219,6 @@ customizedCExpr columnref = asum
       [ fmap (fmap (ArrayCExpr . Right))       arrayExprCont
       , fmap (fmap (ArrayCExpr . Left) . pure) selectWithParens
       ]
-  , do
-    a <- wrapToHead selectWithParens
-    endHead
-    b <- optional (space *> indirection)
-    return (SelectWithParensCExpr a b)
-  , InParensCExpr <$> (inParens aExpr <* endHead) <*> optional
-    (space *> indirection)
   , AexprConstCExpr <$> wrapToHead aexprConst
   , FuncCExpr <$> funcExpr
   , ColumnrefCExpr <$> columnref
@@ -1264,8 +1274,14 @@ row = ExplicitRowRow <$> explicitRow <|> ImplicitRowRow <$> implicitRow
 
 explicitRow = keyword "row" *> space *> inParens (optional exprList)
 
-implicitRow = inParens $ do
-  a <- wrapToHead aExpr
+implicitRow = inParens (wrapToHead aExpr >>= implicitRowTailInner)
+
+-- the "tail" of the @implicitRow@ parser, i.e. the parser after the initial
+-- "( $EXPR" part.
+implicitRowTail :: AExpr -> Parser ImplicitRow
+implicitRowTail a = implicitRowTailInner a <* space <* char ')'
+
+implicitRowTailInner a = do
   commaSeparator
   b <- exprList
   return $ case NonEmpty.consAndUnsnoc a b of

From f677eb1e17a3ecebdd47ecbe9f0d5b5186d8befd Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <ls-contractor@proda.ai>
Date: Tue, 23 Mar 2021 00:49:00 +0000
Subject: [PATCH 5/8] Fix last commit

Tests expect other option for ambiguous parses
(nested parens with a select -> Should be WithParensSelectWithParens)
---
 library/PostgresqlSyntax/Parsing.hs | 23 ++++++++++++++++++++---
 1 file changed, 20 insertions(+), 3 deletions(-)

diff --git a/library/PostgresqlSyntax/Parsing.hs b/library/PostgresqlSyntax/Parsing.hs
index 3449dc9..98fd409 100644
--- a/library/PostgresqlSyntax/Parsing.hs
+++ b/library/PostgresqlSyntax/Parsing.hs
@@ -358,7 +358,9 @@ selectWithParens = inParens
 selectNoParens = withSelectNoParens <|> simpleSelectNoParens
 
 sharedSelectNoParens _with = do
-  _select     <- selectClauseNoParens
+  _select <- case _with of
+    Just{}  -> selectClause
+    Nothing -> selectClauseNoParens
   _sort       <- optional (space1 *> sortClause)
   _limit      <- optional (space1 *> selectLimit)
   _forLocking <- optional (space1 *> forLockingClause)
@@ -1205,8 +1207,9 @@ customizedCExpr columnref = asum
       endHead
       asum
         [ ImplicitRowCExpr <$> implicitRowTail a
-        , InParensCExpr a
-          <$> (space *> char ')' *> optional (space *> indirection))
+        , convertNestedParenSelect
+        .   InParensCExpr a
+        <$> (space *> char ')' *> optional (space *> indirection))
         ]
     ]
   , inParensWithClause (keyword "grouping")
@@ -1224,6 +1227,20 @@ customizedCExpr columnref = asum
   , ColumnrefCExpr <$> columnref
   ]
 
+convertNestedParenSelect :: CExpr -> CExpr
+convertNestedParenSelect cExpr = case go cExpr of
+  Left  x -> SelectWithParensCExpr x Nothing
+  Right x -> x
+ where
+  go :: CExpr -> Either SelectWithParens CExpr
+  go (InParensCExpr (CExprAExpr e) ind) = case go e of
+    Left select -> case ind of
+      Nothing -> Left $ WithParensSelectWithParens select
+      Just{} ->
+        Right $ SelectWithParensCExpr (WithParensSelectWithParens select) ind
+    Right x -> Right $ InParensCExpr (CExprAExpr x) ind
+  go (SelectWithParensCExpr a Nothing) = Left a
+  go x = Right x
 
 -- *
 -------------------------

From b851635c5b47f918979a7003885b7283fbaee509 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <ls-contractor@proda.ai>
Date: Tue, 23 Mar 2021 09:31:39 +0000
Subject: [PATCH 6/8] Add comment about binop parsing failure behaviour

---
 library/PostgresqlSyntax/Parsing.hs | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/library/PostgresqlSyntax/Parsing.hs b/library/PostgresqlSyntax/Parsing.hs
index 98fd409..2470f11 100644
--- a/library/PostgresqlSyntax/Parsing.hs
+++ b/library/PostgresqlSyntax/Parsing.hs
@@ -1080,6 +1080,11 @@ customizedAExpr cExpr = suffixRec base suffix where
     ]
   suffix a = asum
     [ typecastExpr a TypecastAExpr
+      -- we could just use `base` instead of `aExpr` for the BinOp, would
+      -- lead to slightly different trees. I am not completely convinced that
+      -- `wrapHead` catches the case where you have a sequence of expressions
+      -- and operators followed by something that does not parse (my fear is
+      -- that it would repeatedly fail for each level).
     , symbolicBinOpExpr a aExpr SymbolicBinOpAExpr
     , space1 *> asum
       [ do
@@ -1173,6 +1178,11 @@ customizedBExpr cExpr = suffixRec base suffix where
     ]
   suffix a = asum
     [ typecastExpr a TypecastBExpr
+      -- we could just use `base` instead of `bExpr` for the BinOp, would
+      -- lead to slightly different trees. I am not completely convinced that
+      -- `wrapHead` catches the case where you have a sequence of expressions
+      -- and operators followed by something that does not parse (my fear is
+      -- that it would repeatedly fail for each level).
     , symbolicBinOpExpr a bExpr SymbolicBinOpBExpr
     , do
       space1

From 76aa4bec5354b6957000150dcec1d84fae0a159b Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <ls-contractor@proda.ai>
Date: Tue, 23 Mar 2021 09:33:36 +0000
Subject: [PATCH 7/8] Fix common-prefix colId in asum of cExpr

---
 library/PostgresqlSyntax/Parsing.hs | 82 +++++++++++++++++++++++------
 1 file changed, 66 insertions(+), 16 deletions(-)

diff --git a/library/PostgresqlSyntax/Parsing.hs b/library/PostgresqlSyntax/Parsing.hs
index 2470f11..820c6ab 100644
--- a/library/PostgresqlSyntax/Parsing.hs
+++ b/library/PostgresqlSyntax/Parsing.hs
@@ -1200,9 +1200,19 @@ customizedBExpr cExpr = suffixRec base suffix where
       return (IsOpBExpr a b c)
     ]
 
-cExpr = customizedCExpr columnref
+cExpr = asum
+  [ cExprCommon
+  , FuncCExpr <$> funcExprNoCommonPrefix
+  , do
+    a <- wrapToHead colId
+    endHead
+    asum [FuncCExpr <$> funcExprTail a, ColumnrefCExpr <$> columnrefCont a]
+  ]
 
-customizedCExpr columnref = asum
+customizedCExpr columnref =
+  asum [cExprCommon, FuncCExpr <$> funcExpr, ColumnrefCExpr <$> columnref]
+
+cExprCommon = asum
   [ ParamCExpr <$> (char '$' *> decimal <* endHead) <*> optional
     (space *> indirection)
   , CaseCExpr <$> caseExpr
@@ -1233,8 +1243,6 @@ customizedCExpr columnref = asum
       , fmap (fmap (ArrayCExpr . Left) . pure) selectWithParens
       ]
   , AexprConstCExpr <$> wrapToHead aexprConst
-  , FuncCExpr <$> funcExpr
-  , ColumnrefCExpr <$> columnref
   ]
 
 convertNestedParenSelect :: CExpr -> CExpr
@@ -1350,16 +1358,28 @@ elseClause = do
   space1
   return a
 
-funcExpr = asum
+funcExpr :: Parser FuncExpr
+funcExpr = funcExprNoCommonPrefix <|> (wrapToHead colId >>= funcExprTail)
+
+funcExprNoCommonPrefix :: Parser FuncExpr
+funcExprNoCommonPrefix = asum
   [ SubexprFuncExpr <$> funcExprCommonSubexpr
   , do
-    a <- funcApplication
-    endHead
-    b <- optional (space1 *> withinGroupClause)
-    c <- optional (space1 *> filterClause)
-    d <- optional (space1 *> overClause)
-    return (ApplicationFuncExpr a b c d)
+    app <- funcApplicationNoCommonPrefix
+    appFuncExprTail app
   ]
+funcExprTail :: Ident -> HeadedParsec Void Text FuncExpr
+funcExprTail ident = do
+  a <- wrapToHead $ funcApplicationTailIdent ident
+  endHead
+  appFuncExprTail a
+
+appFuncExprTail a = do
+  b <- optional (space1 *> withinGroupClause)
+  c <- optional (space1 *> filterClause)
+  d <- optional (space1 *> overClause)
+  return (ApplicationFuncExpr a b c d)
+
 
 funcExprWindowless = asum
   [ CommonSubexprFuncExprWindowless <$> funcExprCommonSubexpr
@@ -1515,6 +1535,29 @@ trimList = asum
 funcApplication =
   inParensWithLabel FuncApplication funcName (optional funcApplicationParams)
 
+funcApplicationNoCommonPrefix :: Parser FuncApplication
+funcApplicationNoCommonPrefix = do
+  label <- wrapToHead funcNameNoCommonPrefix
+  funcApplicationContFuncName label
+
+-- the tail of the @funcApplication@ parser after the initial @Ident@ parser.
+funcApplicationTailIdent :: Ident -> Parser FuncApplication
+funcApplicationTailIdent ident = do
+  label <- funcNameTail ident
+  funcApplicationContFuncName label
+
+funcApplicationContFuncName
+  :: FuncName -> HeadedParsec Void Text FuncApplication
+funcApplicationContFuncName label = do
+  space
+  char '('
+  endHead
+  space
+  content <- optional funcApplicationParams
+  space
+  char ')'
+  pure (FuncApplication label content)
+
 funcApplicationParams = asum
   [ starFuncApplicationParams
   , listVariadicFuncApplicationParams
@@ -2046,12 +2089,16 @@ qualifiedName =
     <$> colId
 
 columnref = customizedColumnref colId
+columnrefCont = customizedColumnrefCont
 
 filteredColumnref _keywords = customizedColumnref (filteredColId _keywords)
 
 customizedColumnref colId = do
   a <- wrapToHead colId
   endHead
+  customizedColumnrefCont a
+
+customizedColumnrefCont a = do
   b <- optional (space *> indirection)
   return (Columnref a b)
 
@@ -2077,11 +2124,14 @@ func_name:
   | ColId indirection
 -}
 funcName =
-  IndirectedFuncName
-    <$> wrapToHead colId
-    <*> (space *> indirection)
-    <|> TypeFuncName
-    <$> typeFunctionName
+  (wrapToHead colId >>= funcNameTail) <|> TypeFuncName <$> typeFunctionName
+
+-- the tail of the @funcName@ parser after the head consisting of an @Ident@.
+funcNameTail :: Ident -> HeadedParsec Void Text FuncName
+funcNameTail a = IndirectedFuncName a <$> (space *> indirection)
+funcNameNoCommonPrefix :: HeadedParsec Void Text FuncName
+funcNameNoCommonPrefix = TypeFuncName <$> typeFunctionName
+
 
 {-
 type_function_name:

From e0450870e35dcbfd4a11d6757bcb54c4bd65cc10 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <ls-contractor@proda.ai>
Date: Tue, 23 Mar 2021 12:45:01 +0000
Subject: [PATCH 8/8] Improve another open-paren-then-stuff aExpr/cExpr parsing
 overlap

---
 library/PostgresqlSyntax/Parsing.hs | 88 ++++++++++++++++++++++-------
 1 file changed, 67 insertions(+), 21 deletions(-)

diff --git a/library/PostgresqlSyntax/Parsing.hs b/library/PostgresqlSyntax/Parsing.hs
index 820c6ab..77ffe14 100644
--- a/library/PostgresqlSyntax/Parsing.hs
+++ b/library/PostgresqlSyntax/Parsing.hs
@@ -1070,13 +1070,29 @@ customizedAExpr cExpr = suffixRec base suffix where
     [ DefaultAExpr <$ keyword "default"
     , UniqueAExpr <$> (keyword "unique" *> space1 *> selectWithParens)
     , OverlapsAExpr
-    <$> wrapToHead row
+    <$> wrapToHead (ExplicitRowRow <$> explicitRow)
     <*> (space1 *> keyword "overlaps" *> space1 *> endHead *> row)
     , qualOpExpr aExpr PrefixQualOpAExpr
     , PlusAExpr <$> plusedExpr aExpr
     , MinusAExpr <$> minusedExpr aExpr
     , NotAExpr <$> (keyword "not" *> space1 *> aExpr)
-    , CExprAExpr <$> cExpr
+    , CExprAExpr <$> cExprNoCommonPrefix
+    , char '(' *> space *> asum
+      [ CExprAExpr <$> cExprTailNoCommonPrefix
+      , do
+        a <- wrapToHead aExpr
+        asum
+          [ do
+            b <- wrapToHead $ ImplicitRowRow <$> implicitRowTail a
+            space1
+            keyword "overlaps"
+            space1
+            endHead
+            c <- row
+            return $ OverlapsAExpr b c
+          , CExprAExpr . convertNestedParenSelect <$> cExprTailParenExpr a
+          ]
+      ]
     ]
   suffix a = asum
     [ typecastExpr a TypecastAExpr
@@ -1200,7 +1216,11 @@ customizedBExpr cExpr = suffixRec base suffix where
       return (IsOpBExpr a b c)
     ]
 
-cExpr = asum
+cExpr :: Parser CExpr
+cExpr = asum [cExprNoCommonPrefix, char '(' *> space *> cExprTailParen]
+
+cExprNoCommonPrefix :: Parser CExpr
+cExprNoCommonPrefix = asum
   [ cExprCommon
   , FuncCExpr <$> funcExprNoCommonPrefix
   , do
@@ -1209,29 +1229,12 @@ cExpr = asum
     asum [FuncCExpr <$> funcExprTail a, ColumnrefCExpr <$> columnrefCont a]
   ]
 
-customizedCExpr columnref =
-  asum [cExprCommon, FuncCExpr <$> funcExpr, ColumnrefCExpr <$> columnref]
-
+cExprCommon :: Parser CExpr
 cExprCommon = asum
   [ ParamCExpr <$> (char '$' *> decimal <* endHead) <*> optional
     (space *> indirection)
   , CaseCExpr <$> caseExpr
   , ExplicitRowCExpr <$> explicitRow
-  , char '(' *> space *> asum
-    [ do
-      a <- selectNoParens <* endHead <* space <* char ')'
-      b <- optional (space *> indirection)
-      return (SelectWithParensCExpr (NoParensSelectWithParens a) b)
-    , do
-      a <- aExpr
-      endHead
-      asum
-        [ ImplicitRowCExpr <$> implicitRowTail a
-        , convertNestedParenSelect
-        .   InParensCExpr a
-        <$> (space *> char ')' *> optional (space *> indirection))
-        ]
-    ]
   , inParensWithClause (keyword "grouping")
                        (GroupingCExpr <$> sep1 commaSeparator aExpr)
   , keyword "exists" *> space *> (ExistsCExpr <$> selectWithParens)
@@ -1245,6 +1248,43 @@ cExprCommon = asum
   , AexprConstCExpr <$> wrapToHead aexprConst
   ]
 
+-- cExpr following a '('
+cExprTailParen :: Parser CExpr
+cExprTailParen = asum
+  [ cExprTailNoCommonPrefix
+  , do
+    a <- aExpr
+    endHead
+    cExprTailParenExpr a
+  ]
+
+-- the part of the tail-parser of a cExpr after a '(' that does not have a
+-- @aExpr@ prefix.
+cExprTailNoCommonPrefix :: Parser CExpr
+cExprTailNoCommonPrefix = do
+  a <- selectNoParens <* endHead <* space <* char ')'
+  b <- optional (space *> indirection)
+  return (SelectWithParensCExpr (NoParensSelectWithParens a) b)
+
+-- cExpr following a '(' plus an @aExpr@.
+cExprTailParenExpr :: AExpr -> Parser CExpr
+cExprTailParenExpr a = asum
+  [ ImplicitRowCExpr <$> implicitRowTail a
+  , InParensCExpr a <$> (space *> char ')' *> optional (space *> indirection))
+  ]
+
+customizedCExpr :: Parser Columnref -> Parser CExpr
+customizedCExpr columnref = asum
+  [ cExprCommon
+  , char '(' *> space *> cExprTailParen
+  , FuncCExpr <$> funcExpr
+  , ColumnrefCExpr <$> columnref
+  ]
+
+
+openParenAExpr :: Parser AExpr
+openParenAExpr = char '(' *> space *> aExpr <* endHead
+
 convertNestedParenSelect :: CExpr -> CExpr
 convertNestedParenSelect cExpr = case go cExpr of
   Left  x -> SelectWithParensCExpr x Nothing
@@ -1310,6 +1350,12 @@ row = ExplicitRowRow <$> explicitRow <|> ImplicitRowRow <$> implicitRow
 explicitRow = keyword "row" *> space *> inParens (optional exprList)
 
 implicitRow = inParens (wrapToHead aExpr >>= implicitRowTailInner)
+-- implicitRow = inParens $ do
+--   a <- wrapToHead aExpr
+--   commaSeparator
+--   b <- exprList
+--   return $ case NonEmpty.consAndUnsnoc a b of
+--     (c, d) -> ImplicitRow c d
 
 -- the "tail" of the @implicitRow@ parser, i.e. the parser after the initial
 -- "( $EXPR" part.