{-|
Module: IHP.IDE.SchemaDesigner.Types
Description: Parser for Application/Schema.sql
Copyright: (c) digitally induced GmbH, 2020
-}
module IHP.IDE.SchemaDesigner.Parser
( parseSchemaSql
, parseSqlFile
, schemaFilePath
, parseDDL
, expression
, sqlType
, removeTypeCasts
, parseIndexColumns
) where

import IHP.Prelude
import IHP.IDE.SchemaDesigner.Types
import qualified Prelude
import qualified Data.Text.IO as Text
import Text.Megaparsec
import Data.Void
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as Lexer
import Data.Char
import Control.Monad.Combinators.Expr
import Data.Functor

schemaFilePath = "Application/Schema.sql"

parseSchemaSql :: IO (Either ByteString [Statement])
parseSchemaSql = parseSqlFile schemaFilePath

parseSqlFile :: FilePath -> IO (Either ByteString [Statement])
parseSqlFile schemaFilePath = do
    schemaSql <- Text.readFile schemaFilePath
    let result = runParser parseDDL (cs schemaFilePath) schemaSql
    case result of
        Left error -> pure (Left (cs $ errorBundlePretty error))
        Right r -> pure (Right r)

type Parser = Parsec Void Text

spaceConsumer :: Parser ()
spaceConsumer = Lexer.space
    space1
    (Lexer.skipLineComment "//")
    (Lexer.skipBlockComment "/*" "*/")

lexeme :: Parser a -> Parser a
lexeme = Lexer.lexeme spaceConsumer

symbol :: Text -> Parser Text
symbol = Lexer.symbol spaceConsumer

symbol' :: Text -> Parser Text
symbol' = Lexer.symbol' spaceConsumer

stringLiteral :: Parser String
stringLiteral = char '\'' *> manyTill Lexer.charLiteral (char '\'')

parseDDL :: Parser [Statement]
parseDDL = optional space >> (manyTill statement eof)

statement = do
    space
    let create = try createExtension <|> try (StatementCreateTable <$> createTable) <|> try createIndex <|> try createFunction <|> try createTrigger <|> try createEnumType <|> try createPolicy <|> try createSequence
    let alter = do
            lexeme "ALTER"
            alterTable <|> alterType <|> alterSequence
    s <- setStatement <|> create <|> alter <|> selectStatement <|> try dropTable <|> try dropIndex <|> try dropPolicy <|> try dropFunction <|> try dropType <|> dropTrigger <|> commentStatement <|> comment <|> begin <|> commit <|> restrict <|> unrestrict
    space
    pure s


createExtension = do
    lexeme "CREATE"
    lexeme "EXTENSION"
    ifNotExists <- isJust <$> optional (lexeme "IF" >> lexeme "NOT" >> lexeme "EXISTS")
    name <- qualifiedIdentifier
    optional do
        space
        lexeme "WITH"
        lexeme "SCHEMA"
        lexeme "public"
    char ';'
    pure CreateExtension { name, ifNotExists = True }

createTable = do
    lexeme "CREATE"
    unlogged <- isJust <$> optional (lexeme "UNLOGGED")
    lexeme "TABLE"
    name <- qualifiedIdentifier

    -- Process columns (tagged if they're primary key) and table constraints
    -- together, as they can be in any order
    (taggedColumns, allConstraints) <- between (char '(' >> space) (char ')' >> space) do
        columnsAndConstraints <- ((Right <$> parseTableConstraint) <|> (Left <$> parseColumn)) `sepBy` (char ',' >> space)
        pure (lefts columnsAndConstraints, rights columnsAndConstraints)

    char ';'

    -- Check that either there is a single column with a PRIMARY KEY constraint,
    -- or there is a single PRIMARY KEY table constraint
    let
        columns = map snd taggedColumns
        constraints = rights allConstraints

    primaryKeyConstraint <- case filter fst taggedColumns of
        [] -> case lefts allConstraints of
            [] -> pure $ PrimaryKeyConstraint []
            [primaryKeyConstraint] -> pure primaryKeyConstraint
            _ -> Prelude.fail ("Multiple PRIMARY KEY constraints on table " <> cs name)
        [(_, Column { name })] -> case lefts allConstraints of
            [] -> pure $ PrimaryKeyConstraint [name]
            _ -> Prelude.fail ("Primary key defined in both column and table constraints on table " <> cs name)
        _ -> Prelude.fail "Multiple columns with PRIMARY KEY constraint"

    pure CreateTable { name, columns, primaryKeyConstraint, constraints, unlogged }

createEnumType = do
    lexeme "CREATE"
    lexeme "TYPE"
    optional do
        lexeme "public"
        char '.'
    name <- identifier
    lexeme "AS"
    lexeme "ENUM"
    values <- between (char '(' >> space) (space >> char ')' >> space) (textExpr' `sepBy` (char ',' >> space))
    space
    char ';'
    pure CreateEnumType { name, values }

addConstraint tableName = do
    constraint <- parseTableConstraint >>= \case
      Left primaryKeyConstraint -> pure AlterTableAddPrimaryKey { name = Nothing, primaryKeyConstraint }
      Right constraint -> pure constraint
    deferrable <- optional parseDeferrable
    deferrableType <- optional parseDeferrableType
    char ';'
    pure AddConstraint { tableName, constraint, deferrable, deferrableType }

parseDeferrable = do
    isDeferrable <- lexeme "DEFERRABLE" <|> lexeme "NOT DEFERRABLE"
    pure $ case isDeferrable of
        "DEFERRABLE" -> True
        "NOT DEFERRABLE" -> False

parseDeferrableType = do
    lexeme "INITIALLY"
    dtype <- lexeme "IMMEDIATE" <|> lexeme "DEFERRED"
    case dtype of
        "IMMEDIATE" -> pure InitiallyImmediate
        "DEFERRED" -> pure InitiallyDeferred

parseTableConstraint = do
    name <- optional do
        lexeme "CONSTRAINT"
        identifier
    (Left <$> parsePrimaryKeyConstraint) <|>
      (Right <$> (parseForeignKeyConstraint name <|> parseUniqueConstraint name <|> parseCheckConstraint name <|> parseExcludeConstraint name))

parsePrimaryKeyConstraint = do
    lexeme "PRIMARY"
    lexeme "KEY"
    primaryKeyColumnNames <- between (char '(' >> space) (char ')' >> space) (identifier `sepBy1` (char ',' >> space))
    pure PrimaryKeyConstraint { primaryKeyColumnNames }

parseForeignKeyConstraint name = do
    lexeme "FOREIGN"
    lexeme "KEY"
    columnName <- between (char '(' >> space) (char ')' >> space) identifier
    lexeme "REFERENCES"
    referenceTable <- qualifiedIdentifier
    referenceColumn <- optional $ between (char '(' >> space) (char ')' >> space) identifier
    onDelete <- optional do
        lexeme "ON"
        lexeme "DELETE"
        parseOnDelete
    pure ForeignKeyConstraint { name, columnName, referenceTable, referenceColumn, onDelete }

parseUniqueConstraint name = do
    lexeme "UNIQUE"
    columnNames <- between (char '(' >> space) (char ')' >> space) (identifier `sepBy1` (char ',' >> space))
    pure UniqueConstraint { name, columnNames }

parseCheckConstraint name = do
    lexeme "CHECK"
    checkExpression <- between (char '(' >> space) (char ')' >> space) expression
    pure CheckConstraint { name, checkExpression }

parseExcludeConstraint name = do
    lexeme "EXCLUDE"
    indexType <- optional parseIndexType
    excludeElements <- between (char '(' >> space) (char ')' >> space) $ excludeElement `sepBy` (char ',' >> space)
    predicate <- optional do
        lexeme "WHERE"
        between (char '(' >> space) (char ')' >> space) expression
    pure ExcludeConstraint { name, excludeElements, predicate, indexType }
    where
        excludeElement = do
            element <- identifier
            space
            lexeme "WITH"
            space
            operator <- parseCommutativeInfixOperator
            pure ExcludeConstraintElement { element, operator }

        parseCommutativeInfixOperator = choice $ map lexeme
            [ "="
            , "<>"
            , "!="
            , "AND"
            , "OR"
            ]

parseOnDelete = choice
        [ (lexeme "NO" >> lexeme "ACTION") >> pure NoAction
        , (lexeme "RESTRICT" >> pure Restrict)
        , (lexeme "SET" >> ((lexeme "NULL" >> pure SetNull) <|> (lexeme "DEFAULT" >> pure SetDefault)))
        , (lexeme "CASCADE" >> pure Cascade)
        ]

parseColumn :: Parser (Bool, Column)
parseColumn = do
    name <- identifier
    columnType <- sqlType
    space
    defaultValue <- optional do
        lexeme "DEFAULT"
        expression
    generator <- optional do
        lexeme "GENERATED"
        lexeme "ALWAYS"
        lexeme "AS"
        generate <- expression
        stored <- isJust <$> optional (lexeme "STORED")
        pure ColumnGenerator { generate, stored }
    primaryKey <- isJust <$> optional (lexeme "PRIMARY" >> lexeme "KEY")
    notNull <- isJust <$> optional (lexeme "NOT" >> lexeme "NULL")
    isUnique <- isJust <$> optional (lexeme "UNIQUE")
    pure (primaryKey, Column { name, columnType, defaultValue, notNull, isUnique, generator })

sqlType :: Parser PostgresType
sqlType = choice $ map optionalArray
        [ uuid
        , text
        , interval --Needs higher precedence otherwise parsed as int
        , bigint
        , smallint
        , int   -- order int after smallint/bigint because symbol INT is prefix of INT2, INT8
        , bool
        , timestamp
        , timestampZ
        , timestampZ'
        , timestamp'
        , real
        , double
        , point
        , polygon
        , date
        , binary
        , time
        , numericPS
        , numeric
        , character
        , varchar
        , serial
        , bigserial
        , jsonb
        , inet
        , tsvector
        , trigger
        , eventTrigger
        , singleChar
        , customType
        ]
            where
                timestamp = do
                    try (symbol' "TIMESTAMP" >> symbol' "WITHOUT" >> symbol' "TIME" >> symbol' "ZONE")
                    pure PTimestamp

                timestampZ = do
                    try (symbol' "TIMESTAMP" >> symbol' "WITH" >> symbol' "TIME" >> symbol' "ZONE")
                    pure PTimestampWithTimezone

                timestampZ' = do
                    try (symbol' "TIMESTAMPZ")
                    pure PTimestampWithTimezone

                timestamp' = do
                    try (symbol' "TIMESTAMP")
                    pure PTimestamp

                uuid = do
                    try (symbol' "UUID")
                    pure PUUID

                text = do
                    try (symbol' "TEXT")
                    pure PText

                bigint = do
                    try (symbol' "BIGINT") <|> try (symbol' "INT8")
                    pure PBigInt

                smallint = do
                    try (symbol' "SMALLINT") <|> try (symbol' "INT2")
                    pure PSmallInt

                int = do
                    try (symbol' "INTEGER") <|> try (symbol' "INT4") <|> try (symbol' "INT")
                    pure PInt

                bool = do
                    try (symbol' "BOOLEAN") <|> try (symbol' "BOOL")
                    pure PBoolean

                real = do
                    try (symbol' "REAL") <|> try (symbol' "FLOAT4")
                    pure PReal

                double = do
                    try (symbol' "DOUBLE PRECISION") <|> try (symbol' "FLOAT8")
                    pure PDouble

                point = do
                    try (symbol' "POINT")
                    pure PPoint

                polygon = do
                    try (symbol' "POLYGON")
                    pure PPolygon

                date = do
                    try (symbol' "DATE")
                    pure PDate

                binary = do
                    try (symbol' "BYTEA")
                    pure PBinary

                time = do
                    try (symbol' "TIME")
                    optional do
                        symbol' "WITHOUT"
                        symbol' "TIME"
                        symbol' "ZONE"
                    pure PTime

                interval = do
                    try (symbol' "INTERVAL")
                    fields <- optional do
                        choice $ map symbol' intervalFields
                    pure (PInterval fields)

                numericPS = do
                    try (symbol' "NUMERIC(")
                    values <- between (space) (char ')' >> space) (varExpr `sepBy` (char ',' >> space))
                    case values of
                        [VarExpression precision, VarExpression scale] -> do
                            let p = textToInt precision
                            let s = textToInt scale
                            when (or [isNothing p, isNothing s]) do
                                Prelude.fail "Failed to parse NUMERIC(..) expression"
                            pure (PNumeric p s)
                        [VarExpression precision] -> do
                            let p = textToInt precision
                            when (isNothing p) do
                                Prelude.fail "Failed to parse NUMERIC(..) expression"
                            pure (PNumeric p Nothing)
                        _ -> Prelude.fail "Failed to parse NUMERIC(..) expression"

                numeric = do
                    try (symbol' "NUMERIC")
                    pure (PNumeric Nothing Nothing)

                varchar = do
                    try (symbol' "CHARACTER VARYING") <|> try (symbol' "VARCHAR")
                    value <- optional $ between (char '(' >> space) (char ')' >> space) (varExpr)
                    case value of
                        Just (VarExpression limit) -> do
                            let l = textToInt limit
                            case l of
                                Nothing -> Prelude.fail "Failed to parse CHARACTER VARYING(..) expression"
                                Just l -> pure (PVaryingN (Just l))
                        Nothing -> pure (PVaryingN Nothing)
                        _ -> Prelude.fail "Failed to parse CHARACTER VARYING(..) expression"

                character = do
                    try (symbol' "CHAR(") <|> try (symbol' "CHARACTER(")
                    value <- between (space) (char ')' >> space) (varExpr)
                    case value of
                        VarExpression length -> do
                            let l = textToInt length
                            case l of
                                Nothing -> Prelude.fail "Failed to parse CHARACTER VARYING(..) expression"
                                Just l -> pure (PCharacterN l)
                        _ -> Prelude.fail "Failed to parse CHARACTER VARYING(..) expression"

                singleChar = do
                    try (symbol "\"char\"")
                    pure PSingleChar

                serial = do
                    try (symbol' "SERIAL")
                    pure PSerial

                bigserial = do
                    try (symbol' "BIGSERIAL")
                    pure PBigserial

                jsonb = do
                    try (symbol' "JSONB")
                    pure PJSONB

                inet = do
                    try (symbol' "INET")
                    pure PInet

                tsvector = do
                    try (symbol' "TSVECTOR")
                    pure PTSVector

                optionalArray typeParser= do
                    arrayType <- typeParser;
                    (try do symbol' "[]"; pure $ PArray arrayType) <|> pure arrayType

                trigger = do
                    try (symbol' "TRIGGER")
                    pure PTrigger
                
                eventTrigger = do
                    try (symbol' "EVENT_TRIGGER")
                    pure PEventTrigger

                customType = do
                    optional do
                        lexeme "public"
                        char '.'
                    theType <- try (takeWhile1P (Just "Custom type") (\c -> isAlphaNum c || c == '_'))
                    pure (PCustomType theType)


intervalFields :: [Text]
intervalFields =  [ "YEAR TO MONTH", "DAY TO HOUR", "DAY TO MINUTE", "DAY TO SECOND"
                   , "HOUR TO MINUTE", "HOUR TO SECOND", "MINUTE TO SECOND"
                   , "YEAR",  "MONTH", "DAY", "HOUR", "MINUTE", "SECOND"]


term = parens expression <|> try callExpr <|> try doubleExpr <|> try intExpr <|> selectExpr <|> varExpr <|> (textExpr <* optional space)
    where
        parens f = between (char '(' >> space) (char ')' >> space) f

table = [
            [ binary  "<>"  NotEqExpression
            , binary "="  EqExpression

            , binary "<=" LessThanOrEqualToExpression
            , binary "<"  LessThanExpression
            , binary ">="  GreaterThanOrEqualToExpression
            , binary ">"  GreaterThanExpression
            , binary "||" ConcatenationExpression

            , binary "IS" IsExpression
            , inExpr
            , prefix "NOT" NotExpression
            , prefix "EXISTS" ExistsExpression
            , typeCast
            , dot
            ],
            [ binary "AND" AndExpression, binary "OR" OrExpression ]
        ]
    where
        binary  name f = InfixL  (f <$ try (symbol name))
        prefix  name f = Prefix  (f <$ symbol name)
        postfix name f = Postfix (f <$ symbol name)

        -- Cannot be implemented as a infix operator as that requires two expression operands,
        -- but the second is the type-cast type which is not an expression
        typeCast = Postfix do
            symbol "::"
            castType <- sqlType
            pure $ \expr -> TypeCastExpression expr castType

        dot = Postfix do
            char '.'
            name <- identifier
            pure $ \expr -> DotExpression expr name
        
        inExpr = Postfix do
            lexeme "IN"
            right <- try inArrayExpression <|> expression
            pure $ \expr -> InExpression expr right

-- | Parses a SQL expression
--
-- This parser makes use of makeExprParser as described in https://hackage.haskell.org/package/parser-combinators-1.2.0/docs/Control-Monad-Combinators-Expr.html
expression :: Parser Expression
expression = do
    e <- makeExprParser term table <?> "expression"
    space
    pure e

varExpr :: Parser Expression
varExpr = VarExpression <$> identifier

doubleExpr :: Parser Expression
doubleExpr = DoubleExpression <$> (Lexer.signed spaceConsumer Lexer.float)

intExpr :: Parser Expression
intExpr = IntExpression <$> (Lexer.signed spaceConsumer Lexer.decimal)

callExpr :: Parser Expression
callExpr = do
    func <- qualifiedIdentifier
    args <- between (char '(') (char ')') (expression `sepBy` (char ',' >> space))
    space
    pure (CallExpression func args)

textExpr :: Parser Expression
textExpr = TextExpression <$> textExpr'

textExpr' :: Parser Text
textExpr' = cs <$> do
    let emptyByteString = do
            string "'\\x'"
            pure ""
    (try (char '\'' *> manyTill Lexer.charLiteral (char '\''))) <|> emptyByteString

selectExpr :: Parser Expression
selectExpr = do
    symbol' "SELECT"
    columns <- expression `sepBy` (char ',' >> space)
    symbol' "FROM"
    from <- expression


    let whereClause alias = do
            symbol' "WHERE"
            whereClause <- expression
            pure (SelectExpression Select { .. })

    let explicitAs = do
            symbol' "AS"
            alias <- identifier
            whereClause (Just alias)

    let implicitAs = do
            alias <- identifier
            whereClause (Just alias)

    whereClause Nothing <|> explicitAs <|> implicitAs

inArrayExpression :: Parser Expression
inArrayExpression = do
    values <- between (char '(') (char ')') (expression `sepBy` (char ',' >> space))
    pure (InArrayExpression values)



identifier :: Parser Text
identifier = do
    i <- (between (char '"') (char '"') (takeWhile1P Nothing (\c -> c /= '"'))) <|> takeWhile1P (Just "identifier") (\c -> isAlphaNum c || c == '_')
    space
    pure i

comment = do
    (char '-' >> char '-') <?> "Line comment"
    content <- takeWhileP Nothing (/= '\n')
    pure Comment { content }

createIndex = do
    lexeme "CREATE"
    unique <- isJust <$> optional (lexeme "UNIQUE")
    lexeme "INDEX"
    indexName <- identifier
    lexeme "ON"
    tableName <- qualifiedIdentifier
    indexType <- optional parseIndexType
    columns <- between (char '(' >> space) (char ')' >> space) parseIndexColumns
    whereClause <- optional do
        lexeme "WHERE"
        expression
    char ';'
    pure CreateIndex { indexName, unique, tableName, columns, whereClause, indexType }

parseIndexColumns = parseIndexColumn `sepBy` (char ',' >> space)

parseIndexColumn = do
    column <- expression
    orderOption1 <- optional $ space *> lexeme "ASC" $> Asc <|> space *> lexeme "DESC" $> Desc
    orderOption2 <- optional $ space *> lexeme "NULLS FIRST" $> NullsFirst <|> space *> lexeme "NULLS LAST" $> NullsLast
    pure IndexColumn { column, columnOrder = catMaybes [orderOption1, orderOption2] }

parseIndexType = do
    lexeme "USING"

    choice $ map (\(s, v) -> do symbol' s; pure v)
        [ ("btree", Btree)
        , ("gin", Gin)
        , ("gist", Gist)
        ]

createFunction = do
    lexeme "CREATE"
    orReplace <- isJust <$> optional (lexeme "OR" >> lexeme "REPLACE")
    lexeme "FUNCTION"
    functionName <- qualifiedIdentifier
    functionArguments <- between (char '(') (char ')') (functionArgument `sepBy` (char ',' >> space))
    space
    lexeme "RETURNS"
    returns <- sqlType
    space

    language <- optional do
        lexeme "language" <|> lexeme "LANGUAGE"
        symbol' "plpgsql" <|> symbol' "SQL"

    lexeme "AS"
    space
    functionBody <- cs <$> between (char '$' >> char '$') (char '$' >> char '$') (many (anySingleBut '$'))
    space

    language <- case language of
        Just language -> pure language
        Nothing -> do
            lexeme "language" <|> lexeme "LANGUAGE"
            symbol' "plpgsql" <|> symbol' "SQL"
    char ';'
    pure CreateFunction { functionName, functionArguments, functionBody, orReplace, returns, language }
    where
        functionArgument = do
            argumentName <- qualifiedIdentifier
            space
            argumentType <- sqlType
            pure (argumentName, argumentType)

createTrigger = do
    lexeme "CREATE"
    createEventTrigger <|> createTrigger'

createEventTrigger = do
    lexeme "EVENT"
    lexeme "TRIGGER"

    name <- qualifiedIdentifier
    lexeme "ON"
    eventOn <- identifier

    whenCondition <- optional do
        lexeme "WHEN"
        expression

    lexeme "EXECUTE"
    (lexeme "FUNCTION") <|> (lexeme "PROCEDURE")

    (CallExpression functionName arguments) <- callExpr

    char ';'

    pure CreateEventTrigger
        { name
        , eventOn
        , whenCondition
        , functionName
        , arguments
        }



createTrigger' = do
    lexeme "TRIGGER"

    name <- qualifiedIdentifier
    eventWhen <- (lexeme "AFTER" >> pure After) <|> (lexeme "BEFORE" >> pure Before) <|> (lexeme "INSTEAD OF" >> pure InsteadOf)
    event <- (lexeme "INSERT" >> pure TriggerOnInsert) <|> (lexeme "UPDATE" >> pure TriggerOnUpdate) <|> (lexeme "DELETE" >> pure TriggerOnDelete) <|> (lexeme "TRUNCATE" >> pure TriggerOnTruncate)

    lexeme "ON"
    tableName <- qualifiedIdentifier

    lexeme "FOR"
    optional (lexeme "EACH")

    for <- (lexeme "ROW" >> pure ForEachRow) <|> (lexeme "STATEMENT" >> pure ForEachStatement)

    whenCondition <- optional do
        lexeme "WHEN"
        expression

    lexeme "EXECUTE"
    optional (lexeme "FUNCTION" <|> lexeme "PROCEDURE")

    (CallExpression functionName arguments) <- callExpr

    char ';'

    pure CreateTrigger
        { name
        , eventWhen
        , event
        , tableName
        , for
        , whenCondition
        , functionName
        , arguments
        }

alterTable = do
    lexeme "TABLE"
    optional (lexeme "ONLY")
    tableName <- qualifiedIdentifier
    let add = do
            lexeme "ADD"
            let addUnique = do
                    unique <- parseUniqueConstraint Nothing
                    deferrable <- optional parseDeferrable
                    deferrableType <- optional parseDeferrableType
                    char ';'
                    pure (AddConstraint tableName unique deferrable deferrableType)
            addConstraint tableName <|> addColumn tableName <|> addUnique
    let drop = do
            lexeme "DROP"
            dropColumn tableName <|> dropConstraint tableName
    let rename = do
            lexeme "RENAME"
            renameColumn tableName <|> renameTable tableName
    let alter = do
            lexeme "ALTER"
            alterColumn tableName
    enableRowLevelSecurity tableName <|> add <|> drop <|> rename <|> alter

alterType = do
    lexeme "TYPE"
    typeName <- qualifiedIdentifier
    addValue typeName

alterSequence = do
    lexeme "SEQUENCE"
    raw <- cs <$> someTill (anySingle) (char ';')
    pure UnknownStatement { raw = "ALTER SEQUENCE " <> raw };

-- | ALTER TABLE users ALTER COLUMN email DROP NOT NULL;
--  ALTER TABLE users ALTER COLUMN email SET NOT NULL;
--  ALTER TABLE users ALTER COLUMN email SET DEFAULT 'value';
--  ALTER TABLE users ALTER COLUMN email DROP DEFAULT;
alterColumn tableName = do
    lexeme "COLUMN"
    columnName <- identifier

    let drop = do
            lexeme "DROP"
            let notNull = do
                    lexeme "NOT"
                    lexeme "NULL"
                    char ';'
                    pure DropNotNull { tableName, columnName }
            let defaultValue = do
                    lexeme "DEFAULT"
                    char ';'
                    pure DropDefaultValue { tableName, columnName }
            notNull <|> defaultValue

    let set = do
            lexeme "SET"
            let notNull = do
                    lexeme "NOT"
                    lexeme "NULL"
                    char ';'
                    pure SetNotNull { tableName, columnName }
            let defaultValue = do
                    lexeme "DEFAULT"
                    value <- expression
                    char ';'
                    pure SetDefaultValue { tableName, columnName, value }
            notNull <|> defaultValue

    drop <|> set




enableRowLevelSecurity tableName = do
    lexeme "ENABLE"
    lexeme "ROW"
    lexeme "LEVEL"
    lexeme "SECURITY"
    char ';'
    pure EnableRowLevelSecurity { tableName }

createPolicy = do
    lexeme "CREATE"
    lexeme "POLICY"
    name <- identifier
    lexeme "ON"
    tableName <- qualifiedIdentifier

    action <- optional (lexeme "FOR" >> policyAction)

    using <- optional do
        lexeme "USING"
        expression

    check <- optional do
        lexeme "WITH"
        lexeme "CHECK"
        expression

    char ';'

    pure CreatePolicy { name, action, tableName, using, check }

policyAction =
    (lexeme "ALL" >> pure PolicyForAll)
    <|> (lexeme "SELECT" >> pure PolicyForSelect)
    <|> (lexeme "INSERT" >> pure PolicyForInsert)
    <|> (lexeme "UPDATE" >> pure PolicyForUpdate)
    <|> (lexeme "DELETE" >> pure PolicyForDelete)

setStatement = do
    lexeme "SET"
    name <- identifier
    lexeme "="
    value <- expression
    char ';'
    pure Set { name, value }

selectStatement = do
    lexeme "SELECT"
    query <- takeWhile1P (Just "SQL Query") (\c -> c /= ';')
    char ';'
    pure SelectStatement { query }


commentStatement = do
    lexeme "COMMENT"
    content <- takeWhile1P (Just "SQL Query") (\c -> c /= ';')
    char ';'
    pure Comment { content }

qualifiedIdentifier = do
    optional $ try do
        lexeme "public"
        char '.'
    identifier

addColumn tableName = do
    lexeme "COLUMN"
    (_, column) <- parseColumn
    char ';'
    pure AddColumn { tableName, column }

dropColumn tableName = do
    lexeme "COLUMN"
    columnName <- identifier
    char ';'
    pure DropColumn { tableName, columnName }

dropConstraint tableName = do
    lexeme "CONSTRAINT"
    constraintName <- identifier
    char ';'
    pure DropConstraint { tableName, constraintName }

renameColumn tableName = do
    lexeme "COLUMN"
    from <- identifier
    lexeme "TO"
    to <- identifier
    char ';'
    pure RenameColumn { tableName, from, to }

renameTable tableName = do
    lexeme "TO"
    to <- identifier
    char ';'
    pure RenameTable { from = tableName, to }

dropTable = do
    lexeme "DROP"
    lexeme "TABLE"
    tableName <- identifier
    char ';'
    pure DropTable { tableName }

dropType = do
    lexeme "DROP"
    lexeme "TYPE"
    name <- qualifiedIdentifier
    char ';'
    pure DropEnumType { name }

dropFunction = do
    lexeme "DROP"
    lexeme "FUNCTION"
    functionName <- qualifiedIdentifier
    char ';'
    pure DropFunction { functionName }

dropIndex = do
    lexeme "DROP"
    lexeme "INDEX"
    indexName <- qualifiedIdentifier
    char ';'
    pure DropIndex { indexName }

dropPolicy = do
    lexeme "DROP"
    lexeme "POLICY"
    policyName <- qualifiedIdentifier
    lexeme "ON"
    tableName <- qualifiedIdentifier
    char ';'
    pure DropPolicy { tableName, policyName }

dropTrigger = do
    lexeme "DROP"

    dropEventTrigger <|> dropTrigger'

dropTrigger' = do
    lexeme "TRIGGER"
    name <- qualifiedIdentifier
    lexeme "ON"
    tableName <- qualifiedIdentifier
    char ';'
    pure DropTrigger { name, tableName }


dropEventTrigger = do
    lexeme "EVENT"
    lexeme "TRIGGER"
    name <- qualifiedIdentifier
    char ';'
    pure DropEventTrigger { name }

createSequence = do
    lexeme "CREATE"
    lexeme "SEQUENCE"
    name <- qualifiedIdentifier

    -- We accept all the following SEQUENCE attributes, but don't save them
    -- This is mostly to void issues in migrations when parsing the pg_dump output
    optional do
        lexeme "AS"
        sqlType

    optional do
        lexeme "START"
        lexeme "WITH"
        expression

    optional do
        lexeme "INCREMENT"
        lexeme "BY"
        expression

    optional do
        lexeme "NO"
        lexeme "MINVALUE"

    optional do
        lexeme "NO"
        lexeme "MAXVALUE"

    optional do
        lexeme "CACHE"
        expression

    char ';'
    pure CreateSequence { name }

addValue typeName = do
    lexeme "ADD"
    lexeme "VALUE"
    ifNotExists <- isJust <$> optional do
            lexeme "IF"
            lexeme "NOT"
            lexeme "EXISTS"
    newValue <- textExpr'
    char ';'
    pure AddValueToEnumType { enumName = typeName, newValue, ifNotExists }

begin = do
    lexeme "BEGIN"
    char ';'
    pure Begin

commit = do
    lexeme "COMMIT"
    char ';'
    pure Commit

-- | Turns sql like '1::double precision' into just '1'
removeTypeCasts :: Expression -> Expression
removeTypeCasts (TypeCastExpression value _) = value
removeTypeCasts otherwise = otherwise

restrict = do
    lexeme "\\restrict"
    key <- identifier
    pure Comment { content = "" }

unrestrict = do
    lexeme "\\unrestrict"
    key <- identifier
    pure Comment { content = "" }