{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-missing-signatures -Wno-dodgy-imports #-}

-- |
--
-- Our parsing strategy is to port the original Postgres parser as closely as possible.
--
-- We're using the @gram.y@ Postgres source file, which is the closest thing we have
-- to a Postgres syntax spec. Here's a link to it:
-- https://github.com/postgres/postgres/blob/master/src/backend/parser/gram.y.
--
-- Here's the essence of how the original parser is implemented, citing from
-- [PostgreSQL Wiki](https://wiki.postgresql.org/wiki/Developer_FAQ):
--
--     scan.l defines the lexer, i.e. the algorithm that splits a string
--     (containing an SQL statement) into a stream of tokens.
--     A token is usually a single word
--     (i.e., doesn't contain spaces but is delimited by spaces),
--     but can also be a whole single or double-quoted string for example.
--     The lexer is basically defined in terms of regular expressions
--     which describe the different token types.
--
--     gram.y defines the grammar (the syntactical structure) of SQL statements,
--     using the tokens generated by the lexer as basic building blocks.
--     The grammar is defined in BNF notation.
--     BNF resembles regular expressions but works on the level of tokens, not characters.
--     Also, patterns (called rules or productions in BNF) are named, and may be recursive,
--     i.e. use themselves as sub-patterns.
module PostgresqlSyntax.Parsing where

import Control.Applicative.Combinators hiding (some)
import Control.Applicative.Combinators.NonEmpty
import qualified Data.HashSet as HashSet
import qualified Data.Text as Text
import HeadedMegaparsec hiding (string)
import PostgresqlSyntax.Ast
import PostgresqlSyntax.Extras.HeadedMegaparsec hiding (run)
import qualified PostgresqlSyntax.Extras.HeadedMegaparsec as Extras
import qualified PostgresqlSyntax.Extras.NonEmpty as NonEmpty
import qualified PostgresqlSyntax.KeywordSet as KeywordSet
import qualified PostgresqlSyntax.Predicate as Predicate
import PostgresqlSyntax.Prelude hiding (bit, expr, filter, fromList, head, many, option, some, sortBy, tail, try)
import qualified PostgresqlSyntax.Validation as Validation
import qualified Text.Builder as TextBuilder
import qualified Text.Megaparsec as Megaparsec
import qualified Text.Megaparsec.Char as MegaparsecChar

-- $setup
-- >>> testParser parser = either putStr print . run parser

type Parser = HeadedParsec Void Text

-- * Executors

run :: Parser a -> Text -> Either String a
run = Extras.run

-- * Helpers

commaSeparator :: Parser ()
commaSeparator = space *> char ',' *> endHead *> space

dotSeparator :: Parser ()
dotSeparator = space *> char '.' *> endHead *> space

inBrackets :: Parser a -> Parser a
inBrackets p = char '[' *> space *> p <* endHead <* space <* char ']'

inBracketsCont :: Parser a -> Parser (Parser a)
inBracketsCont p = char '[' *> endHead *> pure (space *> p <* endHead <* space <* char ']')

inParens :: Parser a -> Parser a
inParens p = char '(' *> space *> p <* endHead <* space <* char ')'

inParensCont :: Parser a -> Parser (Parser a)
inParensCont p = char '(' *> endHead *> pure (space *> p <* endHead <* space <* char ')')

inParensWithLabel :: (label -> content -> result) -> Parser label -> Parser content -> Parser result
inParensWithLabel result labelParser contentParser = do
  label <- wrapToHead labelParser
  space
  char '('
  endHead
  space
  content <- contentParser
  space
  char ')'
  pure (result label content)

inParensWithClause :: Parser clause -> Parser content -> Parser content
inParensWithClause = inParensWithLabel (const id)

trueIfPresent :: Parser a -> Parser Bool
trueIfPresent p = option False (True <$ p)

-- |
-- >>> testParser (quotedString '\'') "'abc''d'"
-- "abc'd"
quotedString :: Char -> Parser Text
quotedString q = do
  char q
  endHead
  tail <-
    parse
      $ let collectChunks !bdr = do
              chunk <- Megaparsec.takeWhileP Nothing (/= q)
              let bdr' = bdr <> TextBuilder.text chunk
              Megaparsec.try (consumeEscapedQuote bdr') <|> finish bdr'
            consumeEscapedQuote bdr = do
              MegaparsecChar.char q
              MegaparsecChar.char q
              collectChunks (bdr <> TextBuilder.char q)
            finish bdr = do
              MegaparsecChar.char q
              return (TextBuilder.run bdr)
         in collectChunks mempty
  return tail

atEnd :: Parser a -> Parser a
atEnd p = space *> p <* endHead <* space <* eof

-- * PreparableStmt

preparableStmt =
  asum
    [ SelectPreparableStmt <$> selectStmt,
      InsertPreparableStmt <$> insertStmt,
      UpdatePreparableStmt <$> updateStmt,
      DeletePreparableStmt <$> deleteStmt,
      CallPreparableStmt <$> callStmt
    ]

-- * Call

callStmt = do
  keyword "call"
  space1
  CallStmt <$> funcApplication

-- * Insert

insertStmt = do
  a <- optional (wrapToHead withClause <* space1)
  keyword "insert"
  space1
  endHead
  keyword "into"
  space1
  b <- insertTarget
  space1
  c <- insertRest
  d <- optional (space1 *> onConflict)
  e <- optional (space1 *> returningClause)
  return (InsertStmt a b c d e)

insertTarget = do
  a <- qualifiedName
  endHead
  b <- optional (space1 *> keyword "as" *> space1 *> endHead *> colId)
  return (InsertTarget a b)

insertRest =
  asum
    [ DefaultValuesInsertRest <$ (keyword "default" *> space1 *> endHead *> keyword "values"),
      do
        a <- optional (inParens insertColumnList <* space1)
        b <- optional $ do
          keyword "overriding"
          space1
          endHead
          b <- overrideKind
          space1
          keyword "value"
          space1
          return b
        c <- selectStmt
        return (SelectInsertRest a b c)
    ]

overrideKind =
  asum
    [ UserOverrideKind <$ keyword "user",
      SystemOverrideKind <$ keyword "system"
    ]

insertColumnList = sep1 commaSeparator insertColumnItem

insertColumnItem = do
  a <- colId
  endHead
  b <- optional (space1 *> indirection)
  return (InsertColumnItem a b)

onConflict = do
  keyword "on"
  space1
  keyword "conflict"
  space1
  endHead
  a <- optional (confExpr <* space1)
  keyword "do"
  space1
  b <- onConflictDo
  return (OnConflict a b)

confExpr =
  asum
    [ WhereConfExpr <$> inParens indexParams <*> optional (space *> whereClause),
      ConstraintConfExpr <$> (keyword "on" *> space1 *> keyword "constraint" *> space1 *> endHead *> name)
    ]

onConflictDo =
  asum
    [ NothingOnConflictDo <$ keyword "nothing",
      do
        keyword "update"
        space1
        endHead
        keyword "set"
        space1
        a <- setClauseList
        b <- optional (space1 *> whereClause)
        return (UpdateOnConflictDo a b)
    ]

returningClause = do
  keyword "returning"
  space1
  endHead
  targetList

-- * Update

updateStmt = do
  a <- optional (wrapToHead withClause <* space1)
  keyword "update"
  space1
  endHead
  b <- relationExprOptAlias ["set"]
  space1
  keyword "set"
  space1
  c <- setClauseList
  d <- optional (space1 *> fromClause)
  e <- optional (space1 *> whereOrCurrentClause)
  f <- optional (space1 *> returningClause)
  return (UpdateStmt a b c d e f)

setClauseList = sep1 commaSeparator setClause

setClause =
  asum
    [ do
        a <- inParens setTargetList
        space
        char '='
        space
        b <- aExpr
        return (TargetListSetClause a b),
      do
        a <- setTarget
        space
        char '='
        space
        b <- aExpr
        return (TargetSetClause a b)
    ]

setTarget = do
  a <- colId
  endHead
  b <- optional (space1 *> indirection)
  return (SetTarget a b)

setTargetList = sep1 commaSeparator setTarget

-- * Delete

deleteStmt = do
  a <- optional (wrapToHead withClause <* space1)
  keyword "delete"
  space1
  endHead
  keyword "from"
  space1
  b <- relationExprOptAlias ["using", "where", "returning"]
  c <- optional (space1 *> usingClause)
  d <- optional (space1 *> whereOrCurrentClause)
  e <- optional (space1 *> returningClause)
  return (DeleteStmt a b c d e)

usingClause = do
  keyword "using"
  space1
  fromList

-- * Select

-- |
-- >>> test = testParser selectStmt
--
-- >>> test "select id from as"
-- ...
--   |
-- 1 | select id from as
--   |                  ^
-- Reserved keyword "as" used as an identifier. If that's what you intend, you have to wrap it in double quotes.
selectStmt = Left <$> selectNoParens <|> Right <$> selectWithParens

selectWithParens = inParens (WithParensSelectWithParens <$> selectWithParens <|> NoParensSelectWithParens <$> selectNoParens)

selectNoParens = withSelectNoParens <|> simpleSelectNoParens

sharedSelectNoParens with = do
  select <- selectClause
  sort <- optional (space1 *> sortClause)
  limit <- optional (space1 *> selectLimit)
  forLocking <- optional (space1 *> forLockingClause)
  return (SelectNoParens with select sort limit forLocking)

-- |
-- The one that doesn't start with \"WITH\".
--
-- ==== References
-- @
--   | simple_select
--   | select_clause sort_clause
--   | select_clause opt_sort_clause for_locking_clause opt_select_limit
--   | select_clause opt_sort_clause select_limit opt_for_locking_clause
-- @
simpleSelectNoParens = sharedSelectNoParens Nothing

withSelectNoParens = do
  with <- wrapToHead withClause
  space1
  sharedSelectNoParens (Just with)

selectClause = suffixRec base suffix
  where
    base =
      asum
        [ Right <$> selectWithParens,
          Left <$> baseSimpleSelect
        ]
    suffix a = Left <$> extensionSimpleSelect a

baseSimpleSelect =
  asum
    [ do
        keyword "select"
        notFollowedBy $ satisfy $ isAlphaNum
        endHead
        targeting <- optional (space1 *> targeting)
        intoClause <- optional (space1 *> keyword "into" *> endHead *> space1 *> optTempTableName)
        fromClause <- optional (space1 *> fromClause)
        whereClause <- optional (space1 *> whereClause)
        groupClause <- optional (space1 *> keyphrase "group by" *> endHead *> space1 *> sep1 commaSeparator groupByItem)
        havingClause <- optional (space1 *> keyword "having" *> endHead *> space1 *> aExpr)
        windowClause <- optional (space1 *> keyword "window" *> endHead *> space1 *> sep1 commaSeparator windowDefinition)
        return (NormalSimpleSelect targeting intoClause fromClause whereClause groupClause havingClause windowClause),
      do
        keyword "table"
        space1
        endHead
        TableSimpleSelect <$> relationExpr,
      ValuesSimpleSelect <$> valuesClause
    ]

extensionSimpleSelect headSelectClause = do
  op <- space1 *> selectBinOp <* space1
  endHead
  allOrDistinct <- optional (allOrDistinct <* space1)
  selectClause <- selectClause
  return (BinSimpleSelect op headSelectClause allOrDistinct selectClause)

allOrDistinct = keyword "all" $> False <|> keyword "distinct" $> True

selectBinOp =
  asum
    [ keyword "union" $> UnionSelectBinOp,
      keyword "intersect" $> IntersectSelectBinOp,
      keyword "except" $> ExceptSelectBinOp
    ]

valuesClause = do
  keyword "values"
  space
  sep1 commaSeparator $ do
    char '('
    endHead
    space
    a <- sep1 commaSeparator aExpr
    space
    char ')'
    return a

withClause = label "with clause" $ do
  keyword "with"
  space1
  endHead
  recursive <- option False (True <$ keyword "recursive" <* space1)
  cteList <- sep1 commaSeparator commonTableExpr
  return (WithClause recursive cteList)

commonTableExpr = label "common table expression" $ do
  name <- colId <* space <* endHead
  nameList <- optional (inParens (sep1 commaSeparator colId) <* space1)
  keyword "as"
  space1
  materialized <- optional (materialized <* space1)
  stmt <- inParens preparableStmt
  return (CommonTableExpr name nameList materialized stmt)

materialized =
  True <$ keyword "materialized"
    <|> False <$ keyphrase "not materialized"

targeting = distinct <|> allWithTargetList <|> all <|> normal
  where
    normal = NormalTargeting <$> targetList
    allWithTargetList = do
      keyword "all"
      space1
      AllTargeting <$> Just <$> targetList
    all = keyword "all" $> AllTargeting Nothing
    distinct = do
      keyword "distinct"
      space1
      endHead
      optOn <- optional (onExpressionsClause <* space1)
      targetList <- targetList
      return (DistinctTargeting optOn targetList)

targetList = sep1 commaSeparator targetEl

-- |
-- >>> testParser targetEl "a.b as c"
-- AliasedExprTargetEl (CExprAExpr (ColumnrefCExpr (Columnref (UnquotedIdent "a") (Just (AttrNameIndirectionEl (UnquotedIdent "b") :| []))))) (UnquotedIdent "c")
targetEl =
  label "target"
    $ asum
      [ do
          expr <- aExpr
          asum
            [ do
                space1
                asum
                  [ AliasedExprTargetEl expr <$> (keyword "as" *> space1 *> endHead *> colLabel),
                    ImplicitlyAliasedExprTargetEl expr <$> ident
                  ],
              pure (ExprTargetEl expr)
            ],
        AsteriskTargetEl <$ char '*'
      ]

onExpressionsClause = do
  keyword "on"
  space1
  endHead
  inParens (sep1 commaSeparator aExpr)

-- * Into clause details

-- |
-- ==== References
-- @
-- OptTempTableName:
--   | TEMPORARY opt_table qualified_name
--   | TEMP opt_table qualified_name
--   | LOCAL TEMPORARY opt_table qualified_name
--   | LOCAL TEMP opt_table qualified_name
--   | GLOBAL TEMPORARY opt_table qualified_name
--   | GLOBAL TEMP opt_table qualified_name
--   | UNLOGGED opt_table qualified_name
--   | TABLE qualified_name
--   | qualified_name
-- @
optTempTableName =
  asum
    [ do
        a <-
          asum
            [ TemporaryOptTempTableName <$ keyword "temporary" <* space1,
              TempOptTempTableName <$ keyword "temp" <* space1,
              LocalTemporaryOptTempTableName <$ keyphrase "local temporary" <* space1,
              LocalTempOptTempTableName <$ keyphrase "local temp" <* space1,
              GlobalTemporaryOptTempTableName <$ keyphrase "global temporary" <* space1,
              GlobalTempOptTempTableName <$ keyphrase "global temp" <* space1,
              UnloggedOptTempTableName <$ keyword "unlogged" <* space1
            ]
        b <- option False (True <$ keyword "table" <* space1)
        c <- qualifiedName
        return (a b c),
      do
        keyword "table"
        space1
        endHead
        TableOptTempTableName <$> qualifiedName,
      QualifedOptTempTableName <$> qualifiedName
    ]

-- * Group by details

groupByItem =
  asum
    [ EmptyGroupingSetGroupByItem <$ (char '(' *> space *> char ')'),
      RollupGroupByItem <$> (keyword "rollup" *> endHead *> space *> inParens (sep1 commaSeparator aExpr)),
      CubeGroupByItem <$> (keyword "cube" *> endHead *> space *> inParens (sep1 commaSeparator aExpr)),
      GroupingSetsGroupByItem <$> (keyphrase "grouping sets" *> endHead *> space *> inParens (sep1 commaSeparator groupByItem)),
      ExprGroupByItem <$> aExpr
    ]

-- * Window clause details

windowDefinition = WindowDefinition <$> (colId <* space1 <* keyword "as" <* space1 <* endHead) <*> windowSpecification

-- |
-- ==== References
-- @
-- window_specification:
--   |  '(' opt_existing_window_name opt_partition_clause
--             opt_sort_clause opt_frame_clause ')'
-- @
windowSpecification =
  inParens
    $ asum
      [ do
          a <- frameClause
          return (WindowSpecification Nothing Nothing Nothing (Just a)),
        do
          a <- sortClause
          b <- optional (space1 *> frameClause)
          return (WindowSpecification Nothing Nothing (Just a) b),
        do
          a <- partitionByClause
          b <- optional (space1 *> sortClause)
          c <- optional (space1 *> frameClause)
          return (WindowSpecification Nothing (Just a) b c),
        do
          a <- colId
          b <- optional (space1 *> partitionByClause)
          c <- optional (space1 *> sortClause)
          d <- optional (space1 *> frameClause)
          return (WindowSpecification (Just a) b c d),
        pure (WindowSpecification Nothing Nothing Nothing Nothing)
      ]

partitionByClause = keyphrase "partition by" *> space1 *> endHead *> sep1 commaSeparator aExpr

-- |
-- ==== References
-- @
-- opt_frame_clause:
--   |  RANGE frame_extent opt_window_exclusion_clause
--   |  ROWS frame_extent opt_window_exclusion_clause
--   |  GROUPS frame_extent opt_window_exclusion_clause
--   |  EMPTY
-- @
frameClause = do
  a <- frameClauseMode <* space1 <* endHead
  b <- frameExtent
  c <- optional (space1 *> windowExclusionClause)
  return (FrameClause a b c)

frameClauseMode =
  asum
    [ RangeFrameClauseMode <$ keyword "range",
      RowsFrameClauseMode <$ keyword "rows",
      GroupsFrameClauseMode <$ keyword "groups"
    ]

frameExtent =
  BetweenFrameExtent <$> (keyword "between" *> space1 *> endHead *> frameBound <* space1 <* keyword "and" <* space1) <*> frameBound
    <|> SingularFrameExtent <$> frameBound

-- |
-- ==== References
-- @
--   |  UNBOUNDED PRECEDING
--   |  UNBOUNDED FOLLOWING
--   |  CURRENT_P ROW
--   |  a_expr PRECEDING
--   |  a_expr FOLLOWING
-- @
frameBound =
  UnboundedPrecedingFrameBound <$ keyphrase "unbounded preceding"
    <|> UnboundedFollowingFrameBound <$ keyphrase "unbounded following"
    <|> CurrentRowFrameBound <$ keyphrase "current row"
    <|> do
      a <- aExpr
      space1
      PrecedingFrameBound a <$ keyword "preceding" <|> FollowingFrameBound a <$ keyword "following"

windowExclusionClause =
  CurrentRowWindowExclusionClause <$ keyphrase "exclude current row"
    <|> GroupWindowExclusionClause <$ keyphrase "exclude group"
    <|> TiesWindowExclusionClause <$ keyphrase "exclude ties"
    <|> NoOthersWindowExclusionClause <$ keyphrase "exclude no others"

-- * Table refs

fromList = sep1 commaSeparator tableRef

fromClause = keyword "from" *> endHead *> space1 *> fromList

-- |
-- >>> testParser tableRef "a left join b on (a.i = b.i)"
-- JoinTableRef (MethJoinedTable (QualJoinMeth...
tableRef =
  label "table reference"
    $ do
      tr <- nonTrailingTableRef
      recur tr
  where
    recur tr =
      asum
        [ do
            tr2 <- wrapToHead (space1 *> trailingTableRef tr)
            endHead
            recur tr2,
          pure tr
        ]

nonTrailingTableRef =
  asum
    [ lateralTableRef
        <|> wrapToHead nonLateralTableRef
        <|> relationExprTableRef
        <|> joinedTableWithAliasTableRef
        <|> inParensJoinedTableTableRef
    ]
  where
    relationExprTableRef = do
      relationExpr <- relationExpr
      endHead
      optAliasClause <- optional (space1 *> aliasClause)
      optTablesampleClause <- optional (space1 *> tablesampleClause)
      return (RelationExprTableRef relationExpr optAliasClause optTablesampleClause)

    lateralTableRef = do
      keyword "lateral"
      space1
      endHead
      lateralableTableRef True

    nonLateralTableRef = lateralableTableRef False

    lateralableTableRef lateral =
      asum
        [ do
            a <- funcTable
            b <- optional (space1 *> funcAliasClause)
            return (FuncTableRef lateral a b),
          do
            select <- selectWithParens
            optAliasClause <- optional $ space1 *> aliasClause
            return (SelectTableRef lateral select optAliasClause)
        ]

    inParensJoinedTableTableRef = JoinTableRef <$> inParensJoinedTable <*> pure Nothing

    joinedTableWithAliasTableRef = do
      joinedTable <- wrapToHead (inParens joinedTable)
      space1
      alias <- aliasClause
      return (JoinTableRef joinedTable (Just alias))

trailingTableRef tableRef =
  JoinTableRef <$> trailingJoinedTable tableRef <*> pure Nothing

relationExpr =
  label "relation expression"
    $ asum
      [ do
          keyword "only"
          space1
          name <- qualifiedName
          return (OnlyRelationExpr name False),
        inParensWithClause (keyword "only") qualifiedName <&> \a -> OnlyRelationExpr a True,
        do
          name <- qualifiedName
          asterisk <-
            asum
              [ True <$ (space1 *> char '*'),
                pure False
              ]
          return (SimpleRelationExpr name asterisk)
      ]

relationExprOptAlias reservedKeywords = do
  a <- relationExpr
  b <- optional $ do
    space1
    b <- trueIfPresent (keyword "as" *> space1)
    c <- filteredColId reservedKeywords
    return (b, c)
  return (RelationExprOptAlias a b)

tablesampleClause = do
  keyword "tablesample"
  space1
  endHead
  a <- funcName
  space
  b <- inParens exprList
  c <- optional (space *> repeatableClause)
  return (TablesampleClause a b c)

repeatableClause = do
  keyword "repeatable"
  space
  inParens (endHead *> aExpr)

funcTable =
  asum
    [ do
        keyword "rows"
        space1
        keyword "from"
        space
        a <- inParens (endHead *> rowsfromList)
        b <- trueIfPresent (space *> optOrdinality)
        return (RowsFromFuncTable a b),
      do
        a <- funcExprWindowless
        b <- trueIfPresent (space1 *> optOrdinality)
        return (FuncExprFuncTable a b)
    ]

rowsfromItem = do
  a <- funcExprWindowless
  endHead
  b <- optional (space1 *> colDefList)
  return (RowsfromItem a b)

rowsfromList = sep1 commaSeparator rowsfromItem

colDefList = keyword "as" *> space *> inParens (endHead *> tableFuncElementList)

optOrdinality = keyword "with" *> space1 *> keyword "ordinality"

tableFuncElementList = sep1 commaSeparator tableFuncElement

tableFuncElement = do
  a <- wrapToHead colId
  space1
  b <- typename
  c <- optional (space1 *> collateClause)
  return (TableFuncElement a b c)

collateClause = keyword "collate" *> space1 *> endHead *> anyName

funcAliasClause =
  asum
    [ do
        keyword "as"
        asum
          [ do
              space
              inParens $ do
                endHead
                AsFuncAliasClause <$> tableFuncElementList,
            do
              space1
              a <- colId
              asum
                [ do
                    space
                    inParens $ do
                      endHead
                      asum
                        [ AsColIdFuncAliasClause a <$> wrapToHead tableFuncElementList,
                          AliasFuncAliasClause <$> AliasClause True a <$> Just <$> nameList
                        ],
                  pure (AliasFuncAliasClause (AliasClause True a Nothing))
                ]
          ],
      do
        a <- colId
        asum
          [ do
              space
              inParens $ do
                endHead
                asum
                  [ ColIdFuncAliasClause a <$> wrapToHead tableFuncElementList,
                    AliasFuncAliasClause <$> AliasClause False a <$> Just <$> nameList
                  ],
            pure (AliasFuncAliasClause (AliasClause False a Nothing))
          ]
    ]

joinedTable =
  head >>= tail
  where
    head =
      asum
        [ do
            tr <- wrapToHead nonTrailingTableRef
            space1
            trailingJoinedTable tr,
          inParensJoinedTable
        ]
    tail jt =
      asum
        [ do
            jt2 <- wrapToHead (space1 *> trailingJoinedTable (JoinTableRef jt Nothing))
            endHead
            tail jt2,
          pure jt
        ]

-- |
-- ==== References
-- @
--   | '(' joined_table ')'
-- @
inParensJoinedTable = InParensJoinedTable <$> inParens joinedTable

-- |
-- ==== References
-- @
--   | table_ref CROSS JOIN table_ref
--   | table_ref join_type JOIN table_ref join_qual
--   | table_ref JOIN table_ref join_qual
--   | table_ref NATURAL join_type JOIN table_ref
--   | table_ref NATURAL JOIN table_ref
-- @
trailingJoinedTable tr1 =
  asum
    [ do
        keyphrase "cross join"
        endHead
        space1
        tr2 <- nonTrailingTableRef
        return (MethJoinedTable CrossJoinMeth tr1 tr2),
      do
        jt <- joinTypedJoin
        endHead
        space1
        tr2 <- tableRef
        space1
        jq <- joinQual
        return (MethJoinedTable (QualJoinMeth jt jq) tr1 tr2),
      do
        keyword "natural"
        endHead
        space1
        jt <- joinTypedJoin
        space1
        tr2 <- nonTrailingTableRef
        return (MethJoinedTable (NaturalJoinMeth jt) tr1 tr2)
    ]
  where
    joinTypedJoin =
      Just <$> (joinType <* endHead <* space1 <* keyword "join")
        <|> Nothing <$ keyword "join"

joinType =
  asum
    [ do
        keyword "full"
        endHead
        outer <- outerAfterSpace
        return (FullJoinType outer),
      do
        keyword "left"
        endHead
        outer <- outerAfterSpace
        return (LeftJoinType outer),
      do
        keyword "right"
        endHead
        outer <- outerAfterSpace
        return (RightJoinType outer),
      keyword "inner" $> InnerJoinType
    ]
  where
    outerAfterSpace = (space1 *> keyword "outer") $> True <|> pure False

joinQual =
  asum
    [ keyword "using" *> space1 *> inParens (sep1 commaSeparator colId) <&> UsingJoinQual,
      keyword "on" *> space1 *> aExpr <&> OnJoinQual
    ]

aliasClause = do
  (as, alias) <- (True,) <$> (keyword "as" *> space1 *> endHead *> colId) <|> (False,) <$> colId
  columnAliases <- optional (space1 *> inParens (sep1 commaSeparator colId))
  return (AliasClause as alias columnAliases)

-- * Where

whereClause = keyword "where" *> space1 *> endHead *> aExpr

whereOrCurrentClause = do
  keyword "where"
  space1
  endHead
  asum
    [ do
        keyword "current"
        space1
        keyword "of"
        space1
        endHead
        a <- cursorName
        return (CursorWhereOrCurrentClause a),
      ExprWhereOrCurrentClause <$> aExpr
    ]

-- * Sorting

sortClause = do
  keyphrase "order by"
  endHead
  space1
  a <- sep1 commaSeparator sortBy
  return a

sortBy = do
  a <- filteredAExpr ["using", "asc", "desc", "nulls"]
  asum
    [ do
        space1
        keyword "using"
        space1
        endHead
        b <- qualAllOp
        c <- optional (space1 *> nullsOrder)
        return (UsingSortBy a b c),
      do
        b <- optional (space1 *> ascDesc)
        c <- optional (space1 *> nullsOrder)
        return (AscDescSortBy a b c)
    ]

-- * Expressions

exprList = sep1 commaSeparator aExpr

exprListInParens = inParens exprList

-- |
-- Notice that the tree constructed by this parser does not reflect
-- the precedence order of Postgres.
-- For the purposes of this library it simply doesn't matter,
-- so we're not bothering with that.
--
-- ==== Composite on the right:
--
-- >>> testParser aExpr "a = b :: int4"
-- SymbolicBinOpAExpr (CExprAExpr (ColumnrefCExpr (Columnref (UnquotedIdent "a") Nothing))) (MathSymbolicExprBinOp EqualsMathOp) (TypecastAExpr (CExprAExpr (ColumnrefCExpr (Columnref (UnquotedIdent "b") Nothing))) (Typename False (GenericTypeSimpleTypename (GenericType (UnquotedIdent "int4") Nothing Nothing)) False Nothing))
--
-- ==== Composite on the left:
--
-- >>> testParser aExpr "a = b :: int4 and c"
-- SymbolicBinOpAExpr (CExprAExpr (ColumnrefCExpr (Columnref (UnquotedIdent "a") Nothing))) (MathSymbolicExprBinOp EqualsMathOp) (AndAExpr (TypecastAExpr (CExprAExpr (ColumnrefCExpr (Columnref (UnquotedIdent "b") Nothing))) (Typename False (GenericTypeSimpleTypename (GenericType (UnquotedIdent "int4") Nothing Nothing)) False Nothing)) (CExprAExpr (ColumnrefCExpr (Columnref (UnquotedIdent "c") Nothing))))
aExpr = customizedAExpr cExpr

filteredAExpr = customizedAExpr . customizedCExpr . filteredColumnref

customizedAExpr cExpr = suffixRec base suffix
  where
    aExpr = customizedAExpr cExpr
    base =
      asum
        [ DefaultAExpr <$ keyword "default",
          UniqueAExpr <$> (keyword "unique" *> space1 *> selectWithParens),
          OverlapsAExpr <$> wrapToHead row <*> (space1 *> keyword "overlaps" *> space1 *> endHead *> row),
          qualOpExpr aExpr PrefixQualOpAExpr,
          PlusAExpr <$> plusedExpr aExpr,
          MinusAExpr <$> minusedExpr aExpr,
          NotAExpr <$> (keyword "not" *> space1 *> aExpr),
          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")
        ]

bExpr = customizedBExpr cExpr

customizedBExpr cExpr = suffixRec base suffix
  where
    bExpr = customizedBExpr cExpr
    base =
      asum
        [ qualOpExpr bExpr QualOpBExpr,
          PlusBExpr <$> plusedExpr bExpr,
          MinusBExpr <$> minusedExpr bExpr,
          CExprBExpr <$> cExpr
        ]
    suffix a =
      asum
        [ typecastExpr a TypecastBExpr,
          symbolicBinOpExpr a bExpr SymbolicBinOpBExpr,
          do
            space1
            keyword "is"
            space1
            endHead
            b <- trueIfPresent (keyword "not" *> space1)
            c <-
              asum
                [ DistinctFromBExprIsOp <$> (keyphrase "distinct from" *> space1 *> endHead *> bExpr),
                  OfBExprIsOp <$> (keyword "of" *> space1 *> endHead *> inParens typeList),
                  DocumentBExprIsOp <$ keyword "document"
                ]
            return (IsOpBExpr a b c)
        ]

cExpr = customizedCExpr columnref

customizedCExpr columnref =
  asum
    [ ParamCExpr <$> (char '$' *> decimal <* endHead) <*> optional (space *> indirection),
      CaseCExpr <$> caseExpr,
      ImplicitRowCExpr <$> implicitRow,
      ExplicitRowCExpr <$> explicitRow,
      inParensWithClause (keyword "grouping") (GroupingCExpr <$> sep1 commaSeparator aExpr),
      keyword "exists" *> space *> (ExistsCExpr <$> selectWithParens),
      do
        keyword "array"
        space
        join
          $ 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
    ]

subqueryOp =
  asum
    [ AnySubqueryOp <$> (keyword "operator" *> space *> endHead *> inParens anyOperator),
      do
        a <- trueIfPresent (keyword "not" *> space1)
        LikeSubqueryOp a <$ keyword "like" <|> IlikeSubqueryOp a <$ keyword "ilike",
      AllSubqueryOp <$> allOp
    ]

subType =
  asum
    [ AnySubType <$ keyword "any",
      SomeSubType <$ keyword "some",
      AllSubType <$ keyword "all"
    ]

inExpr = SelectInExpr <$> wrapToHead selectWithParens <|> ExprListInExpr <$> inParens exprList

symbolicBinOpExpr a bParser constr = do
  binOp <- label "binary operator" (space *> wrapToHead symbolicExprBinOp <* space)
  b <- bParser
  return (constr a binOp b)

typecastExpr :: a -> (a -> Typename -> a) -> HeadedParsec Void Text a
typecastExpr prefix constr = do
  space
  string "::"
  endHead
  space
  type' <- typename
  return (constr prefix type')

plusedExpr expr = char '+' *> space *> expr

minusedExpr expr = char '-' *> space *> expr

qualOpExpr expr constr = constr <$> wrapToHead qualOp <*> (space *> expr)

row = ExplicitRowRow <$> explicitRow <|> ImplicitRowRow <$> implicitRow

explicitRow = keyword "row" *> space *> inParens (optional exprList)

implicitRow = inParens $ do
  a <- wrapToHead aExpr
  commaSeparator
  b <- exprList
  return $ case NonEmpty.consAndUnsnoc a b of
    (c, d) -> ImplicitRow c d

arrayExprCont =
  inBracketsCont
    $ asum
      [ ArrayExprListArrayExpr <$> sep1 commaSeparator (join arrayExprCont),
        ExprListArrayExpr <$> exprList,
        pure EmptyArrayExpr
      ]

caseExpr = label "case expression" $ do
  keyword "case"
  space1
  endHead
  arg <- optional (aExpr <* space1)
  whenClauses <- sep1 space1 whenClause
  space1
  default' <- optional elseClause
  keyword "end"
  pure $ CaseExpr arg whenClauses default'

whenClause = do
  keyword "when"
  space1
  endHead
  a <- aExpr
  space1
  keyword "then"
  space1
  b <- aExpr
  return (WhenClause a b)

elseClause = do
  keyword "else"
  space1
  endHead
  a <- aExpr
  space1
  return a

funcExpr =
  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)
    ]

funcExprWindowless =
  asum
    [ CommonSubexprFuncExprWindowless <$> funcExprCommonSubexpr,
      ApplicationFuncExprWindowless <$> funcApplication
    ]

withinGroupClause = do
  keyphrase "within group"
  endHead
  space
  inParens sortClause

filterClause = do
  keyword "filter"
  endHead
  space
  inParens (keyword "where" *> space1 *> aExpr)

overClause = do
  keyword "over"
  space1
  endHead
  asum
    [ WindowOverClause <$> windowSpecification,
      ColIdOverClause <$> colId
    ]

funcExprCommonSubexpr =
  asum
    [ CollationForFuncExprCommonSubexpr <$> (inParensWithClause (keyphrase "collation for") aExpr),
      CurrentDateFuncExprCommonSubexpr <$ keyword "current_date",
      CurrentTimestampFuncExprCommonSubexpr <$> labeledIconst "current_timestamp",
      CurrentTimeFuncExprCommonSubexpr <$> labeledIconst "current_time",
      LocalTimestampFuncExprCommonSubexpr <$> labeledIconst "localtimestamp",
      LocalTimeFuncExprCommonSubexpr <$> labeledIconst "localtime",
      CurrentRoleFuncExprCommonSubexpr <$ keyword "current_role",
      CurrentUserFuncExprCommonSubexpr <$ keyword "current_user",
      SessionUserFuncExprCommonSubexpr <$ keyword "session_user",
      UserFuncExprCommonSubexpr <$ keyword "user",
      CurrentCatalogFuncExprCommonSubexpr <$ keyword "current_catalog",
      CurrentSchemaFuncExprCommonSubexpr <$ keyword "current_schema",
      inParensWithClause (keyword "cast") (CastFuncExprCommonSubexpr <$> aExpr <*> (space1 *> keyword "as" *> space1 *> typename)),
      inParensWithClause (keyword "extract") (ExtractFuncExprCommonSubexpr <$> optional extractList),
      inParensWithClause (keyword "overlay") (OverlayFuncExprCommonSubexpr <$> overlayList),
      inParensWithClause (keyword "position") (PositionFuncExprCommonSubexpr <$> optional positionList),
      inParensWithClause (keyword "substring") (SubstringFuncExprCommonSubexpr <$> optional substrList),
      inParensWithClause (keyword "treat") (TreatFuncExprCommonSubexpr <$> aExpr <*> (space1 *> keyword "as" *> space1 *> typename)),
      inParensWithClause (keyword "trim") (TrimFuncExprCommonSubexpr <$> optional (trimModifier <* space1) <*> trimList),
      inParensWithClause (keyword "nullif") (NullIfFuncExprCommonSubexpr <$> aExpr <*> (commaSeparator *> aExpr)),
      inParensWithClause (keyword "coalesce") (CoalesceFuncExprCommonSubexpr <$> exprList),
      inParensWithClause (keyword "greatest") (GreatestFuncExprCommonSubexpr <$> exprList),
      inParensWithClause (keyword "least") (LeastFuncExprCommonSubexpr <$> exprList)
    ]
  where
    labeledIconst label = keyword label *> endHead *> optional (space *> inParens iconst)

extractList = ExtractList <$> extractArg <*> (space1 *> keyword "from" *> space1 *> aExpr)

extractArg =
  asum
    [ YearExtractArg <$ keyword "year",
      MonthExtractArg <$ keyword "month",
      DayExtractArg <$ keyword "day",
      HourExtractArg <$ keyword "hour",
      MinuteExtractArg <$ keyword "minute",
      SecondExtractArg <$ keyword "second",
      SconstExtractArg <$> sconst,
      IdentExtractArg <$> ident
    ]

overlayList = do
  a <- aExpr
  space1
  b <- overlayPlacing
  space1
  c <- substrFrom
  d <- optional (space1 *> substrFor)
  return (OverlayList a b c d)

overlayPlacing = keyword "placing" *> space1 *> endHead *> aExpr

positionList = PositionList <$> bExpr <*> (space1 *> keyword "in" *> space1 *> bExpr)

substrList =
  asum
    [ ExprSubstrList <$> wrapToHead aExpr <*> (space1 *> substrListFromFor),
      ExprListSubstrList <$> exprList
    ]

substrListFromFor =
  asum
    [ do
        a <- substrFrom
        asum
          [ do
              b <- space1 *> substrFor
              return (FromForSubstrListFromFor a b),
            return (FromSubstrListFromFor a)
          ],
      do
        a <- substrFor
        asum
          [ do
              b <- space1 *> substrFrom
              return (ForFromSubstrListFromFor a b),
            return (ForSubstrListFromFor a)
          ]
    ]

substrFrom = keyword "from" *> space1 *> endHead *> aExpr

substrFor = keyword "for" *> space1 *> endHead *> aExpr

trimModifier =
  BothTrimModifier <$ keyword "both"
    <|> LeadingTrimModifier <$ keyword "leading"
    <|> TrailingTrimModifier <$ keyword "trailing"

trimList =
  asum
    [ ExprFromExprListTrimList <$> wrapToHead aExpr <*> (space1 *> keyword "from" *> space1 *> endHead *> exprList),
      FromExprListTrimList <$> (keyword "from" *> space1 *> endHead *> exprList),
      ExprListTrimList <$> exprList
    ]

funcApplication = inParensWithLabel FuncApplication funcName (optional funcApplicationParams)

funcApplicationParams =
  asum
    [ starFuncApplicationParams,
      listVariadicFuncApplicationParams,
      singleVariadicFuncApplicationParams,
      normalFuncApplicationParams
    ]

normalFuncApplicationParams = do
  optAllOrDistinct <- optional (allOrDistinct <* space1)
  argList <- sep1 commaSeparator funcArgExpr
  endHead
  optSortClause <- optional (space1 *> sortClause)
  return (NormalFuncApplicationParams optAllOrDistinct argList optSortClause)

singleVariadicFuncApplicationParams = do
  keyword "variadic"
  space1
  endHead
  arg <- funcArgExpr
  optSortClause <- optional (space1 *> sortClause)
  return (VariadicFuncApplicationParams Nothing arg optSortClause)

listVariadicFuncApplicationParams = do
  (argList, _) <- wrapToHead $ sepEnd1 commaSeparator (keyword "variadic" <* space1) funcArgExpr
  endHead
  arg <- funcArgExpr
  optSortClause <- optional (space1 *> sortClause)
  return (VariadicFuncApplicationParams (Just argList) arg optSortClause)

starFuncApplicationParams = space *> char '*' *> endHead *> space $> StarFuncApplicationParams

-- |
-- ==== References
-- @
-- func_arg_expr:
--   | a_expr
--   | param_name COLON_EQUALS a_expr
--   | param_name EQUALS_GREATER a_expr
-- param_name:
--   | type_function_name
-- @
funcArgExpr =
  asum
    [ do
        a <- wrapToHead typeFunctionName
        space
        asum
          [ do
              string ":="
              endHead
              b <- space *> aExpr
              return (ColonEqualsFuncArgExpr a b),
            do
              string "=>"
              endHead
              b <- space *> aExpr
              return (EqualsGreaterFuncArgExpr a b)
          ],
      ExprFuncArgExpr <$> aExpr
    ]

-- * Ops

symbolicExprBinOp =
  QualSymbolicExprBinOp <$> qualOp
    <|> MathSymbolicExprBinOp <$> mathOp

lexicalExprBinOp = asum $ fmap keyphrase $ ["and", "or", "is distinct from", "is not distinct from"]

qualOp =
  asum
    [ OpQualOp <$> op,
      OperatorQualOp <$> inParensWithClause (keyword "operator") anyOperator
    ]

qualAllOp =
  asum
    [ AnyQualAllOp <$> (keyword "operator" *> space *> inParens (endHead *> anyOperator)),
      AllQualAllOp <$> allOp
    ]

op = do
  a <- takeWhile1P Nothing Predicate.opChar
  case Validation.op a of
    Nothing -> return a
    Just err -> fail (Text.unpack err)

anyOperator =
  asum
    [ AllOpAnyOperator <$> allOp,
      QualifiedAnyOperator <$> colId <*> (space *> char '.' *> space *> anyOperator)
    ]

allOp =
  asum
    [ OpAllOp <$> op,
      MathAllOp <$> mathOp
    ]

mathOp =
  asum
    [ ArrowLeftArrowRightMathOp <$ string' "<>",
      GreaterEqualsMathOp <$ string' ">=",
      ExclamationEqualsMathOp <$ string' "!=",
      LessEqualsMathOp <$ string' "<=",
      PlusMathOp <$ char '+',
      MinusMathOp <$ char '-',
      AsteriskMathOp <$ char '*',
      SlashMathOp <$ char '/',
      PercentMathOp <$ char '%',
      ArrowUpMathOp <$ char '^',
      ArrowLeftMathOp <$ char '<',
      ArrowRightMathOp <$ char '>',
      EqualsMathOp <$ char '='
    ]

-- * Constants

-- |
-- >>> testParser aexprConst "32948023849023"
-- IAexprConst 32948023849023
--
-- >>> testParser aexprConst "'abc''de'"
-- SAexprConst "abc'de"
--
-- >>> testParser aexprConst "23.43234"
-- FAexprConst 23.43234
--
-- >>> testParser aexprConst "32423423.324324872"
-- FAexprConst 3.2423423324324872e7
--
-- >>> testParser aexprConst "NULL"
-- NullAexprConst
--
-- ==== References
-- @
-- AexprConst: Iconst
--       | FCONST
--       | Sconst
--       | BCONST
--       | XCONST
--       | func_name Sconst
--       | func_name '(' func_arg_list opt_sort_clause ')' Sconst
--       | ConstTypename Sconst
--       | ConstInterval Sconst opt_interval
--       | ConstInterval '(' Iconst ')' Sconst
--       | TRUE_P
--       | FALSE_P
--       | NULL_P
-- @
aexprConst =
  asum
    [ do
        keyword "interval"
        space1
        endHead
        a <-
          asum
            [ do
                a <- sconst
                endHead
                b <- optional (space1 *> interval)
                return (StringIntervalAexprConst a b),
              do
                a <- inParens iconst
                space1
                endHead
                b <- sconst
                return (IntIntervalAexprConst a b)
            ]
        return a,
      do
        a <- constTypename
        space1
        endHead
        b <- sconst
        return (ConstTypenameAexprConst a b),
      BoolAexprConst True <$ keyword "true",
      BoolAexprConst False <$ keyword "false",
      NullAexprConst <$ keyword "null" <* parse (Megaparsec.notFollowedBy MegaparsecChar.alphaNumChar),
      either IAexprConst FAexprConst <$> iconstOrFconst,
      SAexprConst <$> sconst,
      label "bit literal" $ do
        string' "b'"
        endHead
        a <- takeWhile1P (Just "0 or 1") (\b -> b == '0' || b == '1')
        char '\''
        return (BAexprConst a),
      label "hex literal" $ do
        string' "x'"
        endHead
        a <- takeWhile1P (Just "Hex digit") Predicate.hexDigit
        char '\''
        return (XAexprConst a),
      wrapToHead $ do
        a <- funcName
        space
        char '('
        space
        b <- sep1 commaSeparator funcArgExpr
        c <- optional (space1 *> sortClause)
        space
        char ')'
        space1
        d <- sconst
        return (FuncAexprConst a (Just (FuncConstArgs b c)) d),
      FuncAexprConst <$> (wrapToHead funcName <* space1) <*> pure Nothing <*> sconst
    ]

iconstOrFconst = Right <$> fconst <|> Left <$> iconst

iconst = decimal

fconst = float

sconst = quotedString '\''

constTypename =
  asum
    [ NumericConstTypename <$> numeric,
      ConstBitConstTypename <$> constBit,
      ConstCharacterConstTypename <$> constCharacter,
      ConstDatetimeConstTypename <$> constDatetime
    ]

numeric =
  asum
    [ IntegerNumeric <$ keyword "integer",
      IntNumeric <$ keyword "int",
      SmallintNumeric <$ keyword "smallint",
      BigintNumeric <$ keyword "bigint",
      RealNumeric <$ keyword "real",
      FloatNumeric <$> (keyword "float" *> endHead *> optional (space *> inParens iconst)),
      DoublePrecisionNumeric <$ keyphrase "double precision",
      DecimalNumeric <$> (keyword "decimal" *> endHead *> optional (space *> exprListInParens)),
      DecNumeric <$> (keyword "dec" *> endHead *> optional (space *> exprListInParens)),
      NumericNumeric <$> (keyword "numeric" *> endHead *> optional (space *> exprListInParens)),
      BooleanNumeric <$ keyword "boolean"
    ]

bit = do
  keyword "bit"
  a <- option False (True <$ space1 <* keyword "varying")
  b <- optional (space1 *> exprListInParens)
  return (Bit a b)

constBit = bit

constCharacter = ConstCharacter <$> (character <* endHead) <*> optional (space *> inParens iconst)

character =
  asum
    [ CharacterCharacter <$> (keyword "character" *> optVaryingAfterSpace),
      CharCharacter <$> (keyword "char" *> optVaryingAfterSpace),
      VarcharCharacter <$ keyword "varchar",
      NationalCharacterCharacter <$> (keyphrase "national character" *> optVaryingAfterSpace),
      NationalCharCharacter <$> (keyphrase "national char" *> optVaryingAfterSpace),
      NcharCharacter <$> (keyword "nchar" *> optVaryingAfterSpace)
    ]
  where
    optVaryingAfterSpace = True <$ space1 <* keyword "varying" <|> pure False

-- |
-- ==== References
-- @
-- ConstDatetime:
--   | TIMESTAMP '(' Iconst ')' opt_timezone
--   | TIMESTAMP opt_timezone
--   | TIME '(' Iconst ')' opt_timezone
--   | TIME opt_timezone
-- @
constDatetime =
  asum
    [ do
        keyword "timestamp"
        a <- optional (space1 *> inParens iconst)
        b <- optional (space1 *> timezone)
        return (TimestampConstDatetime a b),
      do
        keyword "time"
        a <- optional (space1 *> inParens iconst)
        b <- optional (space1 *> timezone)
        return (TimeConstDatetime a b)
    ]

timezone =
  asum
    [ False <$ keyphrase "with time zone",
      True <$ keyphrase "without time zone"
    ]

interval =
  asum
    [ YearToMonthInterval <$ keyphrase "year to month",
      DayToHourInterval <$ keyphrase "day to hour",
      DayToMinuteInterval <$ keyphrase "day to minute",
      DayToSecondInterval <$> (keyphrase "day to" *> space1 *> endHead *> intervalSecond),
      HourToMinuteInterval <$ keyphrase "hour to minute",
      HourToSecondInterval <$> (keyphrase "hour to" *> space1 *> endHead *> intervalSecond),
      MinuteToSecondInterval <$> (keyphrase "minute to" *> space1 *> endHead *> intervalSecond),
      YearInterval <$ keyword "year",
      MonthInterval <$ keyword "month",
      DayInterval <$ keyword "day",
      HourInterval <$ keyword "hour",
      MinuteInterval <$ keyword "minute",
      SecondInterval <$> intervalSecond
    ]

intervalSecond = do
  keyword "second"
  a <- optional (space *> inParens iconst)
  return a

-- * Clauses

-- |
-- ==== References
-- @
-- select_limit:
--   | limit_clause offset_clause
--   | offset_clause limit_clause
--   | limit_clause
--   | offset_clause
-- @
selectLimit =
  asum
    [ do
        a <- limitClause
        LimitOffsetSelectLimit a <$> (space1 *> offsetClause) <|> pure (LimitSelectLimit a),
      do
        a <- offsetClause
        OffsetLimitSelectLimit a <$> (space1 *> limitClause) <|> pure (OffsetSelectLimit a)
    ]

-- |
-- ==== References
-- @
-- limit_clause:
--   | LIMIT select_limit_value
--   | LIMIT select_limit_value ',' select_offset_value
--   | FETCH first_or_next select_fetch_first_value row_or_rows ONLY
--   | FETCH first_or_next row_or_rows ONLY
-- @
limitClause =
  ( do
      keyword "limit"
      endHead
      space1
      a <- selectLimitValue
      b <- optional $ do
        commaSeparator
        aExpr
      return (LimitLimitClause a b)
  )
    <|> ( do
            keyword "fetch"
            endHead
            space1
            a <- firstOrNext
            space1
            asum
              [ do
                  b <- rowOrRows
                  space1
                  keyword "only"
                  return (FetchOnlyLimitClause a Nothing b),
                do
                  b <- selectFetchFirstValue
                  space1
                  c <- rowOrRows
                  space1
                  keyword "only"
                  return (FetchOnlyLimitClause a (Just b) c)
              ]
        )

offsetClause = do
  keyword "offset"
  endHead
  space1
  offsetClauseParams

offsetClauseParams =
  FetchFirstOffsetClause <$> wrapToHead selectFetchFirstValue <*> (space1 *> rowOrRows)
    <|> ExprOffsetClause <$> aExpr

-- |
-- ==== References
-- @
-- select_limit_value:
--   | a_expr
--   | ALL
-- @
selectLimitValue =
  AllSelectLimitValue <$ keyword "all"
    <|> ExprSelectLimitValue <$> aExpr

rowOrRows =
  True <$ keyword "rows"
    <|> False <$ keyword "row"

firstOrNext =
  False <$ keyword "first"
    <|> True <$ keyword "next"

selectFetchFirstValue =
  ExprSelectFetchFirstValue <$> cExpr
    <|> NumSelectFetchFirstValue <$> (plusOrMinus <* endHead <* space) <*> iconstOrFconst

plusOrMinus = False <$ char '+' <|> True <$ char '-'

-- * For Locking

-- |
-- ==== References
-- @
-- for_locking_clause:
--   | for_locking_items
--   | FOR READ ONLY
-- for_locking_items:
--   | for_locking_item
--   | for_locking_items for_locking_item
-- @
forLockingClause = readOnly <|> items
  where
    readOnly = ReadOnlyForLockingClause <$ keyphrase "for read only"
    items = ItemsForLockingClause <$> sep1 space1 forLockingItem

-- |
-- ==== References
-- @
-- for_locking_item:
--   | for_locking_strength locked_rels_list opt_nowait_or_skip
-- locked_rels_list:
--   | OF qualified_name_list
--   | EMPTY
-- opt_nowait_or_skip:
--   | NOWAIT
--   | SKIP LOCKED
--   | EMPTY
-- @
forLockingItem = do
  strength <- forLockingStrength
  rels <- optional $ space1 *> keyword "of" *> space1 *> endHead *> sep1 commaSeparator qualifiedName
  nowaitOrSkip <- optional (space1 *> nowaitOrSkip)
  return (ForLockingItem strength rels nowaitOrSkip)

-- |
-- ==== References
-- @
-- for_locking_strength:
--   | FOR UPDATE
--   | FOR NO KEY UPDATE
--   | FOR SHARE
--   | FOR KEY SHARE
-- @
forLockingStrength =
  UpdateForLockingStrength <$ keyphrase "for update"
    <|> NoKeyUpdateForLockingStrength <$ keyphrase "for no key update"
    <|> ShareForLockingStrength <$ keyphrase "for share"
    <|> KeyForLockingStrength <$ keyphrase "for key share"

nowaitOrSkip = False <$ keyword "nowait" <|> True <$ keyphrase "skip locked"

-- * References & Names

quotedName = filter (const "Empty name") (not . Text.null) (quotedString '"') & fmap QuotedIdent

-- |
-- ==== References
-- @
-- ident_start   [A-Za-z\200-\377_]
-- ident_cont    [A-Za-z\200-\377_0-9\$]
-- identifier    {ident_start}{ident_cont}*
-- @
ident = quotedName <|> keywordNameByPredicate (not . Predicate.keyword)

-- |
-- ==== References
-- @
-- ColId:
--   |  IDENT
--   |  unreserved_keyword
--   |  col_name_keyword
-- @
{-# NOINLINE colId #-}
colId =
  label "identifier"
    $ ident
    <|> keywordNameFromSet (KeywordSet.unreservedKeyword <> KeywordSet.colNameKeyword)

{-# NOINLINE filteredColId #-}
filteredColId =
  let originalSet = KeywordSet.unreservedKeyword <> KeywordSet.colNameKeyword
      filteredSet = foldr HashSet.delete originalSet
   in \reservedKeywords -> label "identifier" $ ident <|> keywordNameFromSet (filteredSet reservedKeywords)

-- |
-- ==== References
-- @
-- ColLabel:
--   |  IDENT
--   |  unreserved_keyword
--   |  col_name_keyword
--   |  type_func_name_keyword
--   |  reserved_keyword
-- @
colLabel =
  label "column label"
    $ keywordNameFromSet KeywordSet.keyword
    <|> ident

-- |
-- >>> testParser qualifiedName "a.b"
-- IndirectedQualifiedName (UnquotedIdent "a") (AttrNameIndirectionEl (UnquotedIdent "b") :| [])
--
-- >>> testParser qualifiedName "a.-"
-- ...
-- expecting '*', column label, or white space
--
-- ==== References
-- @
-- qualified_name:
--   | ColId
--   | ColId indirection
-- @
qualifiedName =
  IndirectedQualifiedName <$> wrapToHead colId <*> (space *> indirection)
    <|> SimpleQualifiedName <$> colId

columnref = customizedColumnref colId

filteredColumnref keywords = customizedColumnref (filteredColId keywords)

customizedColumnref colId = do
  a <- wrapToHead colId
  endHead
  b <- optional (space *> indirection)
  return (Columnref a b)

anyName = customizedAnyName colId

filteredAnyName keywords = customizedAnyName (filteredColId keywords)

customizedAnyName colId = do
  a <- wrapToHead colId
  endHead
  b <- optional (space *> attrs)
  return (AnyName a b)

name = colId

nameList = sep1 commaSeparator name

cursorName = name

-- |
-- ==== References
-- @
-- func_name:
--   | type_function_name
--   | ColId indirection
-- @
funcName =
  IndirectedFuncName <$> wrapToHead colId <*> (space *> indirection)
    <|> TypeFuncName <$> typeFunctionName

-- |
-- ==== References
-- @
-- type_function_name:
--   | IDENT
--   | unreserved_keyword
--   | type_func_name_keyword
-- @
typeFunctionName =
  keywordNameFromSet KeywordSet.typeFunctionName
    <|> ident

-- |
-- ==== References
-- @
-- indirection:
--   | indirection_el
--   | indirection indirection_el
-- @
indirection = some indirectionEl

-- |
-- ==== References
-- @
-- indirection_el:
--   | '.' attr_name
--   | '.' '*'
--   | '[' a_expr ']'
--   | '[' opt_slice_bound ':' opt_slice_bound ']'
-- opt_slice_bound:
--   | a_expr
--   | EMPTY
-- @
indirectionEl =
  asum
    [ do
        char '.'
        endHead
        space
        AllIndirectionEl <$ char '*' <|> AttrNameIndirectionEl <$> attrName,
      do
        char '['
        endHead
        space
        a <-
          asum
            [ do
                char ':'
                endHead
                space
                b <- optional aExpr
                return (SliceIndirectionEl Nothing b),
              do
                a <- aExpr
                asum
                  [ do
                      space
                      char ':'
                      space
                      b <- optional aExpr
                      return (SliceIndirectionEl (Just a) b),
                    return (ExprIndirectionEl a)
                  ]
            ]
        space
        char ']'
        return a
    ]

-- |
-- ==== References
-- @
-- attr_name:
--   | ColLabel
-- @
attrName = colLabel

keywordNameFromSet set = keywordNameByPredicate (Predicate.inSet set)

keywordNameByPredicate predicate =
  fmap UnquotedIdent
    $ filter
      (\a -> "Reserved keyword " <> show a <> " used as an identifier. If that's what you intend, you have to wrap it in double quotes.")
      predicate
      anyKeyword

anyKeyword = parse
  $ Megaparsec.label "keyword"
  $ do
    firstChar <- Megaparsec.satisfy Predicate.firstIdentifierChar
    remainder <- Megaparsec.takeWhileP Nothing Predicate.notFirstIdentifierChar
    return (Text.toLower (Text.cons firstChar remainder))

-- | Expected keyword
keyword a = mfilter (a ==) anyKeyword

-- |
-- Consume a keyphrase, ignoring case and types of spaces between words.
keyphrase a =
  Text.words a
    & fmap (void . MegaparsecChar.string')
    & intersperse MegaparsecChar.space1
    & sequence_
    & (<* Megaparsec.notFollowedBy (Megaparsec.satisfy Predicate.notFirstIdentifierChar))
    & fmap (const (Text.toUpper a))
    & Megaparsec.label (show a)
    & parse
    & (<* endHead)

-- * Typename

typeList = sep1 commaSeparator typename

typename =
  do
    a <- option False (keyword "setof" *> space1 $> True)
    b <- simpleTypename
    endHead
    c <- trueIfPresent (space *> char '?')
    asum
      [ do
          space1
          keyword "array"
          endHead
          d <- optional (space *> inBrackets iconst)
          e <- trueIfPresent (space *> char '?')
          return (Typename a b c (Just (ExplicitTypenameArrayDimensions d, e))),
        do
          space
          d <- arrayBounds
          endHead
          e <- trueIfPresent (space *> char '?')
          return (Typename a b c (Just (BoundsTypenameArrayDimensions d, e))),
        return (Typename a b c Nothing)
      ]

arrayBounds = sep1 space (inBrackets (optional iconst))

simpleTypename =
  asum
    $ [ do
          keyword "interval"
          endHead
          asum
            [ ConstIntervalSimpleTypename <$> Right <$> (space *> inParens iconst),
              ConstIntervalSimpleTypename <$> Left <$> optional (space *> interval)
            ],
        ConstDatetimeSimpleTypename <$> constDatetime,
        NumericSimpleTypename <$> numeric,
        BitSimpleTypename <$> bit,
        CharacterSimpleTypename <$> character,
        GenericTypeSimpleTypename <$> genericType
      ]

genericType = do
  a <- typeFunctionName
  endHead
  b <- optional (space *> attrs)
  c <- optional (space1 *> typeModifiers)
  return (GenericType a b c)

attrs = some (char '.' *> endHead *> space *> attrName)

typeModifiers = inParens exprList

-- * Indexes

indexParams = sep1 commaSeparator indexElem

indexElem =
  IndexElem
    <$> (indexElemDef <* endHead)
    <*> optional (space1 *> collate)
    <*> optional (space1 *> class_)
    <*> optional (space1 *> ascDesc)
    <*> optional (space1 *> nullsOrder)

indexElemDef =
  ExprIndexElemDef <$> inParens aExpr
    <|> FuncIndexElemDef <$> funcExprWindowless
    <|> IdIndexElemDef <$> colId

collate = keyword "collate" *> space1 *> endHead *> anyName

class_ = filteredAnyName ["asc", "desc", "nulls"]

ascDesc = keyword "asc" $> AscAscDesc <|> keyword "desc" $> DescAscDesc

nullsOrder = keyword "nulls" *> space1 *> endHead *> (FirstNullsOrder <$ keyword "first" <|> LastNullsOrder <$ keyword "last")