content: {-|
  Module: IHP.IDE.CodeGen.MigrationGenerator
  Description: Generates database migration sql files
  Copyright: (c) digitally induced GmbH, 2021
  -}
  module IHP.IDE.CodeGen.MigrationGenerator where
  
  import IHP.Prelude
  import qualified System.Directory as Directory
  import qualified Data.Text as Text
  import qualified Data.Time.Clock.POSIX as POSIX
  import qualified IHP.NameSupport as NameSupport
  import qualified Data.Char as Char
  import qualified System.Process as Process
  import qualified IHP.IDE.SchemaDesigner.Parser as Parser
  import IHP.IDE.SchemaDesigner.Types
  import Text.Megaparsec
  import IHP.IDE.SchemaDesigner.Compiler (compileSql)
  import IHP.IDE.CodeGen.Types
  import qualified IHP.FrameworkConfig as FrameworkConfig
  import Paths_ihp_ide (getDataFileName)
  
  buildPlan :: Text -> Maybe Text -> IO (Int, [GeneratorAction])
  buildPlan description sqlStatements = buildPlan' True description sqlStatements
  
  buildPlanWithoutIHPSchema :: Text -> Maybe Text -> IO (Int, [GeneratorAction])
  buildPlanWithoutIHPSchema description sqlStatements = buildPlan' False description sqlStatements
  
  buildPlan' :: Bool -> Text -> Maybe Text -> IO (Int, [GeneratorAction])
  buildPlan' includeIHPSchema description sqlStatements = do
      revision <- round <$> POSIX.getPOSIXTime
      let slug = NameSupport.toSlug description
      let migrationFile = tshow revision <> (if isEmpty slug then "" else "-" <> slug) <> ".sql"
  
      migrationSql <- case sqlStatements of
          Just sql -> pure sql
          Nothing -> do
              databaseUrl <- cs <$> FrameworkConfig.defaultDatabaseUrl
              appDiff <- diffAppDatabase includeIHPSchema databaseUrl
              pure $ if isEmpty appDiff
                  then "-- Write your SQL migration code in here\n"
                  else compileSql appDiff
      pure (revision,
              [ EnsureDirectory { directory = "Application/Migration" }
              , CreateFile { filePath = "Application/Migration/" <> migrationFile, fileContent = migrationSql }
              ])
  
  diffAppDatabase includeIHPSchema databaseUrl = do
      (Right schemaSql) <- Parser.parseSchemaSql
      (Right ihpSchemaSql) <- if includeIHPSchema
              then parseIHPSchema
              else pure (Right [])
      actualSchema <- getAppDBSchema databaseUrl
  
      let targetSchema = ihpSchemaSql <> schemaSql
  
      pure (diffSchemas targetSchema actualSchema)
  
  parseIHPSchema :: IO (Either ByteString [Statement])
  parseIHPSchema = do
      ihpSchemaSql <- findIHPSchemaSql
      Parser.parseSqlFile ihpSchemaSql
  
  findIHPSchemaSql :: IO FilePath
  findIHPSchemaSql = getDataFileName "IHPSchema.sql"
  
  diffSchemas :: [Statement] -> [Statement] -> [Statement]
  diffSchemas targetSchema' actualSchema' = (drop <> create)
              |> patchTable
              |> patchEnumType
              |> applyRenameTable
              |> removeImplicitDeletions actualSchema
              |> disableTransactionWhileAddingEnumValues
              |> applyReplaceFunction
      where
          create :: [Statement]
          create = targetSchema \\ actualSchema
  
          drop :: [Statement]
          drop = (actualSchema \\ targetSchema)
                  |> mapMaybe toDropStatement
  
          targetSchema = removeNoise $ normalizeSchema targetSchema'
          actualSchema = removeNoise $ normalizeSchema actualSchema'
  
          -- | Replaces 'DROP TABLE x; CREATE TABLE x;' DDL sequences with a more efficient 'ALTER TABLE' sequence
          patchTable :: [Statement] -> [Statement]
          patchTable ((s@DropTable { tableName }):statements) =
                  case createTable of
                      Just createTable -> (migrateTable createTable actualTable) <> patchTable (delete createTable statements)
                      Nothing -> s:(patchTable statements)
              where
                  createTable :: Maybe Statement
                  createTable = find isCreateTableStatement statements
  
                  isCreateTableStatement :: Statement -> Bool
                  isCreateTableStatement (StatementCreateTable { unsafeGetCreateTable = table }) | table.name == tableName = True
                  isCreateTableStatement otherwise = False
  
                  (Just actualTable) = actualSchema |> find \case
                          StatementCreateTable { unsafeGetCreateTable = table } -> table.name == tableName
                          otherwise                                                            -> False
          patchTable (s:rest) = s:(patchTable rest)
          patchTable [] = []
  
          -- | Replaces 'DROP TYPE x; CREATE TYPE x;' DDL sequences with a more efficient 'ALTER TYPE' sequence
          patchEnumType :: [Statement] -> [Statement]
          patchEnumType ((s@DropEnumType { name }):statements) =
                  case createEnumType of
                      Just createEnumType -> (migrateEnum createEnumType actualEnumType) <> patchEnumType (delete createEnumType statements)
                      Nothing -> s:(patchEnumType statements)
              where
                  createEnumType :: Maybe Statement
                  createEnumType = find isCreateEnumTypeStatement statements
  
                  isCreateEnumTypeStatement :: Statement -> Bool
                  isCreateEnumTypeStatement CreateEnumType { name = n } = name == n
                  isCreateEnumTypeStatement otherwise                   = False
  
                  (Just actualEnumType) = actualSchema |> find \case
                          CreateEnumType { name = enum } -> enum == name
                          otherwise                      -> False
          patchEnumType (s:rest) = s:(patchEnumType rest)
          patchEnumType [] = []
  
          -- | Replaces 'DROP TABLE a; CREATE TABLE b;' DDL sequences with a more efficient 'ALTER TABLE a RENAME TO b' sequence if
          -- the tables have no differences except the name.
          applyRenameTable :: [Statement] -> [Statement]
          applyRenameTable ((s@DropTable { tableName }):statements) =
                  case createTable of
                      Just createTable@(StatementCreateTable { unsafeGetCreateTable = createTable' }) ->
                          let
                              from = tableName
                              to = createTable'.name
                          in
                              (RenameTable { from, to }):(applyRenameTable (fixIdentifiers from to (delete createTable statements)))
                      Nothing -> s:(applyRenameTable statements)
              where
                  createTable :: Maybe Statement
                  createTable = find isCreateTableStatement statements
  
                  isCreateTableStatement :: Statement -> Bool
                  isCreateTableStatement (StatementCreateTable { unsafeGetCreateTable = table }) = (table.name /= actualTable'.name) && ((actualTable' :: CreateTable) { name = "" } == (table :: CreateTable) { name = "" })
                  isCreateTableStatement otherwise = False
  
                  (Just actualTable) = actualSchema |> find \case
                          StatementCreateTable { unsafeGetCreateTable = table } -> table.name == tableName
                          otherwise                                                            -> False
  
                  actualTable' :: CreateTable
                  actualTable' = case actualTable of
                      StatementCreateTable { unsafeGetCreateTable = table } -> table
  
                  fixIdentifiers :: Text -> Text -> [Statement] -> [Statement]
                  fixIdentifiers tableFrom tableTo statements = map fixIdentifier statements
                      where
                          fixIdentifier :: Statement -> Statement
                          fixIdentifier s@(DropConstraint { tableName }) | tableName == tableFrom = s { tableName = tableTo }
                          fixIdentifier s@(DropPolicy { tableName }) | tableName == tableFrom = s { tableName = tableTo }
                          fixIdentifier o = o
          applyRenameTable (s:rest) = s:(applyRenameTable rest)
          applyRenameTable [] = []
  
          toDropStatement :: Statement -> Maybe Statement
          toDropStatement StatementCreateTable { unsafeGetCreateTable = table } = Just DropTable { tableName = table.name }
          toDropStatement CreateEnumType { name } = Just DropEnumType { name }
          toDropStatement CreateIndex { indexName } = Just DropIndex { indexName }
          toDropStatement AddConstraint { tableName, constraint } = case constraint.name of
                  Just constraintName -> Just DropConstraint { tableName, constraintName }
                  Nothing -> Nothing
          toDropStatement CreatePolicy { tableName, name } = Just DropPolicy { tableName, policyName = name }
          toDropStatement CreateFunction { functionName } = Just DropFunction { functionName }
          toDropStatement CreateTrigger { name, tableName } = Just DropTrigger { name, tableName }
          toDropStatement CreateEventTrigger { name } = Just DropEventTrigger { name }
          toDropStatement otherwise = Nothing
  
  
          -- | Replaces 'DROP FUNCTION a; CREATE FUNCTION a ..;' DDL sequences with a more efficient 'CREATE OR REPLACE FUNCTION a' sequence if
          -- the function have no differences except the body.
          applyReplaceFunction :: [Statement] -> [Statement]
          applyReplaceFunction (DropFunction { functionName }:statements) =
              statements
                  |> map \case
                      s@(CreateFunction { functionName = newFunctionName }) | newFunctionName == functionName -> (s { orReplace = True })
                      otherwise -> otherwise
                  |> applyReplaceFunction
          applyReplaceFunction (s:rest) = s:(applyReplaceFunction rest)
          applyReplaceFunction [] = []
  
  removeNoise = filter \case
          Comment {} -> False
          StatementCreateTable { unsafeGetCreateTable = CreateTable { name = "schema_migrations" } }      -> False
          AddConstraint { tableName = "schema_migrations" }                                               -> False
          CreateFunction { functionName } | "notify_" `Text.isPrefixOf` functionName                      -> False
          CreateTrigger { name } | any (`Text.isPrefixOf` name) ["did_update_", "did_delete_", "did_insert_", "ar_did_update_", "ar_did_delete_", "ar_did_insert_"] -> False
          StatementCreateTable { unsafeGetCreateTable = CreateTable { name = "large_pg_notifications" } } -> False
          CreateIndex { tableName = "large_pg_notifications" }                                            -> False
          _                                                                                               -> True
  
  migrateTable :: Statement -> Statement -> [Statement]
  migrateTable StatementCreateTable { unsafeGetCreateTable = targetTable } StatementCreateTable { unsafeGetCreateTable = actualTable } = migrateTable' targetTable actualTable
      where
          migrateTable' CreateTable { name = tableName, columns = targetColumns } CreateTable { columns = actualColumns } =
                  (map dropColumn dropColumns <> map createColumn createColumns)
                      |> applyRenameColumn
                      |> applyMakeUnique
                      |> applySetDefault
                      |> applyToggleNull
              where
  
                  createColumns :: [Column]
                  createColumns = targetColumns \\ actualColumns
  
                  dropColumns :: [Column]
                  dropColumns = actualColumns \\ targetColumns
  
                  createColumn :: Column -> Statement
                  createColumn column = AddColumn { tableName, column }
  
                  dropColumn :: Column -> Statement
                  dropColumn column = DropColumn { tableName, columnName = column.name }
  
                  applyRenameColumn (s@(DropColumn { columnName }):statements) = case matchingCreateColumn of
                          Just matchingCreateColumn -> RenameColumn { tableName, from = columnName, to = matchingCreateColumn.column.name } : (applyRenameColumn (filter ((/=) matchingCreateColumn) statements))
                          Nothing -> s:(applyRenameColumn statements)
                      where
                          matchingCreateColumn :: Maybe Statement
                          matchingCreateColumn = find isMatchingCreateColumn statements
  
                          isMatchingCreateColumn :: Statement -> Bool
                          isMatchingCreateColumn AddColumn { column = addColumn } = actualColumns
                                  |> find \case
                                      Column { name } -> name == columnName
                                  |> maybe False (\c -> (c :: Column) { name = addColumn.name } == addColumn)
                          isMatchingCreateColumn otherwise                          = False
                  applyRenameColumn (statement:rest) = statement:(applyRenameColumn rest)
                  applyRenameColumn [] = []
  
                  -- | Emits 'ALTER TABLE table ADD UNIQUE (column);'
                  --
                  -- This function substitutes the following queries:
                  --
                  -- > ALTER TABLE table DROP COLUMN column;
                  -- > ALTER TABLE table ADD COLUMN column UNIQUE;
                  --
                  -- With a more natural @ADD UNIQUE@:
                  --
                  -- > ALTER TABLE table ADD UNIQUE (column);
                  --
                  applyMakeUnique (s@(DropColumn { columnName }):statements) = case matchingCreateColumn of
                          Just matchingCreateColumn -> updateConstraint:(applyMakeUnique (filter ((/=) matchingCreateColumn) statements))
                          Nothing -> s:(applyMakeUnique statements)
                      where
                          dropColumn :: Column
                          (Just dropColumn) = actualColumns
                                  |> find \case
                                      Column { name } -> name == columnName
  
                          updateConstraint = if dropColumn.isUnique
                              then DropConstraint { tableName, constraintName = tableName <> "_" <> (dropColumn.name) <> "_key" }
                              else AddConstraint { tableName, constraint = UniqueConstraint { name = Nothing, columnNames = [dropColumn.name] }, deferrable = Nothing, deferrableType = Nothing }
  
                          matchingCreateColumn :: Maybe Statement
                          matchingCreateColumn = find isMatchingCreateColumn statements
  
                          isMatchingCreateColumn :: Statement -> Bool
                          isMatchingCreateColumn AddColumn { column = addColumn } = addColumn { isUnique = False } == dropColumn { isUnique = False }
                          isMatchingCreateColumn otherwise                        = False
                  applyMakeUnique (statement:rest) = statement:(applyMakeUnique rest)
                  applyMakeUnique [] = []
  
                  -- | Emits "ALTER TABLE table ALTER COLUMN column SET DEFAULT 'value'"
                  --
                  -- This function substitutes the following queries:
                  --
                  -- > ALTER TABLE table DROP COLUMN column;
                  -- > ALTER TABLE table ADD COLUMN column;
                  --
                  -- With a more natural @SET DEFAULT@:
                  --
                  -- > ALTER TABLE table ALTER COLUMN column SET DEFAULT 'value'
                  --
                  applySetDefault (s@(DropColumn { columnName }):statements) = case matchingCreateColumn of
                          Just matchingCreateColumn -> case matchingCreateColumn.column.defaultValue of
                              Just value -> SetDefaultValue { tableName, columnName, value }:rest
                              Nothing -> DropDefaultValue { tableName, columnName }:rest
                              where
                                  rest = applySetDefault (filter ((/=) matchingCreateColumn) statements)
                          Nothing -> s:(applySetDefault statements)
                      where
                          dropColumn :: Column
                          (Just dropColumn) = actualColumns
                                  |> find \case
                                      Column { name } -> name == columnName
  
                          matchingCreateColumn :: Maybe Statement
                          matchingCreateColumn = find isMatchingCreateColumn statements
  
                          isMatchingCreateColumn :: Statement -> Bool
                          isMatchingCreateColumn AddColumn { column = addColumn } = (addColumn { defaultValue = Nothing } :: Column) == (dropColumn { defaultValue = Nothing } :: Column)
                          isMatchingCreateColumn otherwise                        = False
                  applySetDefault (statement:rest) = statement:(applySetDefault rest)
                  applySetDefault [] = []
  
                  -- | Emits 'ALTER TABLE table ALTER COLUMN column DROP NOT NULL'
                  --
                  -- This function substitutes the following queries:
                  --
                  -- > ALTER TABLE table DROP COLUMN column;
                  -- > ALTER TABLE table ADD COLUMN column;
                  --
                  -- With a more natural @DROP NOT NULL@:
                  --
                  -- > ALTER TABLE table ALTER COLUMN column DROP NOT NULL
                  --
                  applyToggleNull (s@(DropColumn { columnName }):statements) = case matchingCreateColumn of
                          Just matchingCreateColumn -> updateConstraint:(applyToggleNull (filter ((/=) matchingCreateColumn) statements))
                          Nothing -> s:(applyToggleNull statements)
                      where
                          dropColumn :: Column
                          (Just dropColumn) = actualColumns
                                  |> find \case
                                      Column { name } -> name == columnName
  
                          updateConstraint = if dropColumn.notNull
                              then DropNotNull { tableName, columnName = dropColumn.name }
                              else SetNotNull { tableName, columnName = dropColumn.name }
  
                          matchingCreateColumn :: Maybe Statement
                          matchingCreateColumn = find isMatchingCreateColumn statements
  
                          isMatchingCreateColumn :: Statement -> Bool
                          isMatchingCreateColumn AddColumn { column = addColumn } = addColumn `eqColumnExceptNull` dropColumn
                          isMatchingCreateColumn otherwise                        = False
  
                          eqColumnExceptNull :: Column -> Column -> Bool
                          eqColumnExceptNull colA colB = (normalizeCol colA) == (normalizeCol colB)
                              where
                                  normalizeCol col = col { notNull = False, defaultValue = Just (VarExpression "null") }
                  applyToggleNull (statement:rest) = statement:(applyToggleNull rest)
                  applyToggleNull [] = []
  
  migrateEnum :: Statement -> Statement -> [Statement]
  migrateEnum CreateEnumType { name, values = targetValues } CreateEnumType { values = actualValues } = map addValue newValues
      where
          newValues :: [Text]
          newValues = targetValues \\ actualValues
  
          addValue :: Text -> Statement
          addValue value = AddValueToEnumType { enumName = name, newValue = value, ifNotExists = True }
  
  getAppDBSchema :: Text -> IO [Statement]
  getAppDBSchema databaseUrl = do
      sql <- dumpAppDatabaseSchema databaseUrl
      case parseDumpedSql sql of
          Left error -> fail (cs error)
          Right result -> pure result
  
  -- | Returns the DDL statements of the locally running dev db
  --
  -- Basically does the same as @make dumpdb@ but returns the output as a string
  dumpAppDatabaseSchema :: Text -> IO Text
  dumpAppDatabaseSchema databaseUrl = do
      projectDir <- Directory.getCurrentDirectory
      cs <$> Process.readProcess "pg_dump" ["-s", "--no-owner", "--no-acl", cs databaseUrl] []
  
  parseDumpedSql :: Text -> (Either ByteString [Statement])
  parseDumpedSql sql =
      case runParser Parser.parseDDL "pg_dump" sql of
          Left error -> Left (cs $ errorBundlePretty error)
          Right r -> Right r
  
  normalizeSchema :: [Statement] -> [Statement]
  normalizeSchema statements = map normalizeStatement statements
          |> concat
          |> normalizePrimaryKeys
  
  normalizeStatement :: Statement -> [Statement]
  normalizeStatement StatementCreateTable { unsafeGetCreateTable = table } = StatementCreateTable { unsafeGetCreateTable = normalizedTable } : normalizeTableRest
      where
          (normalizedTable, normalizeTableRest) = normalizeTable table
  normalizeStatement AddConstraint { tableName, constraint, deferrable, deferrableType } = [ AddConstraint { tableName, constraint = normalizeConstraint tableName constraint, deferrable, deferrableType } ]
  normalizeStatement CreateEnumType { name, values } = [ CreateEnumType { name = Text.toLower name, values = map Text.toLower values } ]
  normalizeStatement CreatePolicy { name, action, tableName, using, check } = [ CreatePolicy { name = truncateIdentifier name, tableName, using = (unqualifyExpression tableName . normalizeExpression) <$> using, check = (unqualifyExpression tableName . normalizeExpression) <$> check, action = normalizePolicyAction action } ]
  normalizeStatement CreateIndex { columns, indexType, indexName, .. } = [ CreateIndex { columns = map normalizeIndexColumn columns, indexType = normalizeIndexType indexType, indexName = truncateIdentifier indexName, .. } ]
  normalizeStatement CreateFunction { .. } = [ CreateFunction { orReplace = False, language = Text.toUpper language, functionBody = removeIndentation $ normalizeNewLines functionBody, .. } ]
  normalizeStatement otherwise = [otherwise]
  
  normalizePolicyAction (Just PolicyForAll) = Nothing
  normalizePolicyAction otherwise = otherwise
  
  normalizeTable :: CreateTable -> (CreateTable, [Statement])
  normalizeTable table@(CreateTable { .. }) = ( CreateTable { columns = fst normalizedColumns, constraints = normalizedTableConstraints, .. }, (concat $ (snd normalizedColumns)) <> normalizedConstraintsStatements )
      where
          normalizedColumns = columns
                  |> map (normalizeColumn table)
                  |> unzip
  
          -- pg_dump typically inlines the table constraints into the CREATE TABLE statement like this:
          --
          -- > CREATE TABLE public.a (
          -- >     id uuid DEFAULT public.uuid_generate_v4() NOT NULL,
          -- >     CONSTRAINT c CHECK 1=1
          -- > );
          --
          -- In IHP we typically split this into a 'CREATE TABLE' statement and into a 'ALTER TABLE .. ADD CONSTRAINT ..' statement.
          --
          -- We normalize the above statement to this:
          --
          -- > CREATE TABLE public.a (
          -- >     id uuid DEFAULT public.uuid_generate_v4() NOT NULL
          -- > );
          -- > ALTER TABLE a ADD CONSTRAINT c CHECK 1=1;
          normalizedCheckConstraints :: [Either Statement Constraint]
          normalizedCheckConstraints = constraints
                  |> map \case
                      checkConstraint@(CheckConstraint {}) -> Left AddConstraint { tableName = name, constraint = checkConstraint, deferrable = Nothing, deferrableType = Nothing }
                      otherConstraint -> Right otherConstraint
  
          normalizedTableConstraints :: [Constraint]
          normalizedTableConstraints =
              normalizedCheckConstraints
              |> mapMaybe \case
                  Left _ -> Nothing
                  Right c -> Just c
  
          normalizedConstraintsStatements :: [Statement]
          normalizedConstraintsStatements =
              normalizedCheckConstraints
              |> mapMaybe \case
                  Right _ -> Nothing
                  Left c -> Just c
  
  normalizeConstraint :: Text -> Constraint -> Constraint
  normalizeConstraint _ ForeignKeyConstraint { name, columnName, referenceTable, referenceColumn, onDelete } = ForeignKeyConstraint { name = truncateIdentifier <$> name, columnName = Text.toLower columnName, referenceTable = Text.toLower referenceTable, referenceColumn = fmap Text.toLower referenceColumn, onDelete = Just (fromMaybe NoAction onDelete) }
  normalizeConstraint tableName constraint@(UniqueConstraint { name = Just uniqueName, columnNames }) | length columnNames > 1 =
          -- Single column UNIQUE constraints like:
          --
          -- > ALTER TABLE ONLY public.users ADD CONSTRAINT users_github_user_id_key UNIQUE (github_user_id);
          --
          -- are packed into the CREATE TABLE definition:
          --
          -- > CREATE TABLE users (
          -- >     id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
          -- >     github_user_id INT DEFAULT NULL UNIQUE
          -- > );
          --
          -- For multi columns we need to normalize the name, e.g.:
          --
          -- > ALTER TABLE days ADD UNIQUE (category_id, date);
          --
          -- Is the same as:
          --
          -- > ALTER TABLE ONLY public.days ADD CONSTRAINT days_category_id_date_key UNIQUE (category_id, date);
          --
          let
              defaultName = ([tableName] <> columnNames <> ["key"])
                      |> Text.intercalate "_" 
          in
              if uniqueName == defaultName
                  then constraint { name = Nothing }
                  else constraint
  normalizeConstraint _ otherwise = otherwise
  
  normalizeColumn :: CreateTable -> Column -> (Column, [Statement])
  normalizeColumn table Column { name, columnType, defaultValue, notNull, isUnique, generator } = (Column { name = normalizeName name, columnType = normalizeSqlType columnType, defaultValue = normalizedDefaultValue, notNull, isUnique = False, generator = normalizeColumnGenerator <$> generator }, uniqueConstraint)
      where
          uniqueConstraint =
              if isUnique
                  then [ AddConstraint { tableName = table.name, constraint = UniqueConstraint (Just $ (table.name) <>"_" <> name <> "_key") [name], deferrable = Nothing, deferrableType = Nothing } ]
                  else []
  
          normalizeName :: Text -> Text
          normalizeName nane = Text.toLower name
  
          normalizedDefaultValue = case defaultValue of
              Just defaultValue -> Just (normalizeExpression defaultValue)
              Nothing -> if notNull || isJust generator
                  then Nothing
                  else Just (VarExpression "null") -- pg_dump columns don't have an explicit default null value
  
  normalizeColumnGenerator :: ColumnGenerator -> ColumnGenerator
  normalizeColumnGenerator generator@(ColumnGenerator { generate }) = generator { generate = normalizeExpression generate }
  
  normalizeExpression :: Expression -> Expression
  normalizeExpression e@(TextExpression {}) = e
  normalizeExpression (VarExpression var) = VarExpression (Text.toLower var)
  normalizeExpression (CallExpression function args) = CallExpression (Text.toLower function) (map normalizeExpression args)
  normalizeExpression (NotEqExpression a b) = NotEqExpression (normalizeExpression a) (normalizeExpression b)
  normalizeExpression (EqExpression a b) = EqExpression (normalizeExpression a) (normalizeExpression b)
  normalizeExpression (AndExpression a b) = AndExpression (normalizeExpression a) (normalizeExpression b)
  normalizeExpression (IsExpression a b) = IsExpression (normalizeExpression a) (normalizeExpression b)
  normalizeExpression (InExpression a b) = InExpression (normalizeExpression a) (normalizeExpression b)
  normalizeExpression (NotExpression a) = NotExpression (normalizeExpression a)
  normalizeExpression (OrExpression a b) = OrExpression (normalizeExpression a) (normalizeExpression b)
  normalizeExpression (LessThanExpression a b) = LessThanExpression (normalizeExpression a) (normalizeExpression b)
  normalizeExpression (LessThanOrEqualToExpression a b) = LessThanOrEqualToExpression (normalizeExpression a) (normalizeExpression b)
  normalizeExpression (GreaterThanExpression a b) = GreaterThanExpression (normalizeExpression a) (normalizeExpression b)
  normalizeExpression (GreaterThanOrEqualToExpression a b) = GreaterThanOrEqualToExpression (normalizeExpression a) (normalizeExpression b)
  normalizeExpression e@(DoubleExpression {}) = e
  normalizeExpression e@(IntExpression {}) = e
  normalizeExpression (ConcatenationExpression a b) = ConcatenationExpression (normalizeExpression a) (normalizeExpression b)
  -- Enum default values from pg_dump always have an explicit type cast. Inside the Schema.sql they typically don't have those.
  -- Therefore we remove these typecasts here
  --
  -- 'job_status_not_started'::public.job_status => 'job_status_not_started'
  --
  normalizeExpression (TypeCastExpression a b) = normalizeExpression a
  normalizeExpression (SelectExpression Select { columns, from, whereClause, alias }) = SelectExpression Select { columns = resolveAlias' <$> (normalizeExpression <$> columns), from = normalizeFrom from, whereClause = resolveAlias' (normalizeExpression whereClause), alias = Nothing }
      where
          -- Turns a `SELECT 1 FROM a` into `SELECT 1 FROM public.a`
          normalizeFrom (VarExpression a) = DotExpression (VarExpression "public") a
          normalizeFrom otherwise = normalizeExpression otherwise
  
          resolveAlias' = resolveAlias alias (unqualifiedName from)
  
          unqualifiedName :: Expression -> Expression
          unqualifiedName (DotExpression (VarExpression _) name) = VarExpression name
          unqualifiedName name = name
  normalizeExpression (DotExpression a b) = DotExpression (normalizeExpression a) b
  normalizeExpression (ExistsExpression a) = ExistsExpression (normalizeExpression a)
  
  -- | Replaces @table.field@ with just @field@
  --
  -- >>> unqualifyExpression "servers" (sql "SELECT * FROM servers WHERE servers.is_public")
  -- sql "SELECT * FROM servers WHERE is_public"
  --
  unqualifyExpression :: Text -> Expression -> Expression
  unqualifyExpression scope expression = doUnqualify expression
      where
          doUnqualify e@(TextExpression {}) = e
          doUnqualify e@(VarExpression {}) = e
          doUnqualify (CallExpression function args) = CallExpression function (map doUnqualify args)
          doUnqualify (NotEqExpression a b) = NotEqExpression (doUnqualify a) (doUnqualify b)
          doUnqualify (EqExpression a b) = EqExpression (doUnqualify a) (doUnqualify b)
          doUnqualify (AndExpression a b) = AndExpression (doUnqualify a) (doUnqualify b)
          doUnqualify (IsExpression a b) = IsExpression (doUnqualify a) (doUnqualify b)
          doUnqualify (InExpression a b) = InExpression (doUnqualify a) (doUnqualify b)
          doUnqualify (NotExpression a) = NotExpression (doUnqualify a)
          doUnqualify (OrExpression a b) = OrExpression (doUnqualify a) (doUnqualify b)
          doUnqualify (LessThanExpression a b) = LessThanExpression (doUnqualify a) (doUnqualify b)
          doUnqualify (LessThanOrEqualToExpression a b) = LessThanOrEqualToExpression (doUnqualify a) (doUnqualify b)
          doUnqualify (GreaterThanExpression a b) = GreaterThanExpression (doUnqualify a) (doUnqualify b)
          doUnqualify (GreaterThanOrEqualToExpression a b) = GreaterThanOrEqualToExpression (doUnqualify a) (doUnqualify b)
          doUnqualify e@(DoubleExpression {}) = e
          doUnqualify e@(IntExpression {}) = e
          doUnqualify (ConcatenationExpression a b) = ConcatenationExpression (doUnqualify a) (doUnqualify b)
          doUnqualify (TypeCastExpression a b) = TypeCastExpression (doUnqualify a) b
          doUnqualify e@(SelectExpression Select { columns, from, whereClause, alias }) =
              let recurse = case from of
                      VarExpression fromName -> doUnqualify . unqualifyExpression fromName
                      DotExpression (VarExpression "public") fromName -> doUnqualify . unqualifyExpression fromName
                      _ -> doUnqualify
              in
                  SelectExpression Select { columns = (recurse <$> columns), from = from, whereClause = recurse whereClause, alias }
          doUnqualify (ExistsExpression a) = ExistsExpression (doUnqualify a)
          doUnqualify (DotExpression (VarExpression scope') b) | scope == scope' = VarExpression b
          doUnqualify (DotExpression a b) = DotExpression (doUnqualify a) b
  
  
  resolveAlias :: Maybe Text -> Expression -> Expression -> Expression
  resolveAlias (Just alias) fromExpression expression =
      let
          rec = resolveAlias (Just alias) fromExpression
      in case expression of
          e@(TextExpression {}) -> e
          e@(VarExpression var) -> if var == alias
                      then fromExpression
                      else e
          e@(CallExpression function args) -> CallExpression function (map rec args)
          e@(NotEqExpression a b) -> NotEqExpression (rec a) (rec b)
          e@(EqExpression a b) -> EqExpression (rec a) (rec b)
          e@(AndExpression a b) -> AndExpression (rec a) (rec b)
          e@(IsExpression a b) -> IsExpression (rec a) (rec b)
          e@(InExpression a b) -> InExpression (rec a) (rec b)
          e@(NotExpression a) -> NotExpression (rec a)
          e@(OrExpression a b) -> OrExpression (rec a) (rec b)
          e@(LessThanExpression a b) -> LessThanExpression (rec a) (rec b)
          e@(LessThanOrEqualToExpression a b) -> LessThanOrEqualToExpression (rec a) (rec b)
          e@(GreaterThanExpression a b) -> GreaterThanExpression (rec a) (rec b)
          e@(GreaterThanOrEqualToExpression a b) -> GreaterThanOrEqualToExpression (rec a) (rec b)
          e@(DoubleExpression {}) -> e
          e@(IntExpression {}) -> e
          e@(TypeCastExpression a b) -> (TypeCastExpression (rec a) b)
          e@(SelectExpression Select { columns, from, whereClause, alias }) -> SelectExpression Select { columns = rec <$> columns, from = rec from, whereClause = rec whereClause, alias = alias }
          e@(DotExpression a b) -> DotExpression (rec a) b
          e@(ExistsExpression a) -> ExistsExpression (rec a)
  resolveAlias Nothing fromExpression expression = expression
  
  normalizeSqlType :: PostgresType -> PostgresType
  normalizeSqlType (PCustomType customType) = PCustomType (Text.toLower customType)
  normalizeSqlType PBigserial = PBigInt
  normalizeSqlType PSerial = PInt
  normalizeSqlType otherwise = otherwise
  
  migrationPathFromPlan :: [GeneratorAction] -> Text
  migrationPathFromPlan plan =
          let (Just path) = plan
                  |> find \case
                      CreateFile {} -> True
                      otherwise     -> False
                  |> \case
                      Just CreateFile { filePath } -> Just filePath
                      otherwise                    -> Nothing
          in
              path
  
  -- | Removes @ALTER TABLE .. ADD CONSTRAINT .._pkey PRIMARY KEY (id);@ and moves it into the 'primaryKeyConstraint' field of the 'CreateTable'  statement
  --
  -- pg_dump dumps a table like this:
  --
  -- > CREATE TABLE a (
  -- >     id uuid DEFAULT uuid_generate_v4() NOT NULL
  -- > );
  -- >
  -- > ALTER TABLE a ADD CONSTRAINT users_pkey PRIMARY KEY (id);
  --
  -- This function basically removes the @ALTER TABLE@ statements and moves the primary key directly into the @CREATE TABLE@ statement:
  --
  -- > CREATE TABLE a (
  -- >     id uuid DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
  -- > );
  --
  normalizePrimaryKeys :: [Statement] -> [Statement]
  normalizePrimaryKeys statements = reverse $ normalizePrimaryKeys' [] statements
      where
          normalizePrimaryKeys' normalizedStatements ((AddConstraint { tableName, constraint = AlterTableAddPrimaryKey { primaryKeyConstraint } }):rest) =
              normalizePrimaryKeys'
                  (normalizedStatements
                      |> map \case
                          StatementCreateTable { unsafeGetCreateTable = table@(CreateTable { name }) } | name == tableName -> StatementCreateTable { unsafeGetCreateTable = addPK primaryKeyConstraint table }
                          otherwise -> otherwise
                  )
                  (rest)
          normalizePrimaryKeys' normalizedStatements (statement:rest) = normalizePrimaryKeys' (statement:normalizedStatements) rest
          normalizePrimaryKeys' normalizedStatements [] = normalizedStatements
  
          addPK :: PrimaryKeyConstraint -> CreateTable -> CreateTable
          addPK PrimaryKeyConstraint { primaryKeyColumnNames } table@(CreateTable { primaryKeyConstraint = PrimaryKeyConstraint { primaryKeyColumnNames = existingPKs } }) = table { primaryKeyConstraint = PrimaryKeyConstraint { primaryKeyColumnNames = existingPKs <> primaryKeyColumnNames } }
  
  
  -- | Removes @DROP INDEX ..@ statements and other that appear after a @DROP TABLE@ statement. The @DROP TABLE ..@ statement
  -- itself already removes indexes and foreigns keys on that table. So an @DROP INDEX ..@ would then fail.
  --
  -- Shrinks a sequence like this:
  --
  -- > DROP TABLE a;
  -- > DROP INDEX some_index_on_table_a;
  -- > ALTER TABLE a DROP CONSTRAINT some_constraint_on_table_a;
  --
  -- Into this:
  --
  -- > DROP TABLE a;
  --
  removeImplicitDeletions :: [Statement] -> [Statement] -> [Statement]
  removeImplicitDeletions actualSchema (statement@dropStatement:rest) | isDropStatement dropStatement = statement:(filter isImplicitlyDeleted rest)
      where
          isImplicitlyDeleted (DropIndex { indexName }) = case findIndexByName indexName of
                  Just CreateIndex { tableName = indexTableName, columns = indexColumns } -> indexTableName /= dropTableName && (
                          case dropColumnName of
                              Just dropColumnName -> indexColumns
                                      |> find (\IndexColumn { column } -> column == VarExpression dropColumnName)
                                      |> isNothing
                              Nothing -> True
                      )
                  Nothing -> True
          isImplicitlyDeleted (DropConstraint { tableName = constraintTableName }) = constraintTableName /= dropTableName
          isImplicitlyDeleted (DropPolicy { tableName = policyTableName }) = not (isNothing dropColumnName && policyTableName == dropTableName)
          isImplicitlyDeleted otherwise = True
  
          findIndexByName :: Text -> Maybe Statement
          findIndexByName name = find (isIndex name) actualSchema
  
          isIndex :: Text -> Statement -> Bool
          isIndex name CreateIndex { indexName } = indexName == name
          isIndex _    _                         = False
  
          isDropStatement DropTable {} = True
          isDropStatement DropColumn {} = True
          isDropStatement _ = False
  
          (dropTableName, dropColumnName) = case dropStatement of
              DropTable { tableName } -> (tableName, Nothing)
              DropColumn { tableName, columnName } -> (tableName, Just columnName)
  removeImplicitDeletions actualSchema (statement:rest) = statement:(removeImplicitDeletions actualSchema rest)
  removeImplicitDeletions actualSchema [] = []
  
  -- | Moves statements that add enum values outside the database transaction
  --
  -- When IHP generates a migration that contains a statement like this:
  --
  -- > ALTER TYPE my_enum ADD VALUE 'some_value';
  --
  -- the migration will fail with this error:
  --
  -- > Query (89.238182ms): "BEGIN" ()
  -- > migrate: SqlError {sqlState = "25001", sqlExecStatus = FatalError, sqlErrorMsg = "ALTER TYPE ... ADD cannot run inside a transaction block", sqlErrorDetail = "", sqlErrorHint = ""}
  --
  -- This function moves the @ADD VALUE@ statement outside the main database transaction:
  --
  -- > COMMIT; -- Commit the transaction previously started by IHP
  -- > ALTER TYPE my_enum ADD VALUE 'some_value';
  -- > BEGIN; -- Restart the connection as IHP will also try to run it's own COMMIT
  --
  disableTransactionWhileAddingEnumValues :: [Statement] -> [Statement]
  disableTransactionWhileAddingEnumValues statements =
          if isEmpty addEnumValueStatements
              then otherStatements
              else [Comment " Commit the transaction previously started by IHP", Commit] <> (map enableIfNotExists addEnumValueStatements) <> [Comment " Restart the connection as IHP will also try to run it's own COMMIT", Begin] <> otherStatements
      where
          (addEnumValueStatements, otherStatements) = partition isAddEnumValueStatement statements
  
          isAddEnumValueStatement AddValueToEnumType {} = True
          isAddEnumValueStatement otherwise = False
  
          enableIfNotExists statement@(AddValueToEnumType { .. }) = statement { ifNotExists = True }
          enableIfNotExists otherwise = otherwise
  
  normalizeIndexType :: Maybe IndexType -> Maybe IndexType
  normalizeIndexType (Just Btree) = Nothing
  normalizeIndexType indexType = indexType
  
  normalizeIndexColumn :: IndexColumn -> IndexColumn
  normalizeIndexColumn IndexColumn { column, columnOrder } =
      IndexColumn
          { column = normalizeExpression column
          , columnOrder = normalizeIndexColumnOrder columnOrder
          }
  
  normalizeIndexColumnOrder :: [IndexColumnOrder] -> [IndexColumnOrder]
  normalizeIndexColumnOrder columnOrder = columnOrder |> filter (/=Asc)
  
  normalizeNewLines :: Text -> Text
  normalizeNewLines text =
      text
      |> Text.replace "\r\n" "\n"
      |> Text.replace "\r" "\n"
  
  
  removeIndentation :: Text -> Text
  removeIndentation text =
          lines
          |> map (\line -> if line /= "BEGIN"
                  then Text.drop spacesToDrop line
                  else line)
          |> Text.unlines
          |> Text.dropAround (\c -> c == '\n')
      where
          lines :: [Text]
          lines = text
                  |> Text.lines
          spaces :: [Int]
          spaces = lines
                  |> filter (\line -> line /= "" && line /= "BEGIN")
                  |> map (\line -> Text.length (Text.takeWhile Char.isSpace line))
          spacesToDrop = spaces |> minimum
  
  -- | Postgres truncates identifiers longer than 63 characters.
  --
  -- This function truncates a Text to 63 chars max. This way we avoid unnecssary changes in the generated migrations.
  truncateIdentifier :: Text -> Text
  truncateIdentifier identifier =
      if Text.length identifier > 63
          then Text.take 63 identifier
          else identifier
  