-- |
--
-- 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.List.NonEmpty as NonEmpty
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 Text.Megaparsec (Parsec, Stream)
import qualified Text.Megaparsec as Megaparsec
import qualified Text.Megaparsec.Char as MegaparsecChar
import qualified Text.Megaparsec.Char.Lexer as MegaparsecLexer

-- $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
    aExpr = customizedAExpr cExpr
    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")