{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}

{- |
Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

Facilities for performing some database migrations automatically.
See 'autoMigrateSchema' as a primary, high-level entry point.

@since 1.0.0.0
-}
module Orville.PostgreSQL.AutoMigration
  ( MigrationOptions (runSchemaChanges, runConcurrentIndexCreations, migrationLockId)
  , defaultOptions
  , autoMigrateSchema
  , SchemaItem (..)
  , schemaItemSummary
  , MigrationPlan
  , generateMigrationPlan
  , migrationPlanSteps
  , executeMigrationPlan
  , MigrationStep
  , MigrationDataError
  , MigrationLock.MigrationLockId
  , MigrationLock.defaultLockId
  , MigrationLock.nextLockId
  , MigrationLock.withMigrationLock
  , MigrationLock.MigrationLockError
  )
where

import Control.Exception.Safe (Exception, throwIO)
import Control.Monad (guard, when)
import Control.Monad.IO.Class (liftIO)
import Data.Foldable (traverse_)
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)
import qualified Data.Map.Strict as Map
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Data.String as String
import qualified Data.Text.Encoding as Enc
import qualified Database.PostgreSQL.LibPQ as LibPQ

import qualified Orville.PostgreSQL as Orville
import qualified Orville.PostgreSQL.Expr as Expr
import qualified Orville.PostgreSQL.Internal.IndexDefinition as IndexDefinition
import qualified Orville.PostgreSQL.Internal.MigrationLock as MigrationLock
import qualified Orville.PostgreSQL.PgCatalog as PgCatalog
import qualified Orville.PostgreSQL.Raw.RawSql as RawSql
import qualified Orville.PostgreSQL.Schema as Schema

{- |
  A 'SchemaItem' represents a single item in a database schema such as a table,
  index or constraint. The constructor functions below can be used to create
  items from other types (such as 'Orville.TableDefinition') to put them into
  a list to be used with 'autoMigrateSchema'.

@since 1.0.0.0
-}
data SchemaItem where
  -- |
  --    Constructs a 'SchemaItem' from a 'Orville.TableDefinition'.
  -- @since 1.0.0.0
  SchemaTable ::
    Orville.TableDefinition key writeEntity readEntity ->
    SchemaItem
  -- |
  --    Constructs a 'SchemaItem' that will drop the specified table if it is
  --    found in the database.
  -- @since 1.0.0.0
  SchemaDropTable ::
    Orville.TableIdentifier ->
    SchemaItem
  -- |
  --    Constructs a 'SchemaItem' from a 'Orville.SequenceDefinition'.
  -- @since 1.0.0.0
  SchemaSequence ::
    Orville.SequenceDefinition ->
    SchemaItem
  -- |
  --    Constructs a 'SchemaItem' that will drop the specified table if it is
  --    found in the database.
  -- @since 1.0.0.0
  SchemaDropSequence ::
    Orville.SequenceIdentifier ->
    SchemaItem

{- |
  Returns a one-line string describing the 'SchemaItem', suitable for a human
  to identify it in a list of output.

  For example, a 'SchemaItem' constructed via 'SchemaTable' gives @Table <table
  name>@.

@since 1.0.0.0
-}
schemaItemSummary :: SchemaItem -> String
schemaItemSummary item =
  case item of
    SchemaTable tableDef ->
      "Table " <> Orville.tableIdToString (Orville.tableIdentifier tableDef)
    SchemaDropTable tableId ->
      "Drop table " <> Orville.tableIdToString tableId
    SchemaSequence sequenceDef ->
      "Sequence " <> Orville.sequenceIdToString (Orville.sequenceIdentifier sequenceDef)
    SchemaDropSequence sequenceId ->
      "Drop sequence " <> Orville.sequenceIdToString sequenceId

{- |
A 'MigrationPlan' contains an ordered list of migration steps. Each one is a
single DDL statement to make a specific database change. The steps are ordered
such that dependencies from earlier steps will be in place before a later step
is executed (e.g. new columns are added before foreign keys referring to them).

While most steps are executed together in a single transaction this is not
possible for indexes being created concurrently. Any such steps are executed
last after the transaction for the rest of the schema changes has been
successfully committed.

@since 1.0.0.0
-}
data MigrationPlan = MigrationPlan
  { i_transactionalSteps :: [MigrationStep]
  , i_concurrentIndexSteps :: [MigrationStep]
  }

{- |
  Returns all the 'MigrationStep's found in a 'MigrationPlan' together in a
  single list. This is useful if you merely want to examine the steps of a plan
  rather than execute them. You should always use 'executeMigrationPlan' to
  execute a migration plan to ensure that the transactional steps are done
  within a transaction while the concurrent index steps are done afterward
  outside of it.

@since 1.0.0.0
-}
migrationPlanSteps :: MigrationPlan -> [MigrationStep]
migrationPlanSteps plan =
  i_transactionalSteps plan <> i_concurrentIndexSteps plan

mkMigrationPlan :: [MigrationStepWithType] -> MigrationPlan
mkMigrationPlan steps =
  let
    (transactionalSteps, concurrentIndexSteps) =
      List.partition isMigrationStepTransactional
        . List.sortOn migrationStepType
        $ steps
  in
    MigrationPlan
      { i_transactionalSteps = map migrationStep transactionalSteps
      , i_concurrentIndexSteps = map migrationStep concurrentIndexSteps
      }

{- |
  A single SQL statement that will be executed in order to migrate the database
  to the desired result. You can use 'generateMigrationPlan' to get a list
  of these yourself for inspection and debugging.

@since 1.0.0.0
-}
newtype MigrationStep
  = MigrationStep RawSql.RawSql
  deriving
    ( -- | @since 1.0.0.0
      RawSql.SqlExpression
    )

{- |
  This type is used internally by Orville to order the migration steps after
  they have been created. It is not exposed outside this module.

@since 1.0.0.0
-}
data MigrationStepWithType = MigrationStepWithType
  { migrationStepType :: StepType
  , migrationStep :: MigrationStep
  }

mkMigrationStepWithType ::
  RawSql.SqlExpression sql =>
  StepType ->
  sql ->
  MigrationStepWithType
mkMigrationStepWithType stepType sql =
  MigrationStepWithType
    { migrationStepType = stepType
    , migrationStep = MigrationStep (RawSql.toRawSql sql)
    }

isMigrationStepTransactional :: MigrationStepWithType -> Bool
isMigrationStepTransactional stepWithType =
  case migrationStepType stepWithType of
    DropForeignKeys -> True
    DropUniqueConstraints -> True
    DropIndexes -> True
    AddRemoveTablesAndColumns -> True
    AddIndexesTransactionally -> True
    AddUniqueConstraints -> True
    AddForeignKeys -> True
    AddIndexesConcurrently -> False

{- |
  Indicates the kind of operation being performed by a 'MigrationStep' so
  that the steps can be ordered in a sequence that is guaranteed to succeed.
  The order of the constructors below indicates the order in which steps will
  be run.

@since 1.0.0.0
-}
data StepType
  = DropForeignKeys
  | DropUniqueConstraints
  | DropIndexes
  | AddRemoveTablesAndColumns
  | AddIndexesTransactionally
  | AddUniqueConstraints
  | AddForeignKeys
  | AddIndexesConcurrently
  deriving
    ( -- | @since 1.0.0.0
      Eq
    , -- | @since 1.0.0.0
      Ord
    )

{- |
  A 'MigrationDataError' will be thrown from the migration functions if data
  necessary for migration cannot be found.

@since 1.0.0.0
-}
data MigrationDataError
  = UnableToDiscoverCurrentSchema String
  | PgCatalogInvariantViolated String
  deriving
    ( -- | @since 1.0.0.0
      Show
    )

-- | @since 1.0.0.0
instance Exception MigrationDataError

{- |
Options to control how 'autoMigrateSchema' and similar functions behave. You
should use 'defaultOptions' to construct a 'MigrationOptions' value
and then use the record accessors to change any values you want to customize.

@since 1.0.0.0
-}
data MigrationOptions = MigrationOptions
  { runSchemaChanges :: Bool
  -- ^
  --       Indicates whether the normal schema changes (other than concurrent index
  --       creations) should be run. The default value is 'True'. You may want to
  --       disable this if you wish to run concurrent index creations separately
  --       from the rest of the schema changes.
  --
  --       @since 1.0.0.0
  , runConcurrentIndexCreations :: Bool
  -- ^
  --       Indicates whether indexes with the 'Orville.Concurrent' creation strategy
  --       will be created. The default value is 'True'. You may want to disable
  --       this if you wish to run concurrent index creations separately from the
  --       rest of the schema changes.
  --
  --       @since 1.0.0.0
  , migrationLockId :: MigrationLock.MigrationLockId
  -- ^
  --       The 'MigrationLock.MigrationLockId' that will be use to ensure only
  --       one application is running migrations at a time. The default value
  --       is 'MigrationLock.defaultLockId'. You may want to change this if you
  --       want to run concurrent index creations separately from the rest of
  --       the schema changes without blocking one another.
  --
  --       @since 1.0.0.0
  }

{- |
The default 'MigrationOptions', which is to run both the schema changes and
concurrent index creations together using the default Orville migration lock.

@since 1.0.0.0
-}
defaultOptions :: MigrationOptions
defaultOptions =
  MigrationOptions
    { runSchemaChanges = True
    , runConcurrentIndexCreations = True
    , migrationLockId = MigrationLock.defaultLockId
    }

{- |
  This function compares the list of 'SchemaItem's provided against the current
  schema found in the database to determine whether any migrations are
  necessary.  If any changes need to be made, this function executes. You can
  call 'generateMigrationPlan' and 'executeMigrationPlan' yourself if you want
  to have more control over the process, but must then take care to ensure that
  the schema has not changed between the two calls. This function uses a
  PostgreSQL advisory lock to ensure that no other calls to 'autoMigrateSchema'
  (potentially on other processes) attempt to modify the schema at the same
  time.

@since 1.0.0.0
-}
autoMigrateSchema ::
  Orville.MonadOrville m =>
  MigrationOptions ->
  [SchemaItem] ->
  m ()
autoMigrateSchema options schemaItems =
  MigrationLock.withMigrationLock (migrationLockId options) $ do
    plan <- generateMigrationPlanWithoutLock schemaItems
    executeMigrationPlanWithoutLock options plan

{- |
  Compares the list of 'SchemaItem's provided against the current schema found
  in the database and returns a 'MigrationPlan' that could be executed to make
  the database schema match the items given.

  You can execute the 'MigrationPlan' yourself using the 'executeMigrationPlan'
  convenience function, though 'autoMigrateSchema' is usually a better option
  because it uses a database lock to ensure that no other processes are also
  using 'autoMigrateSchema' to apply migrations at the same time. If you use
  'generateMigrationPlan' and 'executeMigrationPlan' separately, you are
  responsible for ensuring that the schema has not changed between the time the
  plan is generated and executed yourself.

@since 1.0.0.0
-}
generateMigrationPlan ::
  Orville.MonadOrville m =>
  MigrationOptions ->
  [SchemaItem] ->
  m MigrationPlan
generateMigrationPlan options =
  MigrationLock.withMigrationLock (migrationLockId options)
    . generateMigrationPlanWithoutLock

generateMigrationPlanWithoutLock :: Orville.MonadOrville m => [SchemaItem] -> m MigrationPlan
generateMigrationPlanWithoutLock schemaItems =
  Orville.withTransaction $ do
    currentNamespace <- findCurrentNamespace

    let
      pgCatalogRelations = fmap (schemaItemPgCatalogRelation currentNamespace) schemaItems

    dbDesc <- PgCatalog.describeDatabaseRelations pgCatalogRelations

    case traverse (calculateMigrationSteps currentNamespace dbDesc) schemaItems of
      Left err ->
        liftIO . throwIO $ err
      Right migrationSteps ->
        pure . mkMigrationPlan . concat $ migrationSteps

{- |
  Executes a 'MigrationPlan' that has been previously devised via
  'generateMigrationPlan'. Normally all the steps in a migration plan are
  executed in a transaction so that they will all be applied together
  successfully or all rolled-back if one of them fails. Any indexes using the
  'Orville.Concurrent' creation strategy cannot be created this way, however,
  because PostgreSQL does not allow @CREATE INDEX CONCURRENTLY@ to be used from
  inside a transaction. If a 'MigrationPlan' includes any indexes whose
  creation strategy is set to 'Orville.Concurrent', Orville will create indexes
  after the rest of the migration steps have been committed successfully. This
  function will wait until all of the migration steps that it runs to finish
  before returning. If one of the concurrent indexes fails during creation, it
  will be left in an invalid state (as is the default PostgreSQL behavior). You
  should check on the status of indexes created this way manually to ensure
  they were created successfully. If they could not be, you can drop them and
  Orville will re-attempt creating them the next time migration is performed.

@since 1.0.0.0
-}
executeMigrationPlan ::
  Orville.MonadOrville m =>
  MigrationOptions ->
  MigrationPlan ->
  m ()
executeMigrationPlan options =
  MigrationLock.withMigrationLock (migrationLockId options)
    . executeMigrationPlanWithoutLock options

executeMigrationPlanWithoutLock ::
  Orville.MonadOrville m =>
  MigrationOptions ->
  MigrationPlan ->
  m ()
executeMigrationPlanWithoutLock options plan = do
  when (runSchemaChanges options)
    . Orville.withTransaction
    . executeMigrationStepsWithoutTransaction
    . i_transactionalSteps
    $ plan

  when (runConcurrentIndexCreations options)
    . executeMigrationStepsWithoutTransaction
    $ i_concurrentIndexSteps
    $ plan

executeMigrationStepsWithoutTransaction :: Orville.MonadOrville m => [MigrationStep] -> m ()
executeMigrationStepsWithoutTransaction =
  traverse_ (Orville.executeVoid Orville.DDLQuery)

calculateMigrationSteps ::
  PgCatalog.NamespaceName ->
  PgCatalog.DatabaseDescription ->
  SchemaItem ->
  Either MigrationDataError [MigrationStepWithType]
calculateMigrationSteps currentNamespace dbDesc schemaItem =
  case schemaItem of
    SchemaTable tableDef ->
      Right $
        let
          (schemaName, tableName) =
            tableIdToPgCatalogNames
              currentNamespace
              (Orville.tableIdentifier tableDef)
        in
          case PgCatalog.lookupRelationOfKind PgCatalog.OrdinaryTable (schemaName, tableName) dbDesc of
            Nothing ->
              mkCreateTableSteps currentNamespace tableDef
            Just relationDesc ->
              mkAlterTableSteps currentNamespace relationDesc tableDef
    SchemaDropTable tableId ->
      Right $
        let
          (schemaName, tableName) =
            tableIdToPgCatalogNames currentNamespace tableId
        in
          case PgCatalog.lookupRelation (schemaName, tableName) dbDesc of
            Nothing ->
              []
            Just _ ->
              let
                dropTableExpr =
                  Expr.dropTableExpr
                    Nothing
                    (Orville.tableIdQualifiedName tableId)
              in
                [mkMigrationStepWithType AddRemoveTablesAndColumns dropTableExpr]
    SchemaSequence sequenceDef ->
      let
        (schemaName, sequenceName) =
          sequenceIdToPgCatalogNames
            currentNamespace
            (Orville.sequenceIdentifier sequenceDef)
      in
        case PgCatalog.lookupRelationOfKind PgCatalog.Sequence (schemaName, sequenceName) dbDesc of
          Nothing ->
            Right
              [ mkMigrationStepWithType
                  AddRemoveTablesAndColumns
                  (Orville.mkCreateSequenceExpr sequenceDef)
              ]
          Just relationDesc ->
            case PgCatalog.relationSequence relationDesc of
              Nothing ->
                Left . PgCatalogInvariantViolated $
                  "Sequence "
                    <> PgCatalog.namespaceNameToString schemaName
                    <> "."
                    <> PgCatalog.relationNameToString sequenceName
                    <> " was found in the 'pg_class' table but no corresponding 'pg_sequence' row was found"
              Just pgSequence ->
                Right $
                  mkAlterSequenceSteps sequenceDef pgSequence
    SchemaDropSequence sequenceId ->
      Right $
        let
          (schemaName, sequenceName) =
            sequenceIdToPgCatalogNames currentNamespace sequenceId
        in
          case PgCatalog.lookupRelationOfKind PgCatalog.Sequence (schemaName, sequenceName) dbDesc of
            Nothing ->
              []
            Just _ ->
              [ mkMigrationStepWithType
                  AddRemoveTablesAndColumns
                  (Expr.dropSequenceExpr Nothing (Orville.sequenceIdQualifiedName sequenceId))
              ]

{- |
  Builds 'MigrationStep's that will perform table creation. This function
  assumes the table does not exist. The migration step it produces will fail if
  the table already exists in its schema. Multiple steps may be required to
  create the table if foreign keys exist to that reference other tables, which
  may not have been created yet.

@since 1.0.0.0
-}
mkCreateTableSteps ::
  PgCatalog.NamespaceName ->
  Orville.TableDefinition key writeEntity readEntity ->
  [MigrationStepWithType]
mkCreateTableSteps currentNamespace tableDef =
  let
    tableName =
      Orville.tableName tableDef

    -- constraints are not included in the create table expression because
    -- they are added in a separate migration step to avoid ordering problems
    -- when creating multiple tables with interrelated foreign keys.
    createTableExpr =
      Expr.createTableExpr
        tableName
        (Orville.mkTableColumnDefinitions tableDef)
        (Orville.mkTablePrimaryKeyExpr tableDef)
        []

    addConstraintActions =
      concatMap
        (mkAddConstraintActions currentNamespace Set.empty)
        (Schema.tableConstraintDefinitions $ Orville.tableConstraints tableDef)

    addIndexSteps =
      concatMap
        (mkAddIndexSteps Set.empty tableName)
        (Orville.tableIndexes tableDef)
  in
    mkMigrationStepWithType AddRemoveTablesAndColumns createTableExpr
      : mkConstraintSteps tableName addConstraintActions
        <> addIndexSteps

{- |
  Builds migration steps that are required to create or alter the table's
  schema to make it match the given table definition.

  This function uses the given relation description to determine what
  alterations need to be performed. If there is nothing to do, an empty list
  will be returned.

@since 1.0.0.0
-}
mkAlterTableSteps ::
  PgCatalog.NamespaceName ->
  PgCatalog.RelationDescription ->
  Orville.TableDefinition key writeEntity readEntity ->
  [MigrationStepWithType]
mkAlterTableSteps currentNamespace relationDesc tableDef =
  let
    addAlterColumnActions =
      concat $
        Orville.foldMarshallerFields
          (Orville.unannotatedSqlMarshaller $ Orville.tableMarshaller tableDef)
          []
          (Orville.collectFromField Orville.IncludeReadOnlyColumns (mkAddAlterColumnActions relationDesc))

    dropColumnActions =
      concatMap
        (mkDropColumnActions tableDef)
        (PgCatalog.relationAttributes relationDesc)

    existingConstraints =
      Set.fromList
        . Maybe.mapMaybe pgConstraintMigrationKey
        . PgCatalog.relationConstraints
        $ relationDesc

    constraintsToKeep =
      Set.map (setDefaultSchemaNameOnConstraintKey currentNamespace)
        . Schema.tableConstraintKeys
        . Orville.tableConstraints
        $ tableDef

    addConstraintActions =
      concatMap
        (mkAddConstraintActions currentNamespace existingConstraints)
        (Schema.tableConstraintDefinitions $ Orville.tableConstraints tableDef)

    dropConstraintActions =
      concatMap
        (mkDropConstraintActions constraintsToKeep)
        (PgCatalog.relationConstraints relationDesc)

    systemIndexOids =
      Set.fromList
        . Maybe.mapMaybe (pgConstraintImpliedIndexOid . PgCatalog.constraintRecord)
        . PgCatalog.relationConstraints
        $ relationDesc

    isSystemIndex indexDesc =
      Set.member
        (PgCatalog.pgIndexPgClassOid $ PgCatalog.indexRecord indexDesc)
        systemIndexOids

    existingIndexes =
      Set.fromList
        . concatMap pgIndexMigrationKeys
        . filter (not . isSystemIndex)
        . PgCatalog.relationIndexes
        $ relationDesc

    indexesToKeep =
      Map.keysSet
        . Orville.tableIndexes
        $ tableDef

    addIndexSteps =
      concatMap
        (mkAddIndexSteps existingIndexes tableName)
        (Orville.tableIndexes tableDef)

    dropIndexSteps =
      concatMap
        (mkDropIndexSteps indexesToKeep systemIndexOids)
        (PgCatalog.relationIndexes relationDesc)

    tableName =
      Orville.tableName tableDef
  in
    mkAlterColumnSteps tableName (addAlterColumnActions <> dropColumnActions)
      <> mkConstraintSteps tableName (addConstraintActions <> dropConstraintActions)
      <> addIndexSteps
      <> dropIndexSteps

{- |
  Consolidates alter table actions (which should all be related to adding and
  dropping constraints) into migration steps based on their 'StepType'. Actions
  with the same 'StepType' will be performed togethir in a single @ALTER TABLE@
  statement.

@since 1.0.0.0
-}
mkConstraintSteps ::
  Expr.Qualified Expr.TableName ->
  [(StepType, Expr.AlterTableAction)] ->
  [MigrationStepWithType]
mkConstraintSteps tableName actions =
  let
    mkMapEntry ::
      (StepType, Expr.AlterTableAction) ->
      (StepType, NonEmpty Expr.AlterTableAction)
    mkMapEntry (keyType, action) =
      (keyType, (action :| []))

    addStep stepType actionExprs steps =
      mkMigrationStepWithType stepType (Expr.alterTableExpr tableName actionExprs) : steps
  in
    Map.foldrWithKey addStep []
      . Map.fromListWith (<>)
      . map mkMapEntry
      $ actions

{- |
  If there are any alter table actions for adding or removing columns, creates a migration
  step to perform them. Otherwise returns an empty list.

@since 1.0.0.0
-}
mkAlterColumnSteps ::
  Expr.Qualified Expr.TableName ->
  [Expr.AlterTableAction] ->
  [MigrationStepWithType]
mkAlterColumnSteps tableName actionExprs =
  case nonEmpty actionExprs of
    Nothing ->
      []
    Just nonEmptyActionExprs ->
      [mkMigrationStepWithType AddRemoveTablesAndColumns (Expr.alterTableExpr tableName nonEmptyActionExprs)]

{- |
  Builds 'Expr.AlterTableAction' expressions to bring the database schema in
  line with the given 'Orville.FieldDefinition', or none if no change is
  required.

@since 1.0.0.0
-}
mkAddAlterColumnActions ::
  PgCatalog.RelationDescription ->
  Orville.FieldDefinition nullability a ->
  [Expr.AlterTableAction]
mkAddAlterColumnActions relationDesc fieldDef =
  let
    pgAttributeName =
      String.fromString (Orville.fieldNameToString $ Orville.fieldName fieldDef)
  in
    case PgCatalog.lookupAttribute pgAttributeName relationDesc of
      Just attr
        | PgCatalog.isOrdinaryColumn attr ->
            let
              sqlType =
                Orville.fieldType fieldDef

              typeIsChanged =
                (Orville.sqlTypeOid sqlType /= PgCatalog.pgAttributeTypeOid attr)
                  || (Orville.sqlTypeMaximumLength sqlType /= PgCatalog.pgAttributeMaxLength attr)

              columnName =
                Orville.fieldColumnName fieldDef

              dataType =
                Orville.sqlTypeExpr sqlType

              alterType = do
                guard typeIsChanged
                [Expr.alterColumnType columnName dataType (Just $ Expr.usingCast columnName dataType)]

              nullabilityIsChanged =
                Orville.fieldIsNotNullable fieldDef /= PgCatalog.pgAttributeIsNotNull attr

              nullabilityAction =
                if Orville.fieldIsNotNullable fieldDef
                  then Expr.setNotNull
                  else Expr.dropNotNull

              alterNullability = do
                guard nullabilityIsChanged
                [Expr.alterColumnNullability (Orville.fieldColumnName fieldDef) nullabilityAction]

              maybeExistingDefault =
                PgCatalog.lookupAttributeDefault attr relationDesc

              maybeDefaultExpr =
                Orville.defaultValueExpression
                  <$> Orville.fieldDefaultValue fieldDef

              (dropDefault, setDefault) =
                case (maybeExistingDefault, maybeDefaultExpr) of
                  (Nothing, Nothing) ->
                    (Nothing, Nothing)
                  (Just _, Nothing) ->
                    if Orville.sqlTypeDontDropImplicitDefaultDuringMigrate sqlType
                      then (Nothing, Nothing)
                      else
                        ( Just (Expr.alterColumnDropDefault columnName)
                        , Nothing
                        )
                  (Nothing, Just newDefault) ->
                    ( Nothing
                    , Just (Expr.alterColumnSetDefault columnName newDefault)
                    )
                  (Just oldDefault, Just newDefault) ->
                    let
                      oldDefaultExprBytes =
                        Enc.encodeUtf8
                          . PgCatalog.pgAttributeDefaultExpression
                          $ oldDefault

                      newDefaultExprBytes =
                        RawSql.toExampleBytes newDefault
                    in
                      if oldDefaultExprBytes == newDefaultExprBytes
                        then (Nothing, Nothing)
                        else
                          ( Just (Expr.alterColumnDropDefault columnName)
                          , Just (Expr.alterColumnSetDefault columnName newDefault)
                          )
            in
              Maybe.maybeToList dropDefault <> alterType <> Maybe.maybeToList setDefault <> alterNullability
      _ ->
        -- Either the column doesn't exist in the table _OR_ it's a system
        -- column. If it's a system column, attempting to add it will result
        -- in an error that will be reported to the user. We could explicitly
        -- return an error from this function, but that would make the error
        -- reporting inconsistent with the handling in create table, where we
        -- must rely on the database to raise the error because the table
        -- does not yet exist for us to discover a conflict with system
        -- attributes.
        [Expr.addColumn (Orville.fieldColumnDefinition fieldDef)]

{- |
  Builds 'Expr.AlterTableAction' expressions for the given attribute to make
  the database schema match the given 'Orville.TableDefinition'. This function
  is only responsible for handling cases where the attribute does not have a
  correspending 'Orville.FieldDefinition'. See 'mkAlterTableSteps' for those
  cases.

@since 1.0.0.0
-}
mkDropColumnActions ::
  Orville.TableDefinition key readEntity writeEntity ->
  PgCatalog.PgAttribute ->
  [Expr.AlterTableAction]
mkDropColumnActions tableDef attr = do
  let
    attrName =
      PgCatalog.attributeNameToString $ PgCatalog.pgAttributeName attr

  guard $ Set.member attrName (Orville.columnsToDrop tableDef)

  [Expr.dropColumn $ Expr.columnName attrName]

{- |
  Sets the schema name on a constraint to the given namespace when the
  constraint has no namespace explicitly given. This is important for Orville
  to discover whether a constraint from a table definition matches a constraint
  found to already exist in the database because constraints in the database
  always have schema names included with them.

@since 1.0.0.0
-}
setDefaultSchemaNameOnConstraintKey ::
  PgCatalog.NamespaceName ->
  Orville.ConstraintMigrationKey ->
  Orville.ConstraintMigrationKey
setDefaultSchemaNameOnConstraintKey currentNamespace constraintKey =
  case Orville.constraintKeyForeignTable constraintKey of
    Nothing ->
      constraintKey
    Just foreignTable ->
      case Orville.tableIdSchemaNameString foreignTable of
        Nothing ->
          constraintKey
            { Orville.constraintKeyForeignTable =
                Just $
                  Orville.setTableIdSchema
                    (PgCatalog.namespaceNameToString currentNamespace)
                    foreignTable
            }
        Just _ ->
          constraintKey

{- |
  Builds 'Expr.AlterTableAction' expressions to create the given table
  constraint if it does not exist.

@since 1.0.0.0
-}
mkAddConstraintActions ::
  PgCatalog.NamespaceName ->
  Set.Set Orville.ConstraintMigrationKey ->
  Orville.ConstraintDefinition ->
  [(StepType, Expr.AlterTableAction)]
mkAddConstraintActions currentNamespace existingConstraints constraintDef =
  let
    constraintKey =
      setDefaultSchemaNameOnConstraintKey currentNamespace $
        Orville.constraintMigrationKey constraintDef

    stepType =
      case Orville.constraintKeyType constraintKey of
        Orville.UniqueConstraint -> AddUniqueConstraints
        Orville.ForeignKeyConstraint -> AddForeignKeys
  in
    if Set.member constraintKey existingConstraints
      then []
      else [(stepType, Expr.addConstraint (Orville.constraintSqlExpr constraintDef))]

{- |
  Builds 'Expr.AlterTableAction' expressions to drop the given table
  constraint if it should not exist.

@since 1.0.0.0
-}
mkDropConstraintActions ::
  Set.Set Orville.ConstraintMigrationKey ->
  PgCatalog.ConstraintDescription ->
  [(StepType, Expr.AlterTableAction)]
mkDropConstraintActions constraintsToKeep constraint =
  case pgConstraintMigrationKey constraint of
    Nothing ->
      []
    Just constraintKey ->
      if Set.member constraintKey constraintsToKeep
        then []
        else
          let
            constraintName =
              Expr.constraintName
                . PgCatalog.constraintNameToString
                . PgCatalog.pgConstraintName
                . PgCatalog.constraintRecord
                $ constraint

            stepType =
              case Orville.constraintKeyType constraintKey of
                Orville.UniqueConstraint -> DropUniqueConstraints
                Orville.ForeignKeyConstraint -> DropForeignKeys
          in
            [(stepType, Expr.dropConstraint constraintName)]

{- |
  Builds the orville migration key for a description of an existing constraint
  so that it can be compared with constraints found in a table definition.
  Constraint keys built this way always have a schema name populated, so it's
  important to set the schema names for the constraints found in the table
  definition before comparing them. See 'setDefaultSchemaNameOnConstraintKey'.

  If the description is for a kind of constraint that Orville does not support,
  'Nothing' is returned.

@since 1.0.0.0
-}
pgConstraintMigrationKey ::
  PgCatalog.ConstraintDescription ->
  Maybe Orville.ConstraintMigrationKey
pgConstraintMigrationKey constraintDesc =
  let
    toOrvilleConstraintKeyType pgConType =
      case pgConType of
        PgCatalog.UniqueConstraint -> Just Orville.UniqueConstraint
        PgCatalog.ForeignKeyConstraint -> Just Orville.ForeignKeyConstraint
        _ -> Nothing

    constraint =
      PgCatalog.constraintRecord constraintDesc

    pgAttributeNamesToFieldNames =
      map (Orville.stringToFieldName . PgCatalog.attributeNameToString . PgCatalog.pgAttributeName)

    foreignRelationTableId :: PgCatalog.ForeignRelationDescription -> Orville.TableIdentifier
    foreignRelationTableId foreignRelationDesc =
      let
        relationName =
          PgCatalog.relationNameToString
            . PgCatalog.pgClassRelationName
            . PgCatalog.foreignRelationClass
            $ foreignRelationDesc

        namespaceName =
          PgCatalog.namespaceNameToString
            . PgCatalog.pgNamespaceName
            . PgCatalog.foreignRelationNamespace
            $ foreignRelationDesc
      in
        Orville.setTableIdSchema namespaceName $
          Orville.unqualifiedNameToTableId relationName
  in
    do
      keyType <- toOrvilleConstraintKeyType (PgCatalog.pgConstraintType constraint)
      pure $
        Orville.ConstraintMigrationKey
          { Orville.constraintKeyType = keyType
          , Orville.constraintKeyColumns =
              fmap
                pgAttributeNamesToFieldNames
                (PgCatalog.constraintKey constraintDesc)
          , Orville.constraintKeyForeignTable =
              fmap foreignRelationTableId (PgCatalog.constraintForeignRelation constraintDesc)
          , Orville.constraintKeyForeignColumns =
              fmap
                pgAttributeNamesToFieldNames
                (PgCatalog.constraintForeignKey constraintDesc)
          , Orville.constraintKeyForeignKeyOnUpdateAction =
              PgCatalog.pgConstraintForeignKeyOnUpdateType $ PgCatalog.constraintRecord constraintDesc
          , Orville.constraintKeyForeignKeyOnDeleteAction =
              PgCatalog.pgConstraintForeignKeyOnDeleteType $ PgCatalog.constraintRecord constraintDesc
          }

{- |
  Builds migration steps to create an index if it does not exist.

@since 1.0.0.0
-}
mkAddIndexSteps ::
  Set.Set IndexDefinition.IndexMigrationKey ->
  Expr.Qualified Expr.TableName ->
  Orville.IndexDefinition ->
  [MigrationStepWithType]
mkAddIndexSteps existingIndexes tableName indexDef =
  let
    indexKey =
      IndexDefinition.indexMigrationKey indexDef

    indexStep =
      case Orville.indexCreationStrategy indexDef of
        Orville.Transactional -> AddIndexesTransactionally
        Orville.Concurrent -> AddIndexesConcurrently
  in
    if Set.member indexKey existingIndexes
      then []
      else [mkMigrationStepWithType indexStep (Orville.indexCreateExpr indexDef tableName)]

{- |
  Builds migration steps to drop an index if it should not exist.

@since 1.0.0.0
-}
mkDropIndexSteps ::
  Set.Set IndexDefinition.IndexMigrationKey ->
  Set.Set LibPQ.Oid ->
  PgCatalog.IndexDescription ->
  [MigrationStepWithType]
mkDropIndexSteps indexesToKeep systemIndexOids indexDesc =
  case pgIndexMigrationKeys indexDesc of
    [] ->
      []
    indexKeys ->
      let
        pgClass =
          PgCatalog.indexPgClass indexDesc

        indexName =
          Expr.indexName
            . PgCatalog.relationNameToString
            . PgCatalog.pgClassRelationName
            $ pgClass

        indexOid =
          PgCatalog.pgClassOid pgClass
      in
        if any (flip Set.member indexesToKeep) indexKeys
          || Set.member indexOid systemIndexOids
          then []
          else [mkMigrationStepWithType DropIndexes (Expr.dropIndexExpr indexName)]

{- |
  Primary Key, Unique, and Exclusion constraints automatically create indexes
  that we don't want orville to consider for the purposes of migrations. This
  function checks the constraint type and returns the OID of the supporting
  index if the constraint is one of these types.

  Foreign key constraints also have a supporting index OID in @pg_catalog@, but
  this index is not automatically created due to the constraint, so we don't
  return the index's OID for that case.

@since 1.0.0.0
-}
pgConstraintImpliedIndexOid :: PgCatalog.PgConstraint -> Maybe LibPQ.Oid
pgConstraintImpliedIndexOid pgConstraint =
  case PgCatalog.pgConstraintType pgConstraint of
    PgCatalog.PrimaryKeyConstraint ->
      Just $ PgCatalog.pgConstraintIndexOid pgConstraint
    PgCatalog.UniqueConstraint ->
      Just $ PgCatalog.pgConstraintIndexOid pgConstraint
    PgCatalog.ExclusionConstraint ->
      Just $ PgCatalog.pgConstraintIndexOid pgConstraint
    PgCatalog.CheckConstraint ->
      Nothing
    PgCatalog.ForeignKeyConstraint ->
      Nothing
    PgCatalog.ConstraintTrigger ->
      Nothing

{- |
  Builds the orville migration keys given a description of an existing index
  so that it can be compared with indexs found in a table definition.

  If the description includes expressions as members of the index rather than
  simple attributes, 'Nothing' is returned.

@since 1.0.0.0
-}
pgIndexMigrationKeys ::
  PgCatalog.IndexDescription ->
  [IndexDefinition.IndexMigrationKey]
pgIndexMigrationKeys indexDesc =
  let
    mkNamedIndexKey =
      IndexDefinition.NamedIndexKey
        . PgCatalog.relationNameToString
        . PgCatalog.pgClassRelationName
        . PgCatalog.indexPgClass
        $ indexDesc
    mkAttributeBasedIndexKey =
      case pgAttributeBasedIndexMigrationKey indexDesc of
        Just standardKey ->
          [IndexDefinition.AttributeBasedIndexKey standardKey]
        Nothing ->
          []
  in
    [mkNamedIndexKey] ++ mkAttributeBasedIndexKey

pgAttributeBasedIndexMigrationKey ::
  PgCatalog.IndexDescription ->
  Maybe IndexDefinition.AttributeBasedIndexMigrationKey
pgAttributeBasedIndexMigrationKey indexDesc = do
  let
    indexMemberToFieldName member =
      case member of
        PgCatalog.IndexAttribute attr ->
          Just (Orville.stringToFieldName . PgCatalog.attributeNameToString . PgCatalog.pgAttributeName $ attr)
        PgCatalog.IndexExpression ->
          Nothing

    uniqueness =
      if PgCatalog.pgIndexIsUnique (PgCatalog.indexRecord indexDesc)
        then Orville.UniqueIndex
        else Orville.NonUniqueIndex

  fieldNames <- traverse indexMemberToFieldName (PgCatalog.indexMembers indexDesc)
  pure $
    IndexDefinition.AttributeBasedIndexMigrationKey
      { IndexDefinition.indexKeyUniqueness = uniqueness
      , IndexDefinition.indexKeyColumns = fieldNames
      }

schemaItemPgCatalogRelation ::
  PgCatalog.NamespaceName ->
  SchemaItem ->
  (PgCatalog.NamespaceName, PgCatalog.RelationName)
schemaItemPgCatalogRelation currentNamespace item =
  case item of
    SchemaTable tableDef ->
      tableIdToPgCatalogNames currentNamespace (Orville.tableIdentifier tableDef)
    SchemaDropTable tableId ->
      tableIdToPgCatalogNames currentNamespace tableId
    SchemaSequence sequenceDef ->
      sequenceIdToPgCatalogNames currentNamespace (Orville.sequenceIdentifier sequenceDef)
    SchemaDropSequence sequenceId ->
      sequenceIdToPgCatalogNames currentNamespace sequenceId

tableIdToPgCatalogNames ::
  PgCatalog.NamespaceName ->
  Orville.TableIdentifier ->
  (PgCatalog.NamespaceName, PgCatalog.RelationName)
tableIdToPgCatalogNames currentNamespace tableId =
  let
    actualNamespace =
      maybe currentNamespace String.fromString
        . Orville.tableIdSchemaNameString
        $ tableId

    relationName =
      String.fromString
        . Orville.tableIdUnqualifiedNameString
        $ tableId
  in
    (actualNamespace, relationName)

mkAlterSequenceSteps ::
  Orville.SequenceDefinition ->
  PgCatalog.PgSequence ->
  [MigrationStepWithType]
mkAlterSequenceSteps sequenceDef pgSequence =
  let
    ifChanged ::
      Eq a =>
      (a -> expr) ->
      (PgCatalog.PgSequence -> a) ->
      (Orville.SequenceDefinition -> a) ->
      Maybe expr
    ifChanged mkChange getOld getNew =
      if getOld pgSequence == getNew sequenceDef
        then Nothing
        else Just . mkChange . getNew $ sequenceDef

    mbIncrementByExpr =
      ifChanged Expr.incrementBy PgCatalog.pgSequenceIncrement Orville.sequenceIncrement

    mbMinValueExpr =
      ifChanged Expr.minValue PgCatalog.pgSequenceMin Orville.sequenceMinValue

    mbMaxValueExpr =
      ifChanged Expr.maxValue PgCatalog.pgSequenceMax Orville.sequenceMaxValue

    mbStartWithExpr =
      ifChanged Expr.startWith PgCatalog.pgSequenceStart Orville.sequenceStart

    mbCacheExpr =
      ifChanged Expr.cache PgCatalog.pgSequenceCache Orville.sequenceCache

    mbCycleExpr =
      ifChanged Expr.cycleIfTrue PgCatalog.pgSequenceCycle Orville.sequenceCycle

    applyChange :: (Bool, Maybe a -> b) -> Maybe a -> (Bool, b)
    applyChange (changed, exprF) mbArg =
      (changed || Maybe.isJust mbArg, exprF mbArg)

    (anyChanges, migrateSequenceExpr) =
      (False, Expr.alterSequenceExpr (Orville.sequenceName sequenceDef))
        `applyChange` mbIncrementByExpr
        `applyChange` mbMinValueExpr
        `applyChange` mbMaxValueExpr
        `applyChange` mbStartWithExpr
        `applyChange` mbCacheExpr
        `applyChange` mbCycleExpr
  in
    if anyChanges
      then [mkMigrationStepWithType AddRemoveTablesAndColumns migrateSequenceExpr]
      else []

sequenceIdToPgCatalogNames ::
  PgCatalog.NamespaceName ->
  Orville.SequenceIdentifier ->
  (PgCatalog.NamespaceName, PgCatalog.RelationName)
sequenceIdToPgCatalogNames currentNamespace sequenceId =
  let
    actualNamespace =
      maybe currentNamespace String.fromString
        . Orville.sequenceIdSchemaNameString
        $ sequenceId

    relationName =
      String.fromString
        . Orville.sequenceIdUnqualifiedNameString
        $ sequenceId
  in
    (actualNamespace, relationName)

currentNamespaceQuery :: Expr.QueryExpr
currentNamespaceQuery =
  Expr.queryExpr
    (Expr.selectClause (Expr.selectExpr Nothing))
    ( Expr.selectDerivedColumns
        [ Expr.deriveColumnAs
            -- current_schema is a special reserved word in postgresql. If you
            -- put it in quotes it tries to treat it as a regular column name,
            -- which then can't be found as a column in the query.
            (RawSql.unsafeSqlExpression "current_schema")
            (Orville.fieldColumnName PgCatalog.namespaceNameField)
        ]
    )
    Nothing

findCurrentNamespace :: Orville.MonadOrville m => m PgCatalog.NamespaceName
findCurrentNamespace = do
  results <-
    Orville.executeAndDecode
      Orville.SelectQuery
      currentNamespaceQuery
      (Orville.annotateSqlMarshallerEmptyAnnotation $ Orville.marshallField id PgCatalog.namespaceNameField)

  liftIO $
    case results of
      [schemaAndCatalog] ->
        pure schemaAndCatalog
      [] ->
        throwIO $ UnableToDiscoverCurrentSchema "No results returned by current_schema query"
      _ ->
        throwIO $ UnableToDiscoverCurrentSchema "Multiple results returned by current_schema query"