{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.AutoMigration
  ( autoMigrationTests
  )
where

import qualified Control.Exception.Safe as ExSafe
import qualified Control.Monad.IO.Class as MIO
import qualified Data.ByteString.Char8 as B8
import qualified Data.Foldable as Fold
import qualified Data.Function as Function
import Data.Int (Int32)
import Data.List ((\\))
import qualified Data.List as List
import qualified Data.List.NonEmpty as NEL
import qualified Data.Maybe as Maybe
import qualified Data.String as String
import Hedgehog ((===))
import qualified Hedgehog as HH
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

import qualified Orville.PostgreSQL as Orville
import qualified Orville.PostgreSQL.AutoMigration as AutoMigration
import qualified Orville.PostgreSQL.Expr as Expr
import qualified Orville.PostgreSQL.PgCatalog as PgCatalog
import qualified Orville.PostgreSQL.Raw.Connection as Conn
import qualified Orville.PostgreSQL.Raw.RawSql as RawSql
import qualified Orville.PostgreSQL.Schema as Schema

import qualified Test.Entities.Foo as Foo
import qualified Test.PgAssert as PgAssert
import qualified Test.PgGen as PgGen
import qualified Test.Property as Property
import qualified Test.TestTable as TestTable

autoMigrationTests :: Orville.ConnectionPool -> Property.Group
autoMigrationTests pool =
  Property.group
    "AutoMigration"
    [ prop_raisesErrorIfMigrationLockIsLocked pool
    , prop_releasesMigrationLockOnError pool
    , prop_createsMissingTables pool
    , prop_dropsRequestedTables pool
    , prop_addsAndRemovesColumns pool
    , prop_columnsWithSystemNameConflictsRaiseError pool
    , prop_altersColumnDataType pool
    , prop_altersColumnDefaultValue_TextNumeric pool
    , prop_altersColumnDefaultValue_Bool pool
    , prop_altersColumnDefaultValue_Timelike pool
    , prop_respectsImplicitDefaultOnSerialFields pool
    , prop_addAndRemovesUniqueConstraints pool
    , prop_addAndRemovesForeignKeyConstraints pool
    , prop_createsMissingSequences pool
    , prop_dropsRequestedSequences pool
    , prop_altersModifiedSequences pool
    , prop_addsAndRemovesMixedIndexes pool
    , prop_arbitrarySchemaInitialMigration pool
    ]

prop_raisesErrorIfMigrationLockIsLocked :: Property.NamedDBProperty
prop_raisesErrorIfMigrationLockIsLocked =
  Property.singletonNamedDBProperty "Raises an error when the migration lock is hold" $ \pool -> do
    errOrSuccess <-
      HH.evalIO $
        Orville.runOrville pool $
          AutoMigration.withMigrationLock AutoMigration.defaultLockId $
            MIO.liftIO $
              ExSafe.try $
                Orville.runOrville pool $
                  AutoMigration.withMigrationLock
                    AutoMigration.defaultLockId
                    (pure ())

    case errOrSuccess of
      Left (_err :: AutoMigration.MigrationLockError) -> pure ()
      Right () -> do
        HH.annotate "Expected MigrationLockError error to be thrown, but it was not"
        HH.failure

prop_releasesMigrationLockOnError :: Property.NamedDBProperty
prop_releasesMigrationLockOnError =
  Property.singletonNamedDBProperty "Releases the migration lock on error" $ \pool -> do
    HH.evalIO $
      Orville.runOrville pool $
        -- Acquire a connection before running a second orville context to
        -- ensure that each context will get a separate connection from the
        -- pool. Both connections must be open simultaneously for this test
        -- to be valid since the lock we are testing is held at a session
        -- level.
        Orville.withConnection_ $ do
          MIO.liftIO $
            Orville.runOrville pool $
              ExSafe.handle (\SimulatedError -> pure ()) $
                AutoMigration.withMigrationLock
                  AutoMigration.defaultLockId
                  (ExSafe.throwM SimulatedError)

          -- If the lock is not released by the previous 'withMigrationLock'
          -- this second call will fail to acquire the lock and the test will
          -- fail
          AutoMigration.withMigrationLock
            AutoMigration.defaultLockId
            (pure ())

data SimulatedError = SimulatedError
  deriving (Show)

instance ExSafe.Exception SimulatedError

prop_createsMissingTables :: Property.NamedDBProperty
prop_createsMissingTables =
  Property.singletonNamedDBProperty "Creates missing tables" $ \pool -> do
    let
      fooTableId =
        Orville.tableIdentifier Foo.table

    firstTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          Orville.executeVoid Orville.DDLQuery $ TestTable.dropTableDefSql Foo.table
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaTable Foo.table]

    secondTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          AutoMigration.executeMigrationPlan AutoMigration.defaultOptions firstTimePlan
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaTable Foo.table]

    length (AutoMigration.migrationPlanSteps firstTimePlan) === 1
    _ <-
      PgAssert.assertTableExists
        pool
        (Orville.tableIdUnqualifiedNameString fooTableId)
    migrationPlanStepStrings secondTimePlan === []

prop_dropsRequestedTables :: Property.NamedDBProperty
prop_dropsRequestedTables =
  Property.singletonNamedDBProperty "Drops requested tables" $ \pool -> do
    let
      fooTableId =
        Orville.tableIdentifier Foo.table

    firstTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          Orville.executeVoid Orville.DDLQuery $ TestTable.dropTableDefSql Foo.table
          Orville.executeVoid Orville.DDLQuery $ Orville.mkCreateTableExpr Foo.table
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaDropTable fooTableId]

    secondTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          AutoMigration.executeMigrationPlan AutoMigration.defaultOptions firstTimePlan
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaDropTable fooTableId]

    length (AutoMigration.migrationPlanSteps firstTimePlan) === 1
    PgAssert.assertTableDoesNotExist pool (Orville.tableIdUnqualifiedNameString fooTableId)
    migrationPlanStepStrings secondTimePlan === []

prop_addsAndRemovesColumns :: Property.NamedDBProperty
prop_addsAndRemovesColumns =
  Property.namedDBProperty "Adds and removes columns columns" $ \pool -> do
    let
      genColumnList =
        Gen.subsequence ["foo", "bar", "baz", "bat", "bax"]

    originalColumns <- HH.forAll genColumnList
    newColumns <- HH.forAll genColumnList

    let
      columnsToDrop =
        originalColumns \\ newColumns

      originalTableDef =
        mkIntListTable "migration_test" originalColumns

      newTableDef =
        Orville.dropColumns columnsToDrop $
          mkIntListTable "migration_test" newColumns

    firstTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          Orville.executeVoid Orville.DDLQuery $ TestTable.dropTableDefSql originalTableDef
          Orville.executeVoid Orville.DDLQuery $ Schema.mkCreateTableExpr originalTableDef
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaTable newTableDef]

    secondTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          AutoMigration.executeMigrationPlan AutoMigration.defaultOptions firstTimePlan
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaTable newTableDef]

    migrationPlanStepStrings secondTimePlan === []
    tableDesc <- PgAssert.assertTableExists pool "migration_test"
    PgAssert.assertColumnNamesEqual tableDesc newColumns

prop_columnsWithSystemNameConflictsRaiseError :: Property.NamedDBProperty
prop_columnsWithSystemNameConflictsRaiseError =
  Property.singletonNamedDBProperty "An error is raised trying to add a column that conflicts with a system name" $ \pool -> do
    let
      tableWithSystemAttributeNames =
        Orville.mkTableDefinitionWithoutKey
          "table_with_system_attribute_names"
          (Orville.marshallField id (Orville.unboundedTextField "tableoid"))

    result <-
      HH.evalIO $
        Orville.runOrville pool $ do
          Orville.executeVoid Orville.DDLQuery $ TestTable.dropTableDefSql tableWithSystemAttributeNames

          -- Create the table with no columns first to ensure we go down the
          -- "add column" path
          Orville.executeVoid Orville.DDLQuery $
            Expr.createTableExpr
              (Orville.tableName tableWithSystemAttributeNames)
              []
              Nothing
              []

          ExSafe.try $
            AutoMigration.autoMigrateSchema
              AutoMigration.defaultOptions
              [AutoMigration.SchemaTable tableWithSystemAttributeNames]

    case result of
      Left err ->
        Conn.sqlExecutionErrorSqlState err === Just (B8.pack "42701")
      Right () -> do
        HH.annotate "Expected migration to fail, but it did not"
        HH.failure

{- |
  Migration Guide: @SomeField@ has been removed. @foldMarshallerFields@ can be
  used to collect data from the fields in a @SqlMarshaller@ while converting
  the results to whatever type you desire.

@since 1.0.0.0
-}
data SomeField where
  SomeField :: Orville.FieldDefinition nullability a -> SomeField

describeField :: SomeField -> String
describeField (SomeField field) =
  B8.unpack (RawSql.toExampleBytes $ Orville.fieldColumnDefinition field)

prop_altersColumnDataType :: Property.NamedDBProperty
prop_altersColumnDataType =
  Property.namedDBProperty "Alters data type on existing column" $ \pool -> do
    let
      baseFieldDefs =
        -- Serial columns are omitted from this list currently because
        -- the are pseudo-types in postgresql, rather than real column types.
        -- We don't handle migrating "away" from them to regular integer type.
        --
        -- time-like and boolean columns are omitted because postgresql raises
        -- an unable-to-cast error when attempting to migrate between them and
        -- numeric columns.
        [ SomeField $ Orville.unboundedTextField "column"
        , SomeField $ Orville.boundedTextField "column" 1
        , SomeField $ Orville.boundedTextField "column" 255
        , SomeField $ Orville.fixedTextField "column" 1
        , SomeField $ Orville.fixedTextField "column" 255
        , SomeField $ Orville.integerField "column"
        , SomeField $ Orville.smallIntegerField "column"
        , SomeField $ Orville.bigIntegerField "column"
        , SomeField $ Orville.doubleField "column"
        ]

      mkNullable (SomeField field) =
        case Orville.fieldNullability field of
          Orville.NullableField nullable ->
            SomeField $ nullable
          Orville.NotNullField notNull ->
            SomeField $ Orville.nullableField notNull

      generateFieldDefinition =
        Gen.element (baseFieldDefs ++ fmap mkNullable baseFieldDefs)

    SomeField originalField <- HH.forAllWith describeField generateFieldDefinition
    SomeField newField <- HH.forAllWith describeField generateFieldDefinition

    let
      originalTableDef =
        Orville.mkTableDefinitionWithoutKey
          "migration_test"
          (Orville.marshallField id originalField)

      newTableDef =
        Orville.mkTableDefinitionWithoutKey
          "migration_test"
          (Orville.marshallField id newField)

      newSqlType =
        Orville.fieldType newField

    firstTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          Orville.executeVoid Orville.DDLQuery $ TestTable.dropTableDefSql originalTableDef
          Orville.executeVoid Orville.DDLQuery $ Schema.mkCreateTableExpr originalTableDef
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaTable newTableDef]

    secondTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          AutoMigration.executeMigrationPlan AutoMigration.defaultOptions firstTimePlan
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaTable newTableDef]

    migrationPlanStepStrings secondTimePlan === []
    newTableDesc <- PgAssert.assertTableExists pool "migration_test"
    attr <- PgAssert.assertColumnExists newTableDesc "column"
    PgCatalog.pgAttributeTypeOid attr === Orville.sqlTypeOid newSqlType
    PgCatalog.pgAttributeMaxLength attr === Orville.sqlTypeMaximumLength newSqlType
    PgCatalog.pgAttributeIsNotNull attr === Orville.fieldIsNotNullable newField

genFieldWithMaybeDefault ::
  HH.Gen a ->
  (a -> Orville.DefaultValue a) ->
  Orville.FieldDefinition nullability a ->
  HH.Gen (Orville.FieldDefinition nullability a)
genFieldWithMaybeDefault defaultGen mkDefaultValue fieldDef = do
  maybeDefault <- Gen.maybe defaultGen
  pure $
    case maybeDefault of
      Nothing ->
        fieldDef
      Just def ->
        Orville.setDefaultValue (mkDefaultValue def) fieldDef

prop_altersColumnDefaultValue_TextNumeric :: Property.NamedDBProperty
prop_altersColumnDefaultValue_TextNumeric =
  Property.namedDBProperty "Alters default value on existing column (text/numeric)" $ \pool -> do
    let
      genDefaultText =
        PgGen.pgText (Range.linear 0 10)

      genDefaultIntegral :: Integral n => HH.Gen n
      genDefaultIntegral =
        Gen.integral (Range.linear (-10) 10)

      genDefaultDouble =
        PgGen.pgDouble

    assertDefaultValuesMigrateProperly pool $
      Gen.choice
        [ SomeField <$> genFieldWithMaybeDefault genDefaultText Orville.textDefault (Orville.unboundedTextField "column")
        , SomeField <$> genFieldWithMaybeDefault genDefaultText Orville.textDefault (Orville.boundedTextField "column" 10)
        , SomeField <$> genFieldWithMaybeDefault genDefaultText Orville.textDefault (Orville.fixedTextField "column" 10)
        , SomeField <$> genFieldWithMaybeDefault genDefaultIntegral Orville.integerDefault (Orville.integerField "column")
        , SomeField <$> genFieldWithMaybeDefault genDefaultIntegral Orville.smallIntegerDefault (Orville.smallIntegerField "column")
        , SomeField <$> genFieldWithMaybeDefault genDefaultIntegral Orville.bigIntegerDefault (Orville.bigIntegerField "column")
        , SomeField <$> genFieldWithMaybeDefault genDefaultDouble Orville.doubleDefault (Orville.doubleField "column")
        ]

prop_altersColumnDefaultValue_Bool :: Property.NamedDBProperty
prop_altersColumnDefaultValue_Bool =
  Property.namedDBProperty "Alters default value on existing column (boolean)" $ \pool -> do
    assertDefaultValuesMigrateProperly pool $
      Gen.choice
        [ SomeField <$> genFieldWithMaybeDefault Gen.bool Orville.booleanDefault (Orville.booleanField "column")
        ]

prop_altersColumnDefaultValue_Timelike :: Property.NamedDBProperty
prop_altersColumnDefaultValue_Timelike =
  Property.namedDBProperty "Alters default value on existing column (timelike)" $ \pool -> do
    assertDefaultValuesMigrateProperly pool $
      Gen.choice
        [ -- Fields without default, or with specific times for the default
          SomeField <$> genFieldWithMaybeDefault PgGen.pgUTCTime Orville.utcTimestampDefault (Orville.utcTimestampField "column")
        , SomeField <$> genFieldWithMaybeDefault PgGen.pgLocalTime Orville.localTimestampDefault (Orville.localTimestampField "column")
        , SomeField <$> genFieldWithMaybeDefault PgGen.pgDay Orville.dateDefault (Orville.dateField "column")
        , -- Fields with "now" for the default
          pure . SomeField $ Orville.setDefaultValue Orville.currentUTCTimestampDefault (Orville.utcTimestampField "column")
        , pure . SomeField $ Orville.setDefaultValue Orville.currentLocalTimestampDefault (Orville.localTimestampField "column")
        , pure . SomeField $ Orville.setDefaultValue Orville.currentDateDefault (Orville.dateField "column")
        ]

prop_respectsImplicitDefaultOnSerialFields :: Property.NamedDBProperty
prop_respectsImplicitDefaultOnSerialFields =
  Property.namedDBProperty "Respects implicit default on serial fields" $ \pool -> do
    SomeField fieldDef <-
      HH.forAllWith describeField $
        Gen.element
          [ SomeField $ Orville.serialField "column"
          , SomeField $ Orville.bigSerialField "column"
          ]

    let
      tableDef =
        Orville.mkTableDefinitionWithoutKey
          "migration_test"
          (Orville.marshallField id fieldDef)

    firstTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          Orville.executeVoid Orville.DDLQuery $ TestTable.dropTableDefSql tableDef
          Orville.executeVoid Orville.DDLQuery $ Schema.mkCreateTableExpr tableDef
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaTable tableDef]

    originalTableDesc <- PgAssert.assertTableExists pool "migration_test"
    PgAssert.assertColumnDefaultExists originalTableDesc "column"

    secondTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          AutoMigration.executeMigrationPlan AutoMigration.defaultOptions firstTimePlan
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaTable tableDef]

    newTableDesc <- PgAssert.assertTableExists pool "migration_test"
    PgAssert.assertColumnDefaultExists newTableDesc "column"
    migrationPlanStepStrings secondTimePlan === []

assertDefaultValuesMigrateProperly ::
  Orville.ConnectionPool ->
  HH.Gen SomeField ->
  HH.PropertyT IO ()
assertDefaultValuesMigrateProperly pool genSomeField = do
  SomeField originalField <- HH.forAllWith describeField genSomeField
  SomeField newField <- HH.forAllWith describeField genSomeField

  let
    originalTableDef =
      Orville.mkTableDefinitionWithoutKey
        "migration_test"
        (Orville.marshallField id originalField)

    newTableDef =
      Orville.mkTableDefinitionWithoutKey
        "migration_test"
        (Orville.marshallField id newField)

  firstTimePlan <-
    HH.evalIO $
      Orville.runOrville pool $ do
        Orville.executeVoid Orville.DDLQuery $ TestTable.dropTableDefSql originalTableDef
        Orville.executeVoid Orville.DDLQuery $ Schema.mkCreateTableExpr originalTableDef
        AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaTable newTableDef]

  originalTableDesc <- PgAssert.assertTableExists pool "migration_test"
  PgAssert.assertColumnDefaultMatches originalTableDesc "column" (Orville.fieldDefaultValue originalField)

  secondTimePlan <-
    HH.evalIO $
      Orville.runOrville pool $ do
        AutoMigration.executeMigrationPlan AutoMigration.defaultOptions firstTimePlan
        AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaTable newTableDef]

  newTableDesc <- PgAssert.assertTableExists pool "migration_test"
  PgAssert.assertColumnDefaultMatches newTableDesc "column" (Orville.fieldDefaultValue newField)
  migrationPlanStepStrings secondTimePlan === []

prop_addAndRemovesUniqueConstraints :: Property.NamedDBProperty
prop_addAndRemovesUniqueConstraints =
  Property.namedDBProperty "Adds and removes unique constraints" $ \pool -> do
    let
      genColumnList =
        Gen.subsequence ["foo", "bar", "baz", "bat", "bax"]

      genConstraintColumns :: [String] -> HH.Gen [NEL.NonEmpty String]
      genConstraintColumns columns =
        fmap Maybe.catMaybes $
          Gen.list (Range.linear 0 10) $ do
            subcolumns <- Gen.subsequence columns
            NEL.nonEmpty <$> Gen.shuffle subcolumns

    originalColumns <- HH.forAll genColumnList
    originalConstraintColumns <- HH.forAll $ genConstraintColumns originalColumns
    newColumns <- HH.forAll genColumnList
    newConstraintColumns <- HH.forAll $ genConstraintColumns newColumns

    let
      columnsToDrop =
        originalColumns \\ newColumns

      originalConstraints =
        fmap mkUniqueConstraint originalConstraintColumns

      newConstraints =
        fmap mkUniqueConstraint newConstraintColumns

      originalTableDef =
        Orville.addTableConstraints originalConstraints $
          mkIntListTable "migration_test" originalColumns

      newTableDef =
        Orville.addTableConstraints newConstraints $
          Orville.dropColumns columnsToDrop $
            mkIntListTable "migration_test" newColumns

    HH.cover 5 (String.fromString "Adding Constraints") (not $ null (newConstraintColumns \\ originalConstraintColumns))
    HH.cover 5 (String.fromString "Dropping Constraints") (not $ null (originalConstraintColumns \\ newConstraintColumns))

    firstTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          Orville.executeVoid Orville.DDLQuery $ TestTable.dropTableDefSql originalTableDef
          AutoMigration.autoMigrateSchema AutoMigration.defaultOptions [AutoMigration.SchemaTable originalTableDef]
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaTable newTableDef]

    HH.annotate ("First time migration steps: " <> show (migrationPlanStepStrings firstTimePlan))

    secondTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          AutoMigration.executeMigrationPlan AutoMigration.defaultOptions firstTimePlan
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaTable newTableDef]

    migrationPlanStepStrings secondTimePlan === []
    tableDesc <- PgAssert.assertTableExists pool "migration_test"

    Fold.traverse_ (PgAssert.assertUniqueConstraintExists tableDesc) newConstraintColumns
    length (PgCatalog.relationConstraints tableDesc) === length (List.nub newConstraintColumns)

prop_addAndRemovesForeignKeyConstraints :: Property.NamedDBProperty
prop_addAndRemovesForeignKeyConstraints =
  Property.namedDBProperty "Adds and removes foreign key constraints" $ \pool -> do
    let
      genColumnList =
        Gen.subsequence ["foo", "bar", "baz", "bat", "bax"]

    localColumns <- HH.forAll genColumnList
    foreignColumns <- HH.forAll genColumnList

    let
      genForeignKeyInfos :: HH.Gen [PgAssert.ForeignKeyInfo]
      genForeignKeyInfos =
        fmap Maybe.catMaybes $
          Gen.list (Range.linear 0 10) $ do
            shuffledLocal <- Gen.shuffle localColumns
            shuffledForeign <- Gen.shuffle foreignColumns

            references <- Gen.subsequence (zip shuffledLocal shuffledForeign)
            onUpdateAction <- generateForeignKeyAction
            onDeleteAction <- generateForeignKeyAction

            pure $
              PgAssert.ForeignKeyInfo
                <$> NEL.nonEmpty references
                <*> Just onUpdateAction
                <*> Just onDeleteAction

    originalForeignKeyInfos <- HH.forAll genForeignKeyInfos
    newForeignKeyInfos <- HH.forAll genForeignKeyInfos

    -- We sort the columns in the unique constraints here to avoid edge cases
    -- with equivalent unique constraints in a different order. In these
    -- situations PostgreSQL can end up creating foreign keys that depending on
    -- indexes with a different ordering than the foreign key, which this test
    -- would then assume can be dropped even though it cannot. Standardizing
    -- the order of the columns in the unique constraints ensures this test
    -- will not try to drop a constraint that is used in both the original and
    -- new schemas while a foreign key is dropped and a new one added.
    let
      originalUniqueConstraints =
        fmap
          (mkUniqueConstraint . NEL.sort . fmap snd . PgAssert.foreignKeyInfoReferences)
          originalForeignKeyInfos

      newUniqueConstraints =
        fmap
          (mkUniqueConstraint . NEL.sort . fmap snd . PgAssert.foreignKeyInfoReferences)
          newForeignKeyInfos

      originalForeignKeyConstraints =
        fmap (mkForeignKeyConstraint "migration_test_foreign") originalForeignKeyInfos

      newForeignKeyConstraints =
        fmap (mkForeignKeyConstraint "migration_test_foreign") newForeignKeyInfos

      originalLocalTableDef =
        Orville.addTableConstraints originalForeignKeyConstraints $
          mkIntListTable "migration_test" localColumns

      newLocalTableDef =
        Orville.addTableConstraints newForeignKeyConstraints $
          mkIntListTable "migration_test" localColumns

      originalForeignTableDef =
        Orville.addTableConstraints originalUniqueConstraints $
          mkIntListTable "migration_test_foreign" foreignColumns

      newForeignTableDef =
        Orville.addTableConstraints newUniqueConstraints $
          mkIntListTable "migration_test_foreign" foreignColumns

    originalSchema <-
      HH.forAllWith (show . map AutoMigration.schemaItemSummary) $
        Gen.shuffle
          [ AutoMigration.SchemaTable originalForeignTableDef
          , AutoMigration.SchemaTable originalLocalTableDef
          ]

    newSchema <-
      HH.forAllWith (show . map AutoMigration.schemaItemSummary) $
        Gen.shuffle
          [ AutoMigration.SchemaTable newForeignTableDef
          , AutoMigration.SchemaTable newLocalTableDef
          ]

    HH.cover 5 (String.fromString "Adding Constraints") (not $ null (newForeignKeyInfos \\ originalForeignKeyInfos))
    HH.cover 5 (String.fromString "Dropping Constraints") (not $ null (originalForeignKeyInfos \\ newForeignKeyInfos))

    firstTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          Orville.executeVoid Orville.DDLQuery $ TestTable.dropTableDefSql originalLocalTableDef
          Orville.executeVoid Orville.DDLQuery $ TestTable.dropTableDefSql originalForeignTableDef
          AutoMigration.autoMigrateSchema AutoMigration.defaultOptions originalSchema
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions newSchema

    HH.annotate ("First time migration steps: " <> show (migrationPlanStepStrings firstTimePlan))

    secondTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          AutoMigration.executeMigrationPlan AutoMigration.defaultOptions firstTimePlan
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions newSchema

    HH.annotate ("Second time migration steps: " <> show (migrationPlanStepStrings secondTimePlan))

    migrationPlanStepStrings secondTimePlan === []
    tableDesc <- PgAssert.assertTableExists pool "migration_test"
    Fold.traverse_ (PgAssert.assertForeignKeyConstraintExists tableDesc) newForeignKeyInfos
    length (PgCatalog.relationConstraints tableDesc) === length (List.nub newForeignKeyInfos)

prop_addsAndRemovesMixedIndexes :: Property.NamedDBProperty
prop_addsAndRemovesMixedIndexes =
  Property.namedDBProperty "Adds and removes named indexes" $ \pool -> do
    let
      genColumnList =
        Gen.subsequence ["foo", "bar", "baz", "bat", "bax"]

    originalColumns <- HH.forAll genColumnList
    originalTestIndexes <- HH.forAll $ generateTestIndexes originalColumns "migration_test"
    newColumns <- HH.forAll genColumnList
    newTestIndexes <- HH.forAll $ generateTestIndexes newColumns "migration_test"

    let
      columnsToDrop =
        originalColumns \\ newColumns

      originalIndexes =
        fmap mkIndexDefinition originalTestIndexes

      newIndexes =
        fmap mkIndexDefinition newTestIndexes

      originalTableDef =
        Orville.addTableIndexes originalIndexes $
          mkIntListTable "migration_test" originalColumns

      newTableDef =
        Orville.addTableIndexes newIndexes $
          Orville.dropColumns columnsToDrop $
            mkIntListTable "migration_test" newColumns

    HH.cover 5 (String.fromString "Adding Indexes") (not $ null (newTestIndexes \\ originalTestIndexes))
    HH.cover 5 (String.fromString "Dropping Indexes") (not $ null (originalTestIndexes \\ newTestIndexes))
    HH.cover
      5
      (String.fromString "Concurrent Indexes")
      ( any
          (\i -> testIndexCreationStrategy i == Orville.Concurrent)
          (originalTestIndexes <> newTestIndexes)
      )

    firstTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          Orville.executeVoid Orville.DDLQuery $ TestTable.dropTableDefSql originalTableDef
          AutoMigration.autoMigrateSchema AutoMigration.defaultOptions [AutoMigration.SchemaTable originalTableDef]
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaTable newTableDef]

    HH.annotate ("First time migration steps: " <> show (migrationPlanStepStrings firstTimePlan))

    originalTableDesc <- PgAssert.assertTableExists pool "migration_test"
    Fold.traverse_
      (PgAssert.assertIndexExists originalTableDesc <$> testIndexUniqueness <*> testIndexColumns)
      originalTestIndexes

    secondTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          AutoMigration.executeMigrationPlan AutoMigration.defaultOptions firstTimePlan
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaTable newTableDef]

    migrationPlanStepStrings secondTimePlan === []
    newTableDesc <- PgAssert.assertTableExists pool "migration_test"

    Fold.traverse_
      (PgAssert.assertIndexExists newTableDesc <$> testIndexUniqueness <*> testIndexColumns)
      newTestIndexes
    length (PgCatalog.relationIndexes newTableDesc) === length (List.nub newTestIndexes)

prop_createsMissingSequences :: Property.NamedDBProperty
prop_createsMissingSequences =
  Property.singletonNamedDBProperty "Creates missing sequences" $ \pool -> do
    let
      sequenceDef =
        Orville.mkSequenceDefinition "migration_test_sequence"
      sequenceId =
        Orville.sequenceIdentifier sequenceDef

    firstTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          Orville.executeVoid Orville.DDLQuery $ Expr.dropSequenceExpr (Just Expr.ifExists) (Orville.sequenceName sequenceDef)
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaSequence sequenceDef]

    secondTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          AutoMigration.executeMigrationPlan AutoMigration.defaultOptions firstTimePlan
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaSequence sequenceDef]

    length (AutoMigration.migrationPlanSteps firstTimePlan) === 1
    _ <-
      PgAssert.assertSequenceExists
        pool
        (Orville.sequenceIdUnqualifiedNameString sequenceId)
    migrationPlanStepStrings secondTimePlan === []

prop_dropsRequestedSequences :: Property.NamedDBProperty
prop_dropsRequestedSequences =
  Property.singletonNamedDBProperty "Drops requested tables" $ \pool -> do
    let
      sequenceDef =
        Orville.mkSequenceDefinition "migration_test_sequence"
      sequenceId =
        Orville.sequenceIdentifier sequenceDef

    firstTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          Orville.executeVoid Orville.DDLQuery $ Expr.dropSequenceExpr (Just Expr.ifExists) (Orville.sequenceName sequenceDef)
          Orville.executeVoid Orville.DDLQuery $ Orville.mkCreateSequenceExpr sequenceDef
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaDropSequence sequenceId]

    secondTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          AutoMigration.executeMigrationPlan AutoMigration.defaultOptions firstTimePlan
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaDropSequence sequenceId]

    length (AutoMigration.migrationPlanSteps firstTimePlan) === 1
    PgAssert.assertSequenceDoesNotExist pool (Orville.sequenceIdUnqualifiedNameString sequenceId)
    migrationPlanStepStrings secondTimePlan === []

prop_altersModifiedSequences :: Property.NamedDBProperty
prop_altersModifiedSequences =
  Property.namedDBProperty "Alters modified sequences" $ \pool -> do
    let
      baseSequenceDef =
        Orville.mkSequenceDefinition "migration_test_sequence"
      generateIncrement =
        Gen.choice
          [ Gen.int64 (Range.linearFrom 1 1 maxBound)
          , Gen.int64 (Range.linearFrom (-1) minBound (-1))
          ]

    originalSequenceDef <- HH.forAll $ do
      increment <- generateIncrement
      minValue <- Gen.int64 (Range.linearFrom 0 minBound (maxBound - 1))
      maxValue <- Gen.int64 (Range.linear (minValue + 1) maxBound)
      start <- Gen.int64 (Range.linear minValue maxValue)
      cache <- Gen.int64 (Range.linear 1 maxBound)
      cycleFlag <- Gen.bool
      pure
        . Orville.setSequenceIncrement increment
        . Orville.setSequenceMinValue minValue
        . Orville.setSequenceMaxValue maxValue
        . Orville.setSequenceStart start
        . Orville.setSequenceCache cache
        . Orville.setSequenceCycle cycleFlag
        $ baseSequenceDef

    newSequenceDef <- HH.forAll $ do
      mbNewIncrement <- Gen.maybe generateIncrement
      -- The range between min and max values must contain the current next
      -- value of the sequence for PostgreSQL to not raise an error. Because
      -- no value has been fetched from our test sequence, that value is
      -- the start value from the original sequence definition
      mbNewMinValue <- Gen.maybe $ Gen.int64 (Range.linear minBound (Orville.sequenceStart originalSequenceDef))
      mbNewMaxValue <- Gen.maybe $ Gen.int64 (Range.linear (Orville.sequenceStart originalSequenceDef + 1) maxBound)

      -- The new start value must lie in the new range of the sequence. If no
      -- changes are being made to these values then the will remain the same as
      -- in the original sequence
      let
        newMinValue = Maybe.fromMaybe (Orville.sequenceMinValue originalSequenceDef) mbNewMinValue
        newMaxValue = Maybe.fromMaybe (Orville.sequenceMaxValue originalSequenceDef) mbNewMaxValue
      mbNewStart <- Gen.maybe $ Gen.int64 (Range.linear newMinValue newMaxValue)
      mbNewCache <- Gen.maybe $ Gen.int64 (Range.linear 1 maxBound)
      mbNewCycleFlag <- Gen.maybe Gen.bool
      pure
        . maybe id Orville.setSequenceIncrement mbNewIncrement
        . maybe id Orville.setSequenceMinValue mbNewMinValue
        . maybe id Orville.setSequenceMaxValue mbNewMaxValue
        . maybe id Orville.setSequenceStart mbNewStart
        . maybe id Orville.setSequenceCache mbNewCache
        . maybe id Orville.setSequenceCycle mbNewCycleFlag
        $ originalSequenceDef

    firstTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          Orville.executeVoid Orville.DDLQuery $ Expr.dropSequenceExpr (Just Expr.ifExists) (Orville.sequenceName originalSequenceDef)
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaSequence originalSequenceDef]

    HH.annotate ("First time steps: " <> show (migrationPlanStepStrings firstTimePlan))
    length (AutoMigration.migrationPlanSteps firstTimePlan) === 1

    secondTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          AutoMigration.executeMigrationPlan AutoMigration.defaultOptions firstTimePlan
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaSequence newSequenceDef]

    HH.annotate ("Second time steps: " <> show (migrationPlanStepStrings secondTimePlan))
    assertSequenceExistsMatching pool originalSequenceDef

    thirdTimePlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          AutoMigration.executeMigrationPlan AutoMigration.defaultOptions secondTimePlan
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions [AutoMigration.SchemaSequence newSequenceDef]

    assertSequenceExistsMatching pool newSequenceDef
    migrationPlanStepStrings thirdTimePlan === []

assertSequenceExistsMatching ::
  (HH.MonadTest m, MIO.MonadIO m) =>
  Orville.ConnectionPool ->
  Orville.SequenceDefinition ->
  m ()
assertSequenceExistsMatching pool sequenceDef = do
  sequenceRelation <-
    PgAssert.assertSequenceExists
      pool
      (Orville.sequenceIdUnqualifiedNameString . Orville.sequenceIdentifier $ sequenceDef)
  pgSequence <- PgAssert.assertRelationHasPgSequence sequenceRelation
  PgCatalog.pgSequenceIncrement pgSequence === Orville.sequenceIncrement sequenceDef
  PgCatalog.pgSequenceStart pgSequence === Orville.sequenceStart sequenceDef
  PgCatalog.pgSequenceMin pgSequence === Orville.sequenceMinValue sequenceDef
  PgCatalog.pgSequenceMax pgSequence === Orville.sequenceMaxValue sequenceDef
  PgCatalog.pgSequenceCache pgSequence === Orville.sequenceCache sequenceDef
  PgCatalog.pgSequenceCycle pgSequence === Orville.sequenceCycle sequenceDef

prop_arbitrarySchemaInitialMigration :: Property.NamedDBProperty
prop_arbitrarySchemaInitialMigration =
  Property.namedDBProperty "An arbitrary list of schema items can be created from scratch" $ \pool -> do
    testTables <- HH.forAll $ generateTestTables (Range.constant 0 10)

    HH.cover 75 (String.fromString "With Tables") (not . null $ testTables)
    HH.cover 75 (String.fromString "With Columns") (not . null $ concatMap testTableColumns testTables)
    HH.cover 50 (String.fromString "With Indexes") (not . null $ concatMap testTableIndexes testTables)
    HH.cover 50 (String.fromString "With Unique Constraints") (not . null $ concatMap testTableUniqueConstraints testTables)
    HH.cover 30 (String.fromString "With Foreign Keys") (not . null $ concatMap testTableForeignKeys testTables)

    let
      testSchema =
        map testTableSchemaItem testTables

    initialMigrationPlan <-
      HH.evalIO $
        Orville.runOrville pool $ do
          Orville.executeVoid Orville.DDLQuery $ RawSql.fromString "DROP SCHEMA IF EXISTS orville_migration_test CASCADE"
          Orville.executeVoid Orville.DDLQuery $ RawSql.fromString "CREATE SCHEMA orville_migration_test"
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions testSchema

    HH.annotate ("Initial migration steps: " <> show (migrationPlanStepStrings initialMigrationPlan))

    migrationPlanAfterMigration <-
      HH.evalIO $
        Orville.runOrville pool $ do
          AutoMigration.executeMigrationPlan AutoMigration.defaultOptions initialMigrationPlan
          AutoMigration.generateMigrationPlan AutoMigration.defaultOptions testSchema

    migrationPlanStepStrings migrationPlanAfterMigration === []
    Fold.traverse_ (assertTableStructure pool) testTables

assertTableStructure ::
  (HH.MonadTest m, MIO.MonadIO m) =>
  Orville.ConnectionPool ->
  TestTable ->
  m ()
assertTableStructure pool testTable = do
  tableDesc <- PgAssert.assertTableExistsInSchema pool "orville_migration_test" (testTableName testTable)

  PgAssert.assertColumnNamesEqual
    tableDesc
    (testTableColumns testTable)

  Fold.traverse_
    (PgAssert.assertIndexExists tableDesc <$> testIndexUniqueness <*> testIndexColumns)
    (testTableIndexes testTable)

  Fold.traverse_
    (PgAssert.assertUniqueConstraintExists tableDesc)
    (testTableUniqueConstraints testTable)

  Fold.traverse_
    (PgAssert.assertForeignKeyConstraintExists tableDesc)
    (map mkForeignKeyInfo . testTableForeignKeys $ testTable)

mkForeignKeyInfo :: TestForeignKey -> PgAssert.ForeignKeyInfo
mkForeignKeyInfo testForeignKey =
  PgAssert.ForeignKeyInfo
    { PgAssert.foreignKeyInfoReferences = testForeignKeyReferences testForeignKey
    , PgAssert.foreignKeyInfoOnUpdate = testForeignKeyOnUpdate testForeignKey
    , PgAssert.foreignKeyInfoOnDelete = testForeignKeyOnDelete testForeignKey
    }

data TestTable = TestTable
  { testTableName :: String
  , testTableColumns :: [String]
  , testTablePrimaryKey :: [String]
  , testTableIndexes :: [TestIndex]
  , testTableUniqueConstraints :: [NEL.NonEmpty String]
  , testTableForeignKeys :: [TestForeignKey]
  }
  deriving (Show)

data TestIndex = TestIndex
  { testIndexName :: Maybe String
  , testIndexUniqueness :: Orville.IndexUniqueness
  , testIndexCreationStrategy :: Orville.IndexCreationStrategy
  , testIndexColumns :: NEL.NonEmpty String
  }
  deriving (Show, Eq)

data TestForeignKey = TestForeignKey
  { testForeignKeyReferences :: NEL.NonEmpty (String, String)
  , testForeignKeyTableName :: String
  , testForeignKeyOnUpdate :: Orville.ForeignKeyAction
  , testForeignKeyOnDelete :: Orville.ForeignKeyAction
  }
  deriving (Show)

data TestForeignKeyTarget = TestForeignKeyTarget
  { testForeignKeyTargetTableName :: String
  , testForeignKeyTargetColumns :: NEL.NonEmpty String
  }
  deriving (Show)

testTableForeignKeyTargets :: TestTable -> [TestForeignKeyTarget]
testTableForeignKeyTargets testTable =
  map
    (TestForeignKeyTarget $ testTableName testTable)
    (testTableUniqueConstraints testTable)

mkIndexDefinition :: TestIndex -> Orville.IndexDefinition
mkIndexDefinition testIndex =
  let
    strategy =
      testIndexCreationStrategy testIndex

    baseIndex =
      case testIndexName testIndex of
        Just name ->
          -- If the test index has a name, use it to test Orville's support for
          -- custome named indexes
          let
            indexBody =
              Expr.indexBodyColumns
                . fmap Expr.columnName
                . testIndexColumns
                $ testIndex
          in
            Orville.mkNamedIndexDefinition
              (testIndexUniqueness testIndex)
              name
              indexBody
        Nothing ->
          -- If the test index has no name, use it to test Orville's support for
          -- unnamed indexes
          Orville.mkIndexDefinition
            (testIndexUniqueness testIndex)
            (Orville.stringToFieldName <$> testIndexColumns testIndex)
  in
    Orville.setIndexCreationStrategy strategy baseIndex

generateTestTable :: HH.Gen TestTable
generateTestTable = do
  columns <- generateTestTableColumns

  tableName <- PgGen.pgIdentifierWithPrefix "t_" 1

  TestTable tableName
    <$> pure columns
    <*> Gen.subsequence columns
    <*> generateTestIndexes columns tableName
    <*> generateTestUniqueConstraints columns
    <*> pure [] -- No foreign keys can be generated until we've generate test tables

generateTestTables :: HH.Range Int -> HH.Gen [TestTable]
generateTestTables tableCountRange = do
  tablesWithoutForeignKeys <-
    fmap
      (List.nubBy (Function.on (==) testTableName))
      (Gen.list tableCountRange generateTestTable)

  let
    foreignKeyTargets =
      concatMap testTableForeignKeyTargets tablesWithoutForeignKeys

  traverse
    (addTestTableForeignKeys foreignKeyTargets)
    tablesWithoutForeignKeys

addTestTableForeignKeys ::
  [TestForeignKeyTarget] ->
  TestTable ->
  HH.Gen TestTable
addTestTableForeignKeys targets table = do
  let
    targetColumnCount =
      length . testForeignKeyTargetColumns

    possibleTargets =
      filter
        (\t -> targetColumnCount t <= length (testTableColumns table))
        targets

    genForeignKey target = do
      let
        targetColumns = testForeignKeyTargetColumns target

      sourceColumns <-
        -- nonEmpty can never produce a 'Nothing' here because the target's
        -- columns are a non-empty list.
        Gen.mapMaybe
          NEL.nonEmpty
          (take (targetColumnCount target) <$> Gen.shuffle (testTableColumns table))

      onUpdateAction <- generateForeignKeyAction
      onDeleteAction <- generateForeignKeyAction

      pure $
        TestForeignKey
          { testForeignKeyReferences = NEL.zip sourceColumns targetColumns
          , testForeignKeyTableName = testForeignKeyTargetTableName target
          , testForeignKeyOnUpdate = onUpdateAction
          , testForeignKeyOnDelete = onDeleteAction
          }

  chosenTargets <-
    case possibleTargets of
      [] -> pure []
      _ -> Gen.list (Range.linear 0 2) (Gen.element possibleTargets)

  foreignKeys <- traverse genForeignKey chosenTargets

  pure $ table {testTableForeignKeys = foreignKeys}

generateForeignKeyAction :: HH.Gen Orville.ForeignKeyAction
generateForeignKeyAction =
  Gen.element
    [ Orville.NoAction
    , Orville.Restrict
    , Orville.Cascade
    , Orville.SetNull
    , Orville.SetDefault
    ]

generateTestIndexes :: [String] -> String -> HH.Gen [TestIndex]
generateTestIndexes columns tableName = do
  testIndices <- fmap Maybe.catMaybes $
    Gen.list (Range.linear 0 10) $ do
      -- The use of `take 8` is to avoid creating a prefix that would be truncated
      -- but is also long enough to avoid collision when generating indexes for
      -- an arbitrary amount of tables
      indexName <- Gen.maybe $ PgGen.pgIdentifierWithPrefix ((take 8 tableName) <> "i_") 3
      subcolumns <- Gen.subsequence columns
      maybeNonEmptyColumns <- NEL.nonEmpty <$> Gen.shuffle subcolumns
      uniqueness <- Gen.element [Orville.UniqueIndex, Orville.NonUniqueIndex]
      strategy <-
        Gen.frequency
          [ (10, pure Orville.Transactional)
          , (1, pure Orville.Concurrent)
          ]
      pure $ fmap (TestIndex indexName uniqueness strategy) maybeNonEmptyColumns

  pure $ (List.nubBy (Function.on (==) testIndexColumns)) testIndices

generateTestUniqueConstraints :: [String] -> HH.Gen [NEL.NonEmpty String]
generateTestUniqueConstraints columns =
  fmap Maybe.catMaybes $
    Gen.list
      (Range.linear 0 5)
      (NEL.nonEmpty <$> Gen.subsequence columns)

testTableSchemaItem :: TestTable -> AutoMigration.SchemaItem
testTableSchemaItem testTable =
  let
    addTableItems ::
      Orville.TableDefinition key writeEntity readEntity ->
      Orville.TableDefinition key writeEntity readEntity
    addTableItems tableDef =
      Orville.addTableConstraints (testTableForeignKeyDefinition <$> testTableForeignKeys testTable)
        . Orville.addTableConstraints (mkUniqueConstraint <$> testTableUniqueConstraints testTable)
        . Orville.addTableIndexes (mkIndexDefinition <$> testTableIndexes testTable)
        . Orville.setTableSchema "orville_migration_test"
        $ tableDef
  in
    case testTablePrimaryKeyDefinition testTable of
      Nothing ->
        AutoMigration.SchemaTable $
          addTableItems $
            Orville.mkTableDefinitionWithoutKey
              (testTableName testTable)
              (intColumnsMarshaller $ testTableColumns testTable)
      Just primaryKey ->
        AutoMigration.SchemaTable $
          addTableItems $
            Orville.mkTableDefinition
              (testTableName testTable)
              primaryKey
              (intColumnsMarshaller $ testTableColumns testTable)

testTablePrimaryKeyDefinition :: TestTable -> Maybe (Orville.PrimaryKey [Int32])
testTablePrimaryKeyDefinition testTable =
  let
    mkPart (index, column) =
      Orville.primaryKeyPart (!! index) (Orville.integerField column)
  in
    case zip [1 ..] (testTablePrimaryKey testTable) of
      [] ->
        Nothing
      (first : rest) ->
        Just $
          Orville.compositePrimaryKey
            (mkPart first)
            (fmap mkPart rest)

testTableForeignKeyDefinition :: TestForeignKey -> Orville.ConstraintDefinition
testTableForeignKeyDefinition foreignKey =
  let
    mkForeignReference (localColumn, foreignColumn) =
      Orville.foreignReference
        (Orville.stringToFieldName localColumn)
        (Orville.stringToFieldName foreignColumn)

    foreignTableId =
      Orville.setTableIdSchema "orville_migration_test"
        . Orville.unqualifiedNameToTableId
        . testForeignKeyTableName
        $ foreignKey
  in
    Orville.foreignKeyConstraintWithOptions
      foreignTableId
      (fmap mkForeignReference $ testForeignKeyReferences foreignKey)
      ( Orville.defaultForeignKeyOptions
          { Orville.foreignKeyOptionsOnUpdate = testForeignKeyOnUpdate foreignKey
          , Orville.foreignKeyOptionsOnDelete = testForeignKeyOnDelete foreignKey
          }
      )

generateTestTableColumns :: HH.Gen [String]
generateTestTableColumns =
  List.nub <$> Gen.list (Range.constant 0 10) PgGen.pgIdentifier

mkIntListTable :: String -> [String] -> Orville.TableDefinition Orville.NoKey [Int32] [Int32]
mkIntListTable tableName columns =
  Orville.mkTableDefinitionWithoutKey tableName (intColumnsMarshaller columns)

intColumnsMarshaller :: [String] -> Orville.SqlMarshaller [Int32] [Int32]
intColumnsMarshaller columns =
  let
    field (idx, column) =
      Orville.marshallField (!! idx) $ Orville.integerField column
  in
    traverse field (zip [0 ..] columns)

mkUniqueConstraint :: NEL.NonEmpty String -> Orville.ConstraintDefinition
mkUniqueConstraint columnList =
  Orville.uniqueConstraint (fmap Orville.stringToFieldName columnList)

mkForeignKeyConstraint :: String -> PgAssert.ForeignKeyInfo -> Orville.ConstraintDefinition
mkForeignKeyConstraint foreignTableName foreignKeyInfo =
  let
    mkForeignReference (localColumn, foreignColumn) =
      Orville.foreignReference
        (Orville.stringToFieldName localColumn)
        (Orville.stringToFieldName foreignColumn)
  in
    Orville.foreignKeyConstraintWithOptions
      (Orville.unqualifiedNameToTableId foreignTableName)
      (fmap mkForeignReference $ PgAssert.foreignKeyInfoReferences foreignKeyInfo)
      ( Orville.defaultForeignKeyOptions
          { Orville.foreignKeyOptionsOnUpdate = PgAssert.foreignKeyInfoOnUpdate foreignKeyInfo
          , Orville.foreignKeyOptionsOnDelete = PgAssert.foreignKeyInfoOnDelete foreignKeyInfo
          }
      )

migrationPlanStepStrings :: AutoMigration.MigrationPlan -> [B8.ByteString]
migrationPlanStepStrings =
  fmap RawSql.toExampleBytes . AutoMigration.migrationPlanSteps