Compiler.hs

{-|
Module: IHP.IDE.SchemaDesigner.Compiler
Description: Compiles AST of SQL to DDL
Copyright: (c) digitally induced GmbH, 2020
-}
module IHP.IDE.SchemaDesigner.Compiler (compileSql, writeSchema, compileIdentifier, compileExpression, compilePostgresType, compileIndexColumn) where

import IHP.Prelude
import IHP.IDE.SchemaDesigner.Types
import Data.Maybe (fromJust)
import qualified Data.Text.IO as Text
import qualified Data.Text as Text

writeSchema :: [Statement] -> IO ()
writeSchema !statements = do
    let sortedStatements = sortBy compareStatement statements
    Text.writeFile "Application/Schema.sql" (compileSql sortedStatements)

compileSql :: [Statement] -> Text
compileSql statements = statements
    |> map compileStatement
    |> unlines

compileStatement :: Statement -> Text
compileStatement (StatementCreateTable CreateTable { name, columns, primaryKeyConstraint, constraints, unlogged }) = "CREATE" <> (if unlogged then " UNLOGGED" else "") <> " TABLE " <> compileIdentifier name <> " (\n" <> intercalate ",\n" (map (\col -> "    " <> compileColumn primaryKeyConstraint col) columns <> maybe [] ((:[]) . indent) (compilePrimaryKeyConstraint primaryKeyConstraint) <> map (indent . compileConstraint) constraints) <> "\n);"
compileStatement CreateEnumType { name, values } = "CREATE TYPE " <> compileIdentifier name <> " AS ENUM (" <> intercalate ", " (values |> map TextExpression |> map compileExpression) <> ");"
compileStatement CreateExtension { name, ifNotExists } = "CREATE EXTENSION " <> (if ifNotExists then "IF NOT EXISTS " else "") <> compileIdentifier name <> ";"
compileStatement AddConstraint { tableName, constraint = UniqueConstraint { name = Nothing, columnNames } } = "ALTER TABLE " <> compileIdentifier tableName <> " ADD UNIQUE (" <> intercalate ", " columnNames <> ")" <> ";"
compileStatement AddConstraint { tableName, constraint, deferrable, deferrableType } = "ALTER TABLE " <> compileIdentifier tableName <> " ADD CONSTRAINT " <> compileIdentifier (fromMaybe (error "compileStatement: Expected constraint name") (constraint.name)) <> " " <> compileConstraint constraint <> compileDeferrable deferrable deferrableType <> ";"
compileStatement AddColumn { tableName, column } = "ALTER TABLE " <> compileIdentifier tableName <> " ADD COLUMN " <> (compileColumn (PrimaryKeyConstraint []) column) <> ";"
compileStatement DropColumn { tableName, columnName } = "ALTER TABLE " <> compileIdentifier tableName <> " DROP COLUMN " <> compileIdentifier columnName <> ";"
compileStatement RenameColumn { tableName, from, to } = "ALTER TABLE " <> compileIdentifier tableName <> " RENAME COLUMN " <> compileIdentifier from <> " TO " <> compileIdentifier to <> ";"
compileStatement DropTable { tableName } = "DROP TABLE " <> compileIdentifier tableName <> ";"
compileStatement Comment { content } = "--" <> content
compileStatement CreateIndex { indexName, unique, tableName, columns, whereClause, indexType } = "CREATE" <> (if unique then " UNIQUE " else " ") <> "INDEX " <> compileIdentifier indexName <> " ON " <> compileIdentifier tableName <> (maybe "" (\indexType -> " USING " <> compileIndexType indexType) indexType) <> " (" <> (intercalate ", " (map compileIndexColumn columns)) <> ")" <> (case whereClause of Just expression -> " WHERE " <> compileExpression expression; Nothing -> "") <> ";"
compileStatement CreateFunction { functionName, functionArguments, functionBody, orReplace, returns, language } = "CREATE " <> (if orReplace then "OR REPLACE " else "") <> "FUNCTION " <> functionName <> "(" <> (functionArguments |> map (\(argName, argType) -> argName ++ " " ++ compilePostgresType argType) |> intercalate  ", ") <> ")" <> " RETURNS " <> compilePostgresType returns <> " AS $$" <> functionBody <> "$$ language " <> language <> ";"
compileStatement EnableRowLevelSecurity { tableName } = "ALTER TABLE " <> compileIdentifier tableName <> " ENABLE ROW LEVEL SECURITY;"
compileStatement CreatePolicy { name, action, tableName, using, check } = "CREATE POLICY " <> compileIdentifier name <> " ON " <> compileIdentifier tableName <> maybe "" (\action -> " FOR " <> compilePolicyAction action) action  <> maybe "" (\expr -> " USING (" <> compileExpression expr <> ")") using <> maybe "" (\expr -> " WITH CHECK (" <> compileExpression expr <> ")") check <> ";"
compileStatement CreateSequence { name } = "CREATE SEQUENCE " <> compileIdentifier name <> ";"
compileStatement DropConstraint { tableName, constraintName } = "ALTER TABLE " <> compileIdentifier tableName <> " DROP CONSTRAINT " <> compileIdentifier constraintName <> ";"
compileStatement DropEnumType { name } = "DROP TYPE " <> compileIdentifier name <> ";"
compileStatement DropIndex { indexName } = "DROP INDEX " <> compileIdentifier indexName <> ";"
compileStatement DropNotNull { tableName, columnName } = "ALTER TABLE " <> compileIdentifier tableName <> " ALTER COLUMN " <> compileIdentifier columnName <> " DROP NOT NULL;"
compileStatement SetNotNull { tableName, columnName } = "ALTER TABLE " <> compileIdentifier tableName <> " ALTER COLUMN " <> compileIdentifier columnName <> " SET NOT NULL;"
compileStatement RenameTable { from, to } = "ALTER TABLE " <> compileIdentifier from <> " RENAME TO " <> compileIdentifier to <> ";"
compileStatement DropPolicy { tableName, policyName } =  "DROP POLICY " <> compileIdentifier policyName <> " ON " <> compileIdentifier tableName <> ";"
compileStatement SetDefaultValue { tableName, columnName, value } = "ALTER TABLE " <> compileIdentifier tableName <> " ALTER COLUMN " <> compileIdentifier columnName <> " SET DEFAULT " <> compileExpression value <> ";"
compileStatement DropDefaultValue { tableName, columnName } = "ALTER TABLE " <> compileIdentifier tableName <> " ALTER COLUMN " <> compileIdentifier columnName <> " DROP DEFAULT;"
compileStatement AddValueToEnumType { enumName, newValue } = "ALTER TYPE " <> compileIdentifier enumName <> " ADD VALUE " <> compileExpression (TextExpression newValue) <> ";"
compileStatement CreateTrigger { name, eventWhen, event, tableName, for, whenCondition, functionName, arguments } = "CREATE TRIGGER " <> compileIdentifier name <> " " <> compileTriggerEventWhen eventWhen <> " " <> compileTriggerEvent event <> " ON " <> compileIdentifier tableName <> " " <> compileTriggerFor for <> " EXECUTE FUNCTION " <> compileExpression (CallExpression functionName arguments) <> ";"
compileStatement Begin = "BEGIN;"
compileStatement Commit = "COMMIT;"
compileStatement DropFunction { functionName } = "DROP FUNCTION " <> compileIdentifier functionName <> ";"
compileStatement UnknownStatement { raw } = raw <> ";"
compileStatement Set { name, value } = "SET " <> compileIdentifier name <> " = " <> compileExpression value <> ";"
compileStatement SelectStatement { query } = "SELECT " <> query <> ";"
compileStatement DropTrigger { name, tableName } = "DROP TRIGGER " <> compileIdentifier name <> " ON " <> compileIdentifier tableName <> ";"
compileStatement CreateEventTrigger { name, eventOn, whenCondition, functionName, arguments } = "CREATE EVENT TRIGGER " <> compileIdentifier name <> " ON " <> compileIdentifier eventOn <> " " <> (maybe "" (\expression -> "WHEN " <> compileExpression expression) whenCondition) <> " EXECUTE FUNCTION " <> compileExpression (CallExpression functionName arguments) <> ";"
compileStatement DropEventTrigger { name } = "DROP EVENT TRIGGER " <> compileIdentifier name <> ";"

-- | Emit a PRIMARY KEY constraint when there are multiple primary key columns
compilePrimaryKeyConstraint :: PrimaryKeyConstraint -> Maybe Text
compilePrimaryKeyConstraint PrimaryKeyConstraint { primaryKeyColumnNames } =
    case primaryKeyColumnNames of
        [] -> Nothing
        [_] -> Nothing
        names -> Just $ "PRIMARY KEY(" <> intercalate ", " names <> ")"

compileConstraint :: Constraint -> Text
compileConstraint ForeignKeyConstraint { columnName, referenceTable, referenceColumn, onDelete } = "FOREIGN KEY (" <> compileIdentifier columnName <> ") REFERENCES " <> compileIdentifier referenceTable <> (if isJust referenceColumn then " (" <> fromJust referenceColumn <> ")" else "") <> " " <> compileOnDelete onDelete
compileConstraint UniqueConstraint { columnNames } = "UNIQUE(" <> intercalate ", " columnNames <> ")"
compileConstraint CheckConstraint { checkExpression } = "CHECK (" <> compileExpression checkExpression <> ")"
compileConstraint ExcludeConstraint { excludeElements, predicate, indexType } = "EXCLUDE" <> compiledIndexType <> " (" <> compiledExcludeElements <> ")" <> case predicate of
    Just expression -> " WHERE (" <> compileExpression expression <> ")"
    Nothing -> ""
    where
        compiledExcludeElements = intercalate ", " $ map compileExcludeElement excludeElements

        compileExcludeElement ExcludeConstraintElement { element, operator } = element <> " WITH " <> operator

        compiledIndexType = case indexType of
            Nothing -> ""
            Just indexType -> " USING " <> compileIndexType indexType

compileDeferrable :: Maybe Bool -> Maybe DeferrableType -> Text
compileDeferrable deferrable deferrableType = Text.concat $ map ((<>) " ") $ catMaybes [compileIsDeferrable <$> deferrable, compileDeferrableType <$> deferrableType]
    where
        compileIsDeferrable True = "DEFERRABLE"
        compileIsDeferrable False = "NOT DEFERRABLE"
        compileDeferrableType InitiallyImmediate = "INITIALLY IMMEDIATE"
        compileDeferrableType InitiallyDeferred = "INITIALLY DEFERRED"

compileOnDelete :: Maybe OnDelete -> Text
compileOnDelete Nothing = ""
compileOnDelete (Just NoAction) = "ON DELETE NO ACTION"
compileOnDelete (Just Restrict) = "ON DELETE RESTRICT"
compileOnDelete (Just SetNull) = "ON DELETE SET NULL"
compileOnDelete (Just SetDefault) = "ON DELETE SET DEFAULT"
compileOnDelete (Just Cascade) = "ON DELETE CASCADE"

compileColumn :: PrimaryKeyConstraint -> Column -> Text
compileColumn primaryKeyConstraint Column { name, columnType, defaultValue, notNull, isUnique, generator } =
    unwords (catMaybes
        [ Just (compileIdentifier name)
        , Just (compilePostgresType columnType)
        , fmap compileDefaultValue defaultValue
        , fmap compileGenerator generator
        , primaryKeyColumnConstraint
        , if notNull then Just "NOT NULL" else Nothing
        , if isUnique then Just "UNIQUE" else Nothing
        ])
    where
        -- Emit a PRIMARY KEY column constraint if this is the only primary key column
        primaryKeyColumnConstraint = case primaryKeyConstraint of
            PrimaryKeyConstraint [primaryKeyColumn]
                | name == primaryKeyColumn -> Just "PRIMARY KEY"
                | otherwise -> Nothing
            PrimaryKeyConstraint _ -> Nothing

compileDefaultValue :: Expression -> Text
compileDefaultValue value = "DEFAULT " <> compileExpression value

compileExpression :: Expression -> Text
compileExpression (TextExpression value) = "'" <> value <> "'"
compileExpression (VarExpression name) =
        if nameContainsSpaces
            then compileIdentifier name
            else name
    where
        nameContainsSpaces = Text.any (== ' ') name
compileExpression (CallExpression func args) = func <> "(" <> intercalate ", " (map compileExpressionWithOptionalParenthese args) <> ")"
compileExpression (NotEqExpression a b) = compileExpression a <> " <> " <> compileExpression b
compileExpression (EqExpression a b) = compileExpressionWithOptionalParenthese a <> " = " <> compileExpressionWithOptionalParenthese b
compileExpression (IsExpression a (NotExpression b)) = compileExpressionWithOptionalParenthese a <> " IS NOT " <> compileExpressionWithOptionalParenthese b -- 'IS (NOT NULL)' => 'IS NOT NULL'
compileExpression (IsExpression a b) = compileExpressionWithOptionalParenthese a <> " IS " <> compileExpressionWithOptionalParenthese b
compileExpression (InExpression a b) = compileExpressionWithOptionalParenthese a <> " IN " <> compileExpressionWithOptionalParenthese b
compileExpression (InArrayExpression values) = "(" <> intercalate ", " (map compileExpression values) <> ")"
compileExpression (NotExpression a) = "NOT " <> compileExpressionWithOptionalParenthese a
compileExpression (AndExpression a b) = compileExpressionWithOptionalParenthese a <> " AND " <> compileExpressionWithOptionalParenthese b
compileExpression (OrExpression a b) = compileExpressionWithOptionalParenthese a <> " OR " <> compileExpressionWithOptionalParenthese b
compileExpression (LessThanExpression a b) = compileExpressionWithOptionalParenthese a <> " < " <> compileExpressionWithOptionalParenthese b
compileExpression (LessThanOrEqualToExpression a b) = compileExpressionWithOptionalParenthese a <> " <= " <> compileExpressionWithOptionalParenthese b
compileExpression (GreaterThanExpression a b) = compileExpressionWithOptionalParenthese a <> " > " <> compileExpressionWithOptionalParenthese b
compileExpression (GreaterThanOrEqualToExpression a b) = compileExpressionWithOptionalParenthese a <> " >= " <> compileExpressionWithOptionalParenthese b
compileExpression (DoubleExpression double) = tshow double
compileExpression (IntExpression integer) = tshow integer
compileExpression (TypeCastExpression value type_) = compileExpression value <> "::" <> compilePostgresType type_
compileExpression (SelectExpression Select { columns, from, whereClause }) = "SELECT " <> intercalate ", " (map compileExpression columns) <> " FROM " <> compileExpression from <> " WHERE " <> compileExpression whereClause
compileExpression (ExistsExpression a) = "EXISTS " <> compileExpressionWithOptionalParenthese a
compileExpression (DotExpression a b) = compileExpressionWithOptionalParenthese a <> "." <> compileIdentifier b
compileExpression (ConcatenationExpression a b) = compileExpressionWithOptionalParenthese a <> " || " <> compileExpressionWithOptionalParenthese b

compileExpressionWithOptionalParenthese :: Expression -> Text
compileExpressionWithOptionalParenthese expr@(VarExpression {}) = compileExpression expr
compileExpressionWithOptionalParenthese expr@(IsExpression a (NotExpression b)) = compileExpression a <> " IS " <> compileExpression (NotExpression b) -- 'IS (NOT NULL)' => 'IS NOT NULL'
compileExpressionWithOptionalParenthese expr@(IsExpression {}) = compileExpression expr
compileExpressionWithOptionalParenthese expr@(EqExpression {}) = compileExpression expr
compileExpressionWithOptionalParenthese expr@(AndExpression a@(AndExpression {}) b ) = "(" <> compileExpression a <> " AND " <> compileExpressionWithOptionalParenthese b <> ")" -- '(a AND b) AND c' => 'a AND b AND C'
compileExpressionWithOptionalParenthese expr@(AndExpression a b@(AndExpression {}) ) = "(" <> compileExpressionWithOptionalParenthese a <> " AND " <> compileExpression b <> ")" -- 'a AND (b AND c)' => 'a AND b AND C'
--compileExpressionWithOptionalParenthese expr@(OrExpression a@(IsExpression {}) b ) = compileExpressionWithOptionalParenthese a <> " OR " <> compileExpressionWithOptionalParenthese b -- '(a IS NULL) OR b' => 'A IS NULL OR b'
compileExpressionWithOptionalParenthese expr@(CallExpression {}) = compileExpression expr
compileExpressionWithOptionalParenthese expr@(TextExpression {}) = compileExpression expr
compileExpressionWithOptionalParenthese expr@(IntExpression {}) = compileExpression expr
compileExpressionWithOptionalParenthese expr@(DoubleExpression {}) = compileExpression expr
compileExpressionWithOptionalParenthese expr@(DotExpression (VarExpression {}) b) = compileExpression expr
compileExpressionWithOptionalParenthese expr@(ConcatenationExpression a b ) = compileExpression expr
compileExpressionWithOptionalParenthese expr@(InArrayExpression values) = compileExpression expr
compileExpressionWithOptionalParenthese expression = "(" <> compileExpression expression <> ")"

compareStatement (CreateEnumType {}) _ = LT
compareStatement (StatementCreateTable CreateTable {}) (AddConstraint {}) = LT
compareStatement (AddConstraint { constraint = a }) (AddConstraint { constraint = b }) = compare (a.name) (b.name)
compareStatement (AddConstraint {}) _ = GT
compareStatement _ _ = EQ

compilePostgresType :: PostgresType -> Text
compilePostgresType PUUID = "UUID"
compilePostgresType PText = "TEXT"
compilePostgresType PInt = "INT"
compilePostgresType PSmallInt = "SMALLINT"
compilePostgresType PBigInt = "BIGINT"
compilePostgresType PBoolean = "BOOLEAN"
compilePostgresType PTimestamp = "TIMESTAMP WITHOUT TIME ZONE"
compilePostgresType PTimestampWithTimezone = "TIMESTAMP WITH TIME ZONE"
compilePostgresType PReal = "REAL"
compilePostgresType PDouble = "DOUBLE PRECISION"
compilePostgresType PPoint = "POINT"
compilePostgresType PPolygon = "POLYGON"
compilePostgresType PDate = "DATE"
compilePostgresType PBinary = "BYTEA"
compilePostgresType PTime = "TIME"
compilePostgresType (PInterval Nothing) = "INTERVAL"
compilePostgresType (PInterval (Just fields)) = "INTERVAL" <> " " <> fields
compilePostgresType (PNumeric (Just precision) (Just scale)) = "NUMERIC(" <> show precision <> "," <> show scale <> ")"
compilePostgresType (PNumeric (Just precision) Nothing) = "NUMERIC(" <> show precision <> ")"
compilePostgresType (PNumeric Nothing _) = "NUMERIC"
compilePostgresType (PVaryingN (Just limit)) = "CHARACTER VARYING(" <> show limit <> ")"
compilePostgresType (PVaryingN Nothing) = "CHARACTER VARYING"
compilePostgresType (PCharacterN length) = "CHARACTER(" <> show length <> ")"
compilePostgresType PSingleChar = "\"char\""
compilePostgresType PSerial = "SERIAL"
compilePostgresType PBigserial = "BIGSERIAL"
compilePostgresType PJSONB = "JSONB"
compilePostgresType PInet = "INET"
compilePostgresType PTSVector = "TSVECTOR"
compilePostgresType (PArray type_) = compilePostgresType type_ <> "[]"
compilePostgresType PTrigger = "TRIGGER"
compilePostgresType PEventTrigger = "EVENT_TRIGGER"
compilePostgresType (PCustomType theType) = theType

compileIdentifier :: Text -> Text
compileIdentifier identifier = if identifierNeedsQuoting then tshow identifier else identifier
    where
        identifierNeedsQuoting = isKeyword || containsChar ' ' || containsChar '-' || isUsingUppercase
        isKeyword = IHP.Prelude.toUpper identifier `elem` keywords
        containsChar char = Text.any (char ==) identifier
        isUsingUppercase = Text.toLower identifier /= identifier

        keywords = [ "ABORT"
            , "ABSOLUTE"
            , "ACCESS"
            , "ACTION"
            , "ADD"
            , "ADMIN"
            , "AFTER"
            , "AGGREGATE"
            , "ALSO"
            , "ALTER"
            , "ASSERTION"
            , "ASSIGNMENT"
            , "AT"
            , "ALL"
            , "BACKWARD"
            , "BEFORE"
            , "BEGIN"
            , "BY"
            , "CACHE"
            , "CALLED"
            , "CASCADE"
            , "CHAIN"
            , "CHARACTERISTICS"
            , "CHECKPOINT"
            , "CLASS"
            , "CLOSE"
            , "CLUSTER"
            , "COMMENT"
            , "COMMIT"
            , "COMMITTED"
            , "CONNECTION"
            , "CONSTRAINTS"
            , "CONVERSION"
            , "COPY"
            , "CREATEDB"
            , "CREATEROLE"
            , "CREATEUSER"
            , "CSV"
            , "CURSOR"
            , "CYCLE"
            , "DATABASE"
            , "DAY"
            , "DEALLOCATE"
            , "DECLARE"
            , "DEFAULTS"
            , "DEFERRED"
            , "DEFINER"
            , "DELETE"
            , "DELIMITER"
            , "DELIMITERS"
            , "DISABLE"
            , "DOMAIN"
            , "DOUBLE"
            , "DROP"
            , "EACH"
            , "ENABLE"
            , "ENCODING"
            , "ENCRYPTED"
            , "ESCAPE"
            , "EXCLUDING"
            , "EXCLUSIVE"
            , "EXECUTE"
            , "EXPLAIN"
            , "EXTERNAL"
            , "FETCH"
            , "FIRST"
            , "FORCE"
            , "FORWARD"
            , "FUNCTION"
            , "GLOBAL"
            , "GRANTED"
            , "HANDLER"
            , "HEADER"
            , "HOLD"
            , "HOUR"
            , "IMMEDIATE"
            , "IMMUTABLE"
            , "IMPLICIT"
            , "INCLUDING"
            , "INCREMENT"
            , "INDEX"
            , "INHERIT"
            , "INHERITS"
            , "INPUT"
            , "INSENSITIVE"
            , "INSERT"
            , "INSTEAD"
            , "INVOKER"
            , "ISOLATION"
            , "KEY"
            , "LANCOMPILER"
            , "LANGUAGE"
            , "LARGE"
            , "LAST"
            , "LEVEL"
            , "LISTEN"
            , "LOAD"
            , "LOCAL"
            , "LOCATION"
            , "LOCK"
            , "LOGIN"
            , "MATCH"
            , "MAXVALUE"
            , "MINUTE"
            , "MINVALUE"
            , "MODE"
            , "MONTH"
            , "MOVE"
            , "NAMES"
            , "NEXT"
            , "NO"
            , "NOCREATEDB"
            , "NOCREATEROLE"
            , "NOCREATEUSER"
            , "NOINHERIT"
            , "NOLOGIN"
            , "NOSUPERUSER"
            , "NOTHING"
            , "NOTIFY"
            , "NOWAIT"
            , "OBJECT"
            , "OF"
            , "OIDS"
            , "OPERATOR"
            , "OPTION"
            , "OWNER"
            , "PARTIAL"
            , "PASSWORD"
            , "PREPARE"
            , "PREPARED"
            , "PRESERVE"
            , "PRIOR"
            , "PRIVILEGES"
            , "PROCEDURAL"
            , "PROCEDURE"
            , "QUOTE"
            , "READ"
            , "RECHECK"
            , "REINDEX"
            , "RELATIVE"
            , "RELEASE"
            , "RENAME"
            , "REPEATABLE"
            , "REPLACE"
            , "RESET"
            , "RESTART"
            , "RESTRICT"
            , "RETURNS"
            , "REVOKE"
            , "ROLE"
            , "ROLLBACK"
            , "ROWS"
            , "RULE"
            , "SAVEPOINT"
            , "SCHEMA"
            , "SCROLL"
            , "SECOND"
            , "SECURITY"
            , "SEQUENCE"
            , "SERIALIZABLE"
            , "SESSION"
            , "SET"
            , "SHARE"
            , "tshow"
            , "SIMPLE"
            , "STABLE"
            , "START"
            , "STATEMENT"
            , "STATISTICS"
            , "STDIN"
            , "STDOUT"
            , "STORAGE"
            , "STRICT"
            , "SUPERUSER"
            , "SYSID"
            , "SYSTEM"
            , "TABLESPACE"
            , "TEMP"
            , "TEMPLATE"
            , "TEMPORARY"
            , "TOAST"
            , "TRANSACTION"
            , "TRIGGER"
            , "TRUNCATE"
            , "TRUSTED"
            , "TYPE"
            , "UNCOMMITTED"
            , "UNENCRYPTED"
            , "UNKNOWN"
            , "UNLISTEN"
            , "UNTIL"
            , "UPDATE"
            , "VACUUM"
            , "VALID"
            , "VALIDATOR"
            , "VALUES"
            , "VARYING"
            , "VIEW"
            , "VOLATILE"
            , "WITH"
            , "WITHOUT"
            , "WORK"
            , "WRITE"
            , "YEAR"
            , "ZONE"
            , "BIGINT"
            , "BIT"
            , "BOOLEAN"
            , "CHAR"
            , "CHARACTER"
            , "COALESCE"
            , "CONVERT"
            , "DEC"
            , "DECIMAL"
            , "EXISTS"
            , "EXTRACT"
            , "FLOAT"
            , "GREATEST"
            , "INOUT"
            , "INT"
            , "INTEGER"
            , "INTERVAL"
            , "LEAST"
            , "NATIONAL"
            , "NCHAR"
            , "NONE"
            , "NULLIF"
            , "NUMERIC"
            , "OUT"
            , "OVERLAY"
            , "POSITION"
            , "PRECISION"
            , "REAL"
            , "ROW"
            , "SETOF"
            , "SMALLINT"
            , "SUBSTRING"
            , "TIME"
            , "TIMESTAMP"
            , "TREAT"
            , "TRIM"
            , "VARCHAR"
            ]

indent text = "    " <> text

compileTriggerEventWhen :: TriggerEventWhen -> Text
compileTriggerEventWhen Before = "BEFORE"
compileTriggerEventWhen After = "AFTER"
compileTriggerEventWhen InsteadOf = "INSTEAD OF"

compileTriggerEvent :: TriggerEvent -> Text
compileTriggerEvent TriggerOnInsert = "INSERT"
compileTriggerEvent TriggerOnUpdate = "UPDATE"
compileTriggerEvent TriggerOnDelete = "DELETE"
compileTriggerEvent TriggerOnTruncate = "TRUNCATE"

compileTriggerFor :: TriggerFor -> Text
compileTriggerFor ForEachRow = "FOR EACH ROW"
compileTriggerFor ForEachStatement = "FOR EACH STATEMENT"

compilePolicyAction :: PolicyAction -> Text
compilePolicyAction PolicyForAll = "ALL"
compilePolicyAction PolicyForSelect = "SELECT"
compilePolicyAction PolicyForInsert = "INSERT"
compilePolicyAction PolicyForUpdate = "UPDATE"
compilePolicyAction PolicyForDelete = "DELETE"

compileGenerator :: ColumnGenerator -> Text
compileGenerator ColumnGenerator { generate, stored } =
    "GENERATED ALWAYS AS ("
    <> compileExpressionWithOptionalParenthese generate
    <> ")"
    <> (if stored then " STORED" else "")

compileIndexType :: IndexType -> Text
compileIndexType Gin = "GIN"
compileIndexType Btree = "BTREE"
compileIndexType Gist = "GIST"

compileIndexColumn :: IndexColumn -> Text
compileIndexColumn IndexColumn { column, columnOrder = [] } = compileExpression column
compileIndexColumn IndexColumn { column, columnOrder } = compileExpression column <> " " <> unwords (columnOrder |> map compileIndexColumnOrder)

compileIndexColumnOrder :: IndexColumnOrder -> Text
compileIndexColumnOrder Asc = "ASC"
compileIndexColumnOrder Desc = "DESC"
compileIndexColumnOrder NullsFirst = "NULLS FIRST"
compileIndexColumnOrder NullsLast = "NULLS LAST"