{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
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
data SchemaItem where
SchemaTable ::
Orville.TableDefinition key writeEntity readEntity ->
SchemaItem
SchemaDropTable ::
Orville.TableIdentifier ->
SchemaItem
SchemaSequence ::
Orville.SequenceDefinition ->
SchemaItem
SchemaDropSequence ::
Orville.SequenceIdentifier ->
SchemaItem
schemaItemSummary :: SchemaItem -> String
schemaItemSummary :: SchemaItem -> String
schemaItemSummary SchemaItem
item =
case SchemaItem
item of
SchemaTable TableDefinition key writeEntity readEntity
tableDef ->
String
"Table " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TableIdentifier -> String
Orville.tableIdToString (TableDefinition key writeEntity readEntity -> TableIdentifier
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableIdentifier
Orville.tableIdentifier TableDefinition key writeEntity readEntity
tableDef)
SchemaDropTable TableIdentifier
tableId ->
String
"Drop table " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TableIdentifier -> String
Orville.tableIdToString TableIdentifier
tableId
SchemaSequence SequenceDefinition
sequenceDef ->
String
"Sequence " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SequenceIdentifier -> String
Orville.sequenceIdToString (SequenceDefinition -> SequenceIdentifier
Orville.sequenceIdentifier SequenceDefinition
sequenceDef)
SchemaDropSequence SequenceIdentifier
sequenceId ->
String
"Drop sequence " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SequenceIdentifier -> String
Orville.sequenceIdToString SequenceIdentifier
sequenceId
data MigrationPlan = MigrationPlan
{ MigrationPlan -> [MigrationStep]
i_transactionalSteps :: [MigrationStep]
, MigrationPlan -> [MigrationStep]
i_concurrentIndexSteps :: [MigrationStep]
}
migrationPlanSteps :: MigrationPlan -> [MigrationStep]
migrationPlanSteps :: MigrationPlan -> [MigrationStep]
migrationPlanSteps MigrationPlan
plan =
MigrationPlan -> [MigrationStep]
i_transactionalSteps MigrationPlan
plan [MigrationStep] -> [MigrationStep] -> [MigrationStep]
forall a. Semigroup a => a -> a -> a
<> MigrationPlan -> [MigrationStep]
i_concurrentIndexSteps MigrationPlan
plan
mkMigrationPlan :: [MigrationStepWithType] -> MigrationPlan
mkMigrationPlan :: [MigrationStepWithType] -> MigrationPlan
mkMigrationPlan [MigrationStepWithType]
steps =
let
([MigrationStepWithType]
transactionalSteps, [MigrationStepWithType]
concurrentIndexSteps) =
(MigrationStepWithType -> Bool)
-> [MigrationStepWithType]
-> ([MigrationStepWithType], [MigrationStepWithType])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition MigrationStepWithType -> Bool
isMigrationStepTransactional
([MigrationStepWithType]
-> ([MigrationStepWithType], [MigrationStepWithType]))
-> ([MigrationStepWithType] -> [MigrationStepWithType])
-> [MigrationStepWithType]
-> ([MigrationStepWithType], [MigrationStepWithType])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MigrationStepWithType -> StepType)
-> [MigrationStepWithType] -> [MigrationStepWithType]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn MigrationStepWithType -> StepType
migrationStepType
([MigrationStepWithType]
-> ([MigrationStepWithType], [MigrationStepWithType]))
-> [MigrationStepWithType]
-> ([MigrationStepWithType], [MigrationStepWithType])
forall a b. (a -> b) -> a -> b
$ [MigrationStepWithType]
steps
in
MigrationPlan
{ i_transactionalSteps :: [MigrationStep]
i_transactionalSteps = (MigrationStepWithType -> MigrationStep)
-> [MigrationStepWithType] -> [MigrationStep]
forall a b. (a -> b) -> [a] -> [b]
map MigrationStepWithType -> MigrationStep
migrationStep [MigrationStepWithType]
transactionalSteps
, i_concurrentIndexSteps :: [MigrationStep]
i_concurrentIndexSteps = (MigrationStepWithType -> MigrationStep)
-> [MigrationStepWithType] -> [MigrationStep]
forall a b. (a -> b) -> [a] -> [b]
map MigrationStepWithType -> MigrationStep
migrationStep [MigrationStepWithType]
concurrentIndexSteps
}
newtype MigrationStep
= MigrationStep RawSql.RawSql
deriving
(
RawSql -> MigrationStep
MigrationStep -> RawSql
(MigrationStep -> RawSql)
-> (RawSql -> MigrationStep) -> SqlExpression MigrationStep
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: MigrationStep -> RawSql
toRawSql :: MigrationStep -> RawSql
$cunsafeFromRawSql :: RawSql -> MigrationStep
unsafeFromRawSql :: RawSql -> MigrationStep
RawSql.SqlExpression
)
data MigrationStepWithType = MigrationStepWithType
{ MigrationStepWithType -> StepType
migrationStepType :: StepType
, MigrationStepWithType -> MigrationStep
migrationStep :: MigrationStep
}
mkMigrationStepWithType ::
RawSql.SqlExpression sql =>
StepType ->
sql ->
MigrationStepWithType
mkMigrationStepWithType :: forall sql.
SqlExpression sql =>
StepType -> sql -> MigrationStepWithType
mkMigrationStepWithType StepType
stepType sql
sql =
MigrationStepWithType
{ migrationStepType :: StepType
migrationStepType = StepType
stepType
, migrationStep :: MigrationStep
migrationStep = RawSql -> MigrationStep
MigrationStep (sql -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql sql
sql)
}
isMigrationStepTransactional :: MigrationStepWithType -> Bool
isMigrationStepTransactional :: MigrationStepWithType -> Bool
isMigrationStepTransactional MigrationStepWithType
stepWithType =
case MigrationStepWithType -> StepType
migrationStepType MigrationStepWithType
stepWithType of
StepType
DropForeignKeys -> Bool
True
StepType
DropUniqueConstraints -> Bool
True
StepType
DropIndexes -> Bool
True
StepType
AddRemoveTablesAndColumns -> Bool
True
StepType
AddIndexesTransactionally -> Bool
True
StepType
AddUniqueConstraints -> Bool
True
StepType
AddForeignKeys -> Bool
True
StepType
AddIndexesConcurrently -> Bool
False
data StepType
= DropForeignKeys
| DropUniqueConstraints
| DropIndexes
| AddRemoveTablesAndColumns
| AddIndexesTransactionally
| AddUniqueConstraints
| AddForeignKeys
| AddIndexesConcurrently
deriving
(
StepType -> StepType -> Bool
(StepType -> StepType -> Bool)
-> (StepType -> StepType -> Bool) -> Eq StepType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StepType -> StepType -> Bool
== :: StepType -> StepType -> Bool
$c/= :: StepType -> StepType -> Bool
/= :: StepType -> StepType -> Bool
Eq
,
Eq StepType
Eq StepType
-> (StepType -> StepType -> Ordering)
-> (StepType -> StepType -> Bool)
-> (StepType -> StepType -> Bool)
-> (StepType -> StepType -> Bool)
-> (StepType -> StepType -> Bool)
-> (StepType -> StepType -> StepType)
-> (StepType -> StepType -> StepType)
-> Ord StepType
StepType -> StepType -> Bool
StepType -> StepType -> Ordering
StepType -> StepType -> StepType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StepType -> StepType -> Ordering
compare :: StepType -> StepType -> Ordering
$c< :: StepType -> StepType -> Bool
< :: StepType -> StepType -> Bool
$c<= :: StepType -> StepType -> Bool
<= :: StepType -> StepType -> Bool
$c> :: StepType -> StepType -> Bool
> :: StepType -> StepType -> Bool
$c>= :: StepType -> StepType -> Bool
>= :: StepType -> StepType -> Bool
$cmax :: StepType -> StepType -> StepType
max :: StepType -> StepType -> StepType
$cmin :: StepType -> StepType -> StepType
min :: StepType -> StepType -> StepType
Ord
)
data MigrationDataError
= UnableToDiscoverCurrentSchema String
| PgCatalogInvariantViolated String
deriving
(
Int -> MigrationDataError -> String -> String
[MigrationDataError] -> String -> String
MigrationDataError -> String
(Int -> MigrationDataError -> String -> String)
-> (MigrationDataError -> String)
-> ([MigrationDataError] -> String -> String)
-> Show MigrationDataError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> MigrationDataError -> String -> String
showsPrec :: Int -> MigrationDataError -> String -> String
$cshow :: MigrationDataError -> String
show :: MigrationDataError -> String
$cshowList :: [MigrationDataError] -> String -> String
showList :: [MigrationDataError] -> String -> String
Show
)
instance Exception MigrationDataError
data MigrationOptions = MigrationOptions
{ MigrationOptions -> Bool
runSchemaChanges :: Bool
, MigrationOptions -> Bool
runConcurrentIndexCreations :: Bool
, MigrationOptions -> MigrationLockId
migrationLockId :: MigrationLock.MigrationLockId
}
defaultOptions :: MigrationOptions
defaultOptions :: MigrationOptions
defaultOptions =
MigrationOptions
{ runSchemaChanges :: Bool
runSchemaChanges = Bool
True
, runConcurrentIndexCreations :: Bool
runConcurrentIndexCreations = Bool
True
, migrationLockId :: MigrationLockId
migrationLockId = MigrationLockId
MigrationLock.defaultLockId
}
autoMigrateSchema ::
Orville.MonadOrville m =>
MigrationOptions ->
[SchemaItem] ->
m ()
autoMigrateSchema :: forall (m :: * -> *).
MonadOrville m =>
MigrationOptions -> [SchemaItem] -> m ()
autoMigrateSchema MigrationOptions
options [SchemaItem]
schemaItems =
MigrationLockId -> m () -> m ()
forall (m :: * -> *) a.
MonadOrville m =>
MigrationLockId -> m a -> m a
MigrationLock.withMigrationLock (MigrationOptions -> MigrationLockId
migrationLockId MigrationOptions
options) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
MigrationPlan
plan <- [SchemaItem] -> m MigrationPlan
forall (m :: * -> *).
MonadOrville m =>
[SchemaItem] -> m MigrationPlan
generateMigrationPlanWithoutLock [SchemaItem]
schemaItems
MigrationOptions -> MigrationPlan -> m ()
forall (m :: * -> *).
MonadOrville m =>
MigrationOptions -> MigrationPlan -> m ()
executeMigrationPlanWithoutLock MigrationOptions
options MigrationPlan
plan
generateMigrationPlan ::
Orville.MonadOrville m =>
MigrationOptions ->
[SchemaItem] ->
m MigrationPlan
generateMigrationPlan :: forall (m :: * -> *).
MonadOrville m =>
MigrationOptions -> [SchemaItem] -> m MigrationPlan
generateMigrationPlan MigrationOptions
options =
MigrationLockId -> m MigrationPlan -> m MigrationPlan
forall (m :: * -> *) a.
MonadOrville m =>
MigrationLockId -> m a -> m a
MigrationLock.withMigrationLock (MigrationOptions -> MigrationLockId
migrationLockId MigrationOptions
options)
(m MigrationPlan -> m MigrationPlan)
-> ([SchemaItem] -> m MigrationPlan)
-> [SchemaItem]
-> m MigrationPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SchemaItem] -> m MigrationPlan
forall (m :: * -> *).
MonadOrville m =>
[SchemaItem] -> m MigrationPlan
generateMigrationPlanWithoutLock
generateMigrationPlanWithoutLock :: Orville.MonadOrville m => [SchemaItem] -> m MigrationPlan
generateMigrationPlanWithoutLock :: forall (m :: * -> *).
MonadOrville m =>
[SchemaItem] -> m MigrationPlan
generateMigrationPlanWithoutLock [SchemaItem]
schemaItems =
m MigrationPlan -> m MigrationPlan
forall (m :: * -> *) a. MonadOrville m => m a -> m a
Orville.withTransaction (m MigrationPlan -> m MigrationPlan)
-> m MigrationPlan -> m MigrationPlan
forall a b. (a -> b) -> a -> b
$ do
NamespaceName
currentNamespace <- m NamespaceName
forall (m :: * -> *). MonadOrville m => m NamespaceName
findCurrentNamespace
let
pgCatalogRelations :: [(NamespaceName, RelationName)]
pgCatalogRelations = (SchemaItem -> (NamespaceName, RelationName))
-> [SchemaItem] -> [(NamespaceName, RelationName)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NamespaceName -> SchemaItem -> (NamespaceName, RelationName)
schemaItemPgCatalogRelation NamespaceName
currentNamespace) [SchemaItem]
schemaItems
DatabaseDescription
dbDesc <- [(NamespaceName, RelationName)] -> m DatabaseDescription
forall (m :: * -> *).
MonadOrville m =>
[(NamespaceName, RelationName)] -> m DatabaseDescription
PgCatalog.describeDatabaseRelations [(NamespaceName, RelationName)]
pgCatalogRelations
case (SchemaItem -> Either MigrationDataError [MigrationStepWithType])
-> [SchemaItem]
-> Either MigrationDataError [[MigrationStepWithType]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (NamespaceName
-> DatabaseDescription
-> SchemaItem
-> Either MigrationDataError [MigrationStepWithType]
calculateMigrationSteps NamespaceName
currentNamespace DatabaseDescription
dbDesc) [SchemaItem]
schemaItems of
Left MigrationDataError
err ->
IO MigrationPlan -> m MigrationPlan
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MigrationPlan -> m MigrationPlan)
-> (MigrationDataError -> IO MigrationPlan)
-> MigrationDataError
-> m MigrationPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MigrationDataError -> IO MigrationPlan
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (MigrationDataError -> m MigrationPlan)
-> MigrationDataError -> m MigrationPlan
forall a b. (a -> b) -> a -> b
$ MigrationDataError
err
Right [[MigrationStepWithType]]
migrationSteps ->
MigrationPlan -> m MigrationPlan
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MigrationPlan -> m MigrationPlan)
-> ([[MigrationStepWithType]] -> MigrationPlan)
-> [[MigrationStepWithType]]
-> m MigrationPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MigrationStepWithType] -> MigrationPlan
mkMigrationPlan ([MigrationStepWithType] -> MigrationPlan)
-> ([[MigrationStepWithType]] -> [MigrationStepWithType])
-> [[MigrationStepWithType]]
-> MigrationPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[MigrationStepWithType]] -> [MigrationStepWithType]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MigrationStepWithType]] -> m MigrationPlan)
-> [[MigrationStepWithType]] -> m MigrationPlan
forall a b. (a -> b) -> a -> b
$ [[MigrationStepWithType]]
migrationSteps
executeMigrationPlan ::
Orville.MonadOrville m =>
MigrationOptions ->
MigrationPlan ->
m ()
executeMigrationPlan :: forall (m :: * -> *).
MonadOrville m =>
MigrationOptions -> MigrationPlan -> m ()
executeMigrationPlan MigrationOptions
options =
MigrationLockId -> m () -> m ()
forall (m :: * -> *) a.
MonadOrville m =>
MigrationLockId -> m a -> m a
MigrationLock.withMigrationLock (MigrationOptions -> MigrationLockId
migrationLockId MigrationOptions
options)
(m () -> m ()) -> (MigrationPlan -> m ()) -> MigrationPlan -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MigrationOptions -> MigrationPlan -> m ()
forall (m :: * -> *).
MonadOrville m =>
MigrationOptions -> MigrationPlan -> m ()
executeMigrationPlanWithoutLock MigrationOptions
options
executeMigrationPlanWithoutLock ::
Orville.MonadOrville m =>
MigrationOptions ->
MigrationPlan ->
m ()
executeMigrationPlanWithoutLock :: forall (m :: * -> *).
MonadOrville m =>
MigrationOptions -> MigrationPlan -> m ()
executeMigrationPlanWithoutLock MigrationOptions
options MigrationPlan
plan = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MigrationOptions -> Bool
runSchemaChanges MigrationOptions
options)
(m () -> m ()) -> (MigrationPlan -> m ()) -> MigrationPlan -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> m ()
forall (m :: * -> *) a. MonadOrville m => m a -> m a
Orville.withTransaction
(m () -> m ()) -> (MigrationPlan -> m ()) -> MigrationPlan -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MigrationStep] -> m ()
forall (m :: * -> *). MonadOrville m => [MigrationStep] -> m ()
executeMigrationStepsWithoutTransaction
([MigrationStep] -> m ())
-> (MigrationPlan -> [MigrationStep]) -> MigrationPlan -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MigrationPlan -> [MigrationStep]
i_transactionalSteps
(MigrationPlan -> m ()) -> MigrationPlan -> m ()
forall a b. (a -> b) -> a -> b
$ MigrationPlan
plan
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MigrationOptions -> Bool
runConcurrentIndexCreations MigrationOptions
options)
(m () -> m ())
-> ([MigrationStep] -> m ()) -> [MigrationStep] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MigrationStep] -> m ()
forall (m :: * -> *). MonadOrville m => [MigrationStep] -> m ()
executeMigrationStepsWithoutTransaction
([MigrationStep] -> m ()) -> [MigrationStep] -> m ()
forall a b. (a -> b) -> a -> b
$ MigrationPlan -> [MigrationStep]
i_concurrentIndexSteps
(MigrationPlan -> [MigrationStep])
-> MigrationPlan -> [MigrationStep]
forall a b. (a -> b) -> a -> b
$ MigrationPlan
plan
executeMigrationStepsWithoutTransaction :: Orville.MonadOrville m => [MigrationStep] -> m ()
executeMigrationStepsWithoutTransaction :: forall (m :: * -> *). MonadOrville m => [MigrationStep] -> m ()
executeMigrationStepsWithoutTransaction =
(MigrationStep -> m ()) -> [MigrationStep] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (QueryType -> MigrationStep -> m ()
forall (m :: * -> *) sql.
(MonadOrville m, SqlExpression sql) =>
QueryType -> sql -> m ()
Orville.executeVoid QueryType
Orville.DDLQuery)
calculateMigrationSteps ::
PgCatalog.NamespaceName ->
PgCatalog.DatabaseDescription ->
SchemaItem ->
Either MigrationDataError [MigrationStepWithType]
calculateMigrationSteps :: NamespaceName
-> DatabaseDescription
-> SchemaItem
-> Either MigrationDataError [MigrationStepWithType]
calculateMigrationSteps NamespaceName
currentNamespace DatabaseDescription
dbDesc SchemaItem
schemaItem =
case SchemaItem
schemaItem of
SchemaTable TableDefinition key writeEntity readEntity
tableDef ->
[MigrationStepWithType]
-> Either MigrationDataError [MigrationStepWithType]
forall a b. b -> Either a b
Right ([MigrationStepWithType]
-> Either MigrationDataError [MigrationStepWithType])
-> [MigrationStepWithType]
-> Either MigrationDataError [MigrationStepWithType]
forall a b. (a -> b) -> a -> b
$
let
(NamespaceName
schemaName, RelationName
tableName) =
NamespaceName -> TableIdentifier -> (NamespaceName, RelationName)
tableIdToPgCatalogNames
NamespaceName
currentNamespace
(TableDefinition key writeEntity readEntity -> TableIdentifier
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableIdentifier
Orville.tableIdentifier TableDefinition key writeEntity readEntity
tableDef)
in
case RelationKind
-> (NamespaceName, RelationName)
-> DatabaseDescription
-> Maybe RelationDescription
PgCatalog.lookupRelationOfKind RelationKind
PgCatalog.OrdinaryTable (NamespaceName
schemaName, RelationName
tableName) DatabaseDescription
dbDesc of
Maybe RelationDescription
Nothing ->
NamespaceName
-> TableDefinition key writeEntity readEntity
-> [MigrationStepWithType]
forall key writeEntity readEntity.
NamespaceName
-> TableDefinition key writeEntity readEntity
-> [MigrationStepWithType]
mkCreateTableSteps NamespaceName
currentNamespace TableDefinition key writeEntity readEntity
tableDef
Just RelationDescription
relationDesc ->
NamespaceName
-> RelationDescription
-> TableDefinition key writeEntity readEntity
-> [MigrationStepWithType]
forall key writeEntity readEntity.
NamespaceName
-> RelationDescription
-> TableDefinition key writeEntity readEntity
-> [MigrationStepWithType]
mkAlterTableSteps NamespaceName
currentNamespace RelationDescription
relationDesc TableDefinition key writeEntity readEntity
tableDef
SchemaDropTable TableIdentifier
tableId ->
[MigrationStepWithType]
-> Either MigrationDataError [MigrationStepWithType]
forall a b. b -> Either a b
Right ([MigrationStepWithType]
-> Either MigrationDataError [MigrationStepWithType])
-> [MigrationStepWithType]
-> Either MigrationDataError [MigrationStepWithType]
forall a b. (a -> b) -> a -> b
$
let
(NamespaceName
schemaName, RelationName
tableName) =
NamespaceName -> TableIdentifier -> (NamespaceName, RelationName)
tableIdToPgCatalogNames NamespaceName
currentNamespace TableIdentifier
tableId
in
case (NamespaceName, RelationName)
-> DatabaseDescription -> Maybe RelationDescription
PgCatalog.lookupRelation (NamespaceName
schemaName, RelationName
tableName) DatabaseDescription
dbDesc of
Maybe RelationDescription
Nothing ->
[]
Just RelationDescription
_ ->
let
dropTableExpr :: DropTableExpr
dropTableExpr =
Maybe IfExists -> Qualified TableName -> DropTableExpr
Expr.dropTableExpr
Maybe IfExists
forall a. Maybe a
Nothing
(TableIdentifier -> Qualified TableName
Orville.tableIdQualifiedName TableIdentifier
tableId)
in
[StepType -> DropTableExpr -> MigrationStepWithType
forall sql.
SqlExpression sql =>
StepType -> sql -> MigrationStepWithType
mkMigrationStepWithType StepType
AddRemoveTablesAndColumns DropTableExpr
dropTableExpr]
SchemaSequence SequenceDefinition
sequenceDef ->
let
(NamespaceName
schemaName, RelationName
sequenceName) =
NamespaceName
-> SequenceIdentifier -> (NamespaceName, RelationName)
sequenceIdToPgCatalogNames
NamespaceName
currentNamespace
(SequenceDefinition -> SequenceIdentifier
Orville.sequenceIdentifier SequenceDefinition
sequenceDef)
in
case RelationKind
-> (NamespaceName, RelationName)
-> DatabaseDescription
-> Maybe RelationDescription
PgCatalog.lookupRelationOfKind RelationKind
PgCatalog.Sequence (NamespaceName
schemaName, RelationName
sequenceName) DatabaseDescription
dbDesc of
Maybe RelationDescription
Nothing ->
[MigrationStepWithType]
-> Either MigrationDataError [MigrationStepWithType]
forall a b. b -> Either a b
Right
[ StepType -> CreateSequenceExpr -> MigrationStepWithType
forall sql.
SqlExpression sql =>
StepType -> sql -> MigrationStepWithType
mkMigrationStepWithType
StepType
AddRemoveTablesAndColumns
(SequenceDefinition -> CreateSequenceExpr
Orville.mkCreateSequenceExpr SequenceDefinition
sequenceDef)
]
Just RelationDescription
relationDesc ->
case RelationDescription -> Maybe PgSequence
PgCatalog.relationSequence RelationDescription
relationDesc of
Maybe PgSequence
Nothing ->
MigrationDataError
-> Either MigrationDataError [MigrationStepWithType]
forall a b. a -> Either a b
Left (MigrationDataError
-> Either MigrationDataError [MigrationStepWithType])
-> (String -> MigrationDataError)
-> String
-> Either MigrationDataError [MigrationStepWithType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MigrationDataError
PgCatalogInvariantViolated (String -> Either MigrationDataError [MigrationStepWithType])
-> String -> Either MigrationDataError [MigrationStepWithType]
forall a b. (a -> b) -> a -> b
$
String
"Sequence "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> NamespaceName -> String
PgCatalog.namespaceNameToString NamespaceName
schemaName
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"."
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> RelationName -> String
PgCatalog.relationNameToString RelationName
sequenceName
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" was found in the 'pg_class' table but no corresponding 'pg_sequence' row was found"
Just PgSequence
pgSequence ->
[MigrationStepWithType]
-> Either MigrationDataError [MigrationStepWithType]
forall a b. b -> Either a b
Right ([MigrationStepWithType]
-> Either MigrationDataError [MigrationStepWithType])
-> [MigrationStepWithType]
-> Either MigrationDataError [MigrationStepWithType]
forall a b. (a -> b) -> a -> b
$
SequenceDefinition -> PgSequence -> [MigrationStepWithType]
mkAlterSequenceSteps SequenceDefinition
sequenceDef PgSequence
pgSequence
SchemaDropSequence SequenceIdentifier
sequenceId ->
[MigrationStepWithType]
-> Either MigrationDataError [MigrationStepWithType]
forall a b. b -> Either a b
Right ([MigrationStepWithType]
-> Either MigrationDataError [MigrationStepWithType])
-> [MigrationStepWithType]
-> Either MigrationDataError [MigrationStepWithType]
forall a b. (a -> b) -> a -> b
$
let
(NamespaceName
schemaName, RelationName
sequenceName) =
NamespaceName
-> SequenceIdentifier -> (NamespaceName, RelationName)
sequenceIdToPgCatalogNames NamespaceName
currentNamespace SequenceIdentifier
sequenceId
in
case RelationKind
-> (NamespaceName, RelationName)
-> DatabaseDescription
-> Maybe RelationDescription
PgCatalog.lookupRelationOfKind RelationKind
PgCatalog.Sequence (NamespaceName
schemaName, RelationName
sequenceName) DatabaseDescription
dbDesc of
Maybe RelationDescription
Nothing ->
[]
Just RelationDescription
_ ->
[ StepType -> DropSequenceExpr -> MigrationStepWithType
forall sql.
SqlExpression sql =>
StepType -> sql -> MigrationStepWithType
mkMigrationStepWithType
StepType
AddRemoveTablesAndColumns
(Maybe IfExists -> Qualified SequenceName -> DropSequenceExpr
Expr.dropSequenceExpr Maybe IfExists
forall a. Maybe a
Nothing (SequenceIdentifier -> Qualified SequenceName
Orville.sequenceIdQualifiedName SequenceIdentifier
sequenceId))
]
mkCreateTableSteps ::
PgCatalog.NamespaceName ->
Orville.TableDefinition key writeEntity readEntity ->
[MigrationStepWithType]
mkCreateTableSteps :: forall key writeEntity readEntity.
NamespaceName
-> TableDefinition key writeEntity readEntity
-> [MigrationStepWithType]
mkCreateTableSteps NamespaceName
currentNamespace TableDefinition key writeEntity readEntity
tableDef =
let
tableName :: Qualified TableName
tableName =
TableDefinition key writeEntity readEntity -> Qualified TableName
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Qualified TableName
Orville.tableName TableDefinition key writeEntity readEntity
tableDef
createTableExpr :: CreateTableExpr
createTableExpr =
Qualified TableName
-> [ColumnDefinition]
-> Maybe PrimaryKeyExpr
-> [TableConstraint]
-> CreateTableExpr
Expr.createTableExpr
Qualified TableName
tableName
(TableDefinition key writeEntity readEntity -> [ColumnDefinition]
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> [ColumnDefinition]
Orville.mkTableColumnDefinitions TableDefinition key writeEntity readEntity
tableDef)
(TableDefinition key writeEntity readEntity -> Maybe PrimaryKeyExpr
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Maybe PrimaryKeyExpr
Orville.mkTablePrimaryKeyExpr TableDefinition key writeEntity readEntity
tableDef)
[]
addConstraintActions :: [(StepType, AlterTableAction)]
addConstraintActions =
(ConstraintDefinition -> [(StepType, AlterTableAction)])
-> [ConstraintDefinition] -> [(StepType, AlterTableAction)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(NamespaceName
-> Set ConstraintMigrationKey
-> ConstraintDefinition
-> [(StepType, AlterTableAction)]
mkAddConstraintActions NamespaceName
currentNamespace Set ConstraintMigrationKey
forall a. Set a
Set.empty)
(TableConstraints -> [ConstraintDefinition]
Schema.tableConstraintDefinitions (TableConstraints -> [ConstraintDefinition])
-> TableConstraints -> [ConstraintDefinition]
forall a b. (a -> b) -> a -> b
$ TableDefinition key writeEntity readEntity -> TableConstraints
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableConstraints
Orville.tableConstraints TableDefinition key writeEntity readEntity
tableDef)
addIndexSteps :: [MigrationStepWithType]
addIndexSteps =
(IndexDefinition -> [MigrationStepWithType])
-> Map IndexMigrationKey IndexDefinition -> [MigrationStepWithType]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(Set IndexMigrationKey
-> Qualified TableName
-> IndexDefinition
-> [MigrationStepWithType]
mkAddIndexSteps Set IndexMigrationKey
forall a. Set a
Set.empty Qualified TableName
tableName)
(TableDefinition key writeEntity readEntity
-> Map IndexMigrationKey IndexDefinition
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> Map IndexMigrationKey IndexDefinition
Orville.tableIndexes TableDefinition key writeEntity readEntity
tableDef)
in
StepType -> CreateTableExpr -> MigrationStepWithType
forall sql.
SqlExpression sql =>
StepType -> sql -> MigrationStepWithType
mkMigrationStepWithType StepType
AddRemoveTablesAndColumns CreateTableExpr
createTableExpr
MigrationStepWithType
-> [MigrationStepWithType] -> [MigrationStepWithType]
forall a. a -> [a] -> [a]
: Qualified TableName
-> [(StepType, AlterTableAction)] -> [MigrationStepWithType]
mkConstraintSteps Qualified TableName
tableName [(StepType, AlterTableAction)]
addConstraintActions
[MigrationStepWithType]
-> [MigrationStepWithType] -> [MigrationStepWithType]
forall a. Semigroup a => a -> a -> a
<> [MigrationStepWithType]
addIndexSteps
mkAlterTableSteps ::
PgCatalog.NamespaceName ->
PgCatalog.RelationDescription ->
Orville.TableDefinition key writeEntity readEntity ->
[MigrationStepWithType]
mkAlterTableSteps :: forall key writeEntity readEntity.
NamespaceName
-> RelationDescription
-> TableDefinition key writeEntity readEntity
-> [MigrationStepWithType]
mkAlterTableSteps NamespaceName
currentNamespace RelationDescription
relationDesc TableDefinition key writeEntity readEntity
tableDef =
let
addAlterColumnActions :: [AlterTableAction]
addAlterColumnActions =
[[AlterTableAction]] -> [AlterTableAction]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[AlterTableAction]] -> [AlterTableAction])
-> [[AlterTableAction]] -> [AlterTableAction]
forall a b. (a -> b) -> a -> b
$
SqlMarshaller writeEntity readEntity
-> [[AlterTableAction]]
-> (MarshallerField writeEntity
-> [[AlterTableAction]] -> [[AlterTableAction]])
-> [[AlterTableAction]]
forall writeEntity readEntity result.
SqlMarshaller writeEntity readEntity
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
Orville.foldMarshallerFields
(AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
forall writeEntity readEntity.
AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
Orville.unannotatedSqlMarshaller (AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity)
-> AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
forall a b. (a -> b) -> a -> b
$ TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
Orville.tableMarshaller TableDefinition key writeEntity readEntity
tableDef)
[]
(ReadOnlyColumnOption
-> (forall nullability a.
FieldDefinition nullability a -> [AlterTableAction])
-> MarshallerField writeEntity
-> [[AlterTableAction]]
-> [[AlterTableAction]]
forall result entity.
ReadOnlyColumnOption
-> (forall nullability a. FieldDefinition nullability a -> result)
-> MarshallerField entity
-> [result]
-> [result]
Orville.collectFromField ReadOnlyColumnOption
Orville.IncludeReadOnlyColumns (RelationDescription
-> FieldDefinition nullability a -> [AlterTableAction]
forall nullability a.
RelationDescription
-> FieldDefinition nullability a -> [AlterTableAction]
mkAddAlterColumnActions RelationDescription
relationDesc))
dropColumnActions :: [AlterTableAction]
dropColumnActions =
(PgAttribute -> [AlterTableAction])
-> Map AttributeName PgAttribute -> [AlterTableAction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(TableDefinition key writeEntity readEntity
-> PgAttribute -> [AlterTableAction]
forall key readEntity writeEntity.
TableDefinition key readEntity writeEntity
-> PgAttribute -> [AlterTableAction]
mkDropColumnActions TableDefinition key writeEntity readEntity
tableDef)
(RelationDescription -> Map AttributeName PgAttribute
PgCatalog.relationAttributes RelationDescription
relationDesc)
existingConstraints :: Set ConstraintMigrationKey
existingConstraints =
[ConstraintMigrationKey] -> Set ConstraintMigrationKey
forall a. Ord a => [a] -> Set a
Set.fromList
([ConstraintMigrationKey] -> Set ConstraintMigrationKey)
-> (RelationDescription -> [ConstraintMigrationKey])
-> RelationDescription
-> Set ConstraintMigrationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstraintDescription -> Maybe ConstraintMigrationKey)
-> [ConstraintDescription] -> [ConstraintMigrationKey]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe ConstraintDescription -> Maybe ConstraintMigrationKey
pgConstraintMigrationKey
([ConstraintDescription] -> [ConstraintMigrationKey])
-> (RelationDescription -> [ConstraintDescription])
-> RelationDescription
-> [ConstraintMigrationKey]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationDescription -> [ConstraintDescription]
PgCatalog.relationConstraints
(RelationDescription -> Set ConstraintMigrationKey)
-> RelationDescription -> Set ConstraintMigrationKey
forall a b. (a -> b) -> a -> b
$ RelationDescription
relationDesc
constraintsToKeep :: Set ConstraintMigrationKey
constraintsToKeep =
(ConstraintMigrationKey -> ConstraintMigrationKey)
-> Set ConstraintMigrationKey -> Set ConstraintMigrationKey
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (NamespaceName -> ConstraintMigrationKey -> ConstraintMigrationKey
setDefaultSchemaNameOnConstraintKey NamespaceName
currentNamespace)
(Set ConstraintMigrationKey -> Set ConstraintMigrationKey)
-> (TableDefinition key writeEntity readEntity
-> Set ConstraintMigrationKey)
-> TableDefinition key writeEntity readEntity
-> Set ConstraintMigrationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableConstraints -> Set ConstraintMigrationKey
Schema.tableConstraintKeys
(TableConstraints -> Set ConstraintMigrationKey)
-> (TableDefinition key writeEntity readEntity -> TableConstraints)
-> TableDefinition key writeEntity readEntity
-> Set ConstraintMigrationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableDefinition key writeEntity readEntity -> TableConstraints
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableConstraints
Orville.tableConstraints
(TableDefinition key writeEntity readEntity
-> Set ConstraintMigrationKey)
-> TableDefinition key writeEntity readEntity
-> Set ConstraintMigrationKey
forall a b. (a -> b) -> a -> b
$ TableDefinition key writeEntity readEntity
tableDef
addConstraintActions :: [(StepType, AlterTableAction)]
addConstraintActions =
(ConstraintDefinition -> [(StepType, AlterTableAction)])
-> [ConstraintDefinition] -> [(StepType, AlterTableAction)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(NamespaceName
-> Set ConstraintMigrationKey
-> ConstraintDefinition
-> [(StepType, AlterTableAction)]
mkAddConstraintActions NamespaceName
currentNamespace Set ConstraintMigrationKey
existingConstraints)
(TableConstraints -> [ConstraintDefinition]
Schema.tableConstraintDefinitions (TableConstraints -> [ConstraintDefinition])
-> TableConstraints -> [ConstraintDefinition]
forall a b. (a -> b) -> a -> b
$ TableDefinition key writeEntity readEntity -> TableConstraints
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableConstraints
Orville.tableConstraints TableDefinition key writeEntity readEntity
tableDef)
dropConstraintActions :: [(StepType, AlterTableAction)]
dropConstraintActions =
(ConstraintDescription -> [(StepType, AlterTableAction)])
-> [ConstraintDescription] -> [(StepType, AlterTableAction)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(Set ConstraintMigrationKey
-> ConstraintDescription -> [(StepType, AlterTableAction)]
mkDropConstraintActions Set ConstraintMigrationKey
constraintsToKeep)
(RelationDescription -> [ConstraintDescription]
PgCatalog.relationConstraints RelationDescription
relationDesc)
systemIndexOids :: Set Oid
systemIndexOids =
[Oid] -> Set Oid
forall a. Ord a => [a] -> Set a
Set.fromList
([Oid] -> Set Oid)
-> (RelationDescription -> [Oid]) -> RelationDescription -> Set Oid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstraintDescription -> Maybe Oid)
-> [ConstraintDescription] -> [Oid]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (PgConstraint -> Maybe Oid
pgConstraintImpliedIndexOid (PgConstraint -> Maybe Oid)
-> (ConstraintDescription -> PgConstraint)
-> ConstraintDescription
-> Maybe Oid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstraintDescription -> PgConstraint
PgCatalog.constraintRecord)
([ConstraintDescription] -> [Oid])
-> (RelationDescription -> [ConstraintDescription])
-> RelationDescription
-> [Oid]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationDescription -> [ConstraintDescription]
PgCatalog.relationConstraints
(RelationDescription -> Set Oid) -> RelationDescription -> Set Oid
forall a b. (a -> b) -> a -> b
$ RelationDescription
relationDesc
isSystemIndex :: IndexDescription -> Bool
isSystemIndex IndexDescription
indexDesc =
Oid -> Set Oid -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member
(PgIndex -> Oid
PgCatalog.pgIndexPgClassOid (PgIndex -> Oid) -> PgIndex -> Oid
forall a b. (a -> b) -> a -> b
$ IndexDescription -> PgIndex
PgCatalog.indexRecord IndexDescription
indexDesc)
Set Oid
systemIndexOids
existingIndexes :: Set IndexMigrationKey
existingIndexes =
[IndexMigrationKey] -> Set IndexMigrationKey
forall a. Ord a => [a] -> Set a
Set.fromList
([IndexMigrationKey] -> Set IndexMigrationKey)
-> (RelationDescription -> [IndexMigrationKey])
-> RelationDescription
-> Set IndexMigrationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IndexDescription -> [IndexMigrationKey])
-> [IndexDescription] -> [IndexMigrationKey]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IndexDescription -> [IndexMigrationKey]
pgIndexMigrationKeys
([IndexDescription] -> [IndexMigrationKey])
-> (RelationDescription -> [IndexDescription])
-> RelationDescription
-> [IndexMigrationKey]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IndexDescription -> Bool)
-> [IndexDescription] -> [IndexDescription]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (IndexDescription -> Bool) -> IndexDescription -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexDescription -> Bool
isSystemIndex)
([IndexDescription] -> [IndexDescription])
-> (RelationDescription -> [IndexDescription])
-> RelationDescription
-> [IndexDescription]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationDescription -> [IndexDescription]
PgCatalog.relationIndexes
(RelationDescription -> Set IndexMigrationKey)
-> RelationDescription -> Set IndexMigrationKey
forall a b. (a -> b) -> a -> b
$ RelationDescription
relationDesc
indexesToKeep :: Set IndexMigrationKey
indexesToKeep =
Map IndexMigrationKey IndexDefinition -> Set IndexMigrationKey
forall k a. Map k a -> Set k
Map.keysSet
(Map IndexMigrationKey IndexDefinition -> Set IndexMigrationKey)
-> (TableDefinition key writeEntity readEntity
-> Map IndexMigrationKey IndexDefinition)
-> TableDefinition key writeEntity readEntity
-> Set IndexMigrationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableDefinition key writeEntity readEntity
-> Map IndexMigrationKey IndexDefinition
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> Map IndexMigrationKey IndexDefinition
Orville.tableIndexes
(TableDefinition key writeEntity readEntity
-> Set IndexMigrationKey)
-> TableDefinition key writeEntity readEntity
-> Set IndexMigrationKey
forall a b. (a -> b) -> a -> b
$ TableDefinition key writeEntity readEntity
tableDef
addIndexSteps :: [MigrationStepWithType]
addIndexSteps =
(IndexDefinition -> [MigrationStepWithType])
-> Map IndexMigrationKey IndexDefinition -> [MigrationStepWithType]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(Set IndexMigrationKey
-> Qualified TableName
-> IndexDefinition
-> [MigrationStepWithType]
mkAddIndexSteps Set IndexMigrationKey
existingIndexes Qualified TableName
tableName)
(TableDefinition key writeEntity readEntity
-> Map IndexMigrationKey IndexDefinition
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> Map IndexMigrationKey IndexDefinition
Orville.tableIndexes TableDefinition key writeEntity readEntity
tableDef)
dropIndexSteps :: [MigrationStepWithType]
dropIndexSteps =
(IndexDescription -> [MigrationStepWithType])
-> [IndexDescription] -> [MigrationStepWithType]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(Set IndexMigrationKey
-> Set Oid -> IndexDescription -> [MigrationStepWithType]
mkDropIndexSteps Set IndexMigrationKey
indexesToKeep Set Oid
systemIndexOids)
(RelationDescription -> [IndexDescription]
PgCatalog.relationIndexes RelationDescription
relationDesc)
tableName :: Qualified TableName
tableName =
TableDefinition key writeEntity readEntity -> Qualified TableName
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Qualified TableName
Orville.tableName TableDefinition key writeEntity readEntity
tableDef
in
Qualified TableName
-> [AlterTableAction] -> [MigrationStepWithType]
mkAlterColumnSteps Qualified TableName
tableName ([AlterTableAction]
addAlterColumnActions [AlterTableAction] -> [AlterTableAction] -> [AlterTableAction]
forall a. Semigroup a => a -> a -> a
<> [AlterTableAction]
dropColumnActions)
[MigrationStepWithType]
-> [MigrationStepWithType] -> [MigrationStepWithType]
forall a. Semigroup a => a -> a -> a
<> Qualified TableName
-> [(StepType, AlterTableAction)] -> [MigrationStepWithType]
mkConstraintSteps Qualified TableName
tableName ([(StepType, AlterTableAction)]
addConstraintActions [(StepType, AlterTableAction)]
-> [(StepType, AlterTableAction)] -> [(StepType, AlterTableAction)]
forall a. Semigroup a => a -> a -> a
<> [(StepType, AlterTableAction)]
dropConstraintActions)
[MigrationStepWithType]
-> [MigrationStepWithType] -> [MigrationStepWithType]
forall a. Semigroup a => a -> a -> a
<> [MigrationStepWithType]
addIndexSteps
[MigrationStepWithType]
-> [MigrationStepWithType] -> [MigrationStepWithType]
forall a. Semigroup a => a -> a -> a
<> [MigrationStepWithType]
dropIndexSteps
mkConstraintSteps ::
Expr.Qualified Expr.TableName ->
[(StepType, Expr.AlterTableAction)] ->
[MigrationStepWithType]
mkConstraintSteps :: Qualified TableName
-> [(StepType, AlterTableAction)] -> [MigrationStepWithType]
mkConstraintSteps Qualified TableName
tableName [(StepType, AlterTableAction)]
actions =
let
mkMapEntry ::
(StepType, Expr.AlterTableAction) ->
(StepType, NonEmpty Expr.AlterTableAction)
mkMapEntry :: (StepType, AlterTableAction)
-> (StepType, NonEmpty AlterTableAction)
mkMapEntry (StepType
keyType, AlterTableAction
action) =
(StepType
keyType, (AlterTableAction
action AlterTableAction -> [AlterTableAction] -> NonEmpty AlterTableAction
forall a. a -> [a] -> NonEmpty a
:| []))
addStep :: StepType
-> NonEmpty AlterTableAction
-> [MigrationStepWithType]
-> [MigrationStepWithType]
addStep StepType
stepType NonEmpty AlterTableAction
actionExprs [MigrationStepWithType]
steps =
StepType -> AlterTableExpr -> MigrationStepWithType
forall sql.
SqlExpression sql =>
StepType -> sql -> MigrationStepWithType
mkMigrationStepWithType StepType
stepType (Qualified TableName -> NonEmpty AlterTableAction -> AlterTableExpr
Expr.alterTableExpr Qualified TableName
tableName NonEmpty AlterTableAction
actionExprs) MigrationStepWithType
-> [MigrationStepWithType] -> [MigrationStepWithType]
forall a. a -> [a] -> [a]
: [MigrationStepWithType]
steps
in
(StepType
-> NonEmpty AlterTableAction
-> [MigrationStepWithType]
-> [MigrationStepWithType])
-> [MigrationStepWithType]
-> Map StepType (NonEmpty AlterTableAction)
-> [MigrationStepWithType]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey StepType
-> NonEmpty AlterTableAction
-> [MigrationStepWithType]
-> [MigrationStepWithType]
addStep []
(Map StepType (NonEmpty AlterTableAction)
-> [MigrationStepWithType])
-> ([(StepType, AlterTableAction)]
-> Map StepType (NonEmpty AlterTableAction))
-> [(StepType, AlterTableAction)]
-> [MigrationStepWithType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty AlterTableAction
-> NonEmpty AlterTableAction -> NonEmpty AlterTableAction)
-> [(StepType, NonEmpty AlterTableAction)]
-> Map StepType (NonEmpty AlterTableAction)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith NonEmpty AlterTableAction
-> NonEmpty AlterTableAction -> NonEmpty AlterTableAction
forall a. Semigroup a => a -> a -> a
(<>)
([(StepType, NonEmpty AlterTableAction)]
-> Map StepType (NonEmpty AlterTableAction))
-> ([(StepType, AlterTableAction)]
-> [(StepType, NonEmpty AlterTableAction)])
-> [(StepType, AlterTableAction)]
-> Map StepType (NonEmpty AlterTableAction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((StepType, AlterTableAction)
-> (StepType, NonEmpty AlterTableAction))
-> [(StepType, AlterTableAction)]
-> [(StepType, NonEmpty AlterTableAction)]
forall a b. (a -> b) -> [a] -> [b]
map (StepType, AlterTableAction)
-> (StepType, NonEmpty AlterTableAction)
mkMapEntry
([(StepType, AlterTableAction)] -> [MigrationStepWithType])
-> [(StepType, AlterTableAction)] -> [MigrationStepWithType]
forall a b. (a -> b) -> a -> b
$ [(StepType, AlterTableAction)]
actions
mkAlterColumnSteps ::
Expr.Qualified Expr.TableName ->
[Expr.AlterTableAction] ->
[MigrationStepWithType]
mkAlterColumnSteps :: Qualified TableName
-> [AlterTableAction] -> [MigrationStepWithType]
mkAlterColumnSteps Qualified TableName
tableName [AlterTableAction]
actionExprs =
case [AlterTableAction] -> Maybe (NonEmpty AlterTableAction)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [AlterTableAction]
actionExprs of
Maybe (NonEmpty AlterTableAction)
Nothing ->
[]
Just NonEmpty AlterTableAction
nonEmptyActionExprs ->
[StepType -> AlterTableExpr -> MigrationStepWithType
forall sql.
SqlExpression sql =>
StepType -> sql -> MigrationStepWithType
mkMigrationStepWithType StepType
AddRemoveTablesAndColumns (Qualified TableName -> NonEmpty AlterTableAction -> AlterTableExpr
Expr.alterTableExpr Qualified TableName
tableName NonEmpty AlterTableAction
nonEmptyActionExprs)]
mkAddAlterColumnActions ::
PgCatalog.RelationDescription ->
Orville.FieldDefinition nullability a ->
[Expr.AlterTableAction]
mkAddAlterColumnActions :: forall nullability a.
RelationDescription
-> FieldDefinition nullability a -> [AlterTableAction]
mkAddAlterColumnActions RelationDescription
relationDesc FieldDefinition nullability a
fieldDef =
let
pgAttributeName :: AttributeName
pgAttributeName =
String -> AttributeName
forall a. IsString a => String -> a
String.fromString (FieldName -> String
Orville.fieldNameToString (FieldName -> String) -> FieldName -> String
forall a b. (a -> b) -> a -> b
$ FieldDefinition nullability a -> FieldName
forall nullability a. FieldDefinition nullability a -> FieldName
Orville.fieldName FieldDefinition nullability a
fieldDef)
in
case AttributeName -> RelationDescription -> Maybe PgAttribute
PgCatalog.lookupAttribute AttributeName
pgAttributeName RelationDescription
relationDesc of
Just PgAttribute
attr
| PgAttribute -> Bool
PgCatalog.isOrdinaryColumn PgAttribute
attr ->
let
sqlType :: SqlType a
sqlType =
FieldDefinition nullability a -> SqlType a
forall nullability a. FieldDefinition nullability a -> SqlType a
Orville.fieldType FieldDefinition nullability a
fieldDef
typeIsChanged :: Bool
typeIsChanged =
(SqlType a -> Oid
forall a. SqlType a -> Oid
Orville.sqlTypeOid SqlType a
sqlType Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
/= PgAttribute -> Oid
PgCatalog.pgAttributeTypeOid PgAttribute
attr)
Bool -> Bool -> Bool
|| (SqlType a -> Maybe Int32
forall a. SqlType a -> Maybe Int32
Orville.sqlTypeMaximumLength SqlType a
sqlType Maybe Int32 -> Maybe Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= PgAttribute -> Maybe Int32
PgCatalog.pgAttributeMaxLength PgAttribute
attr)
columnName :: ColumnName
columnName =
FieldDefinition nullability a -> ColumnName
forall nullability a. FieldDefinition nullability a -> ColumnName
Orville.fieldColumnName FieldDefinition nullability a
fieldDef
dataType :: DataType
dataType =
SqlType a -> DataType
forall a. SqlType a -> DataType
Orville.sqlTypeExpr SqlType a
sqlType
alterType :: [AlterTableAction]
alterType = do
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
typeIsChanged
[ColumnName -> DataType -> Maybe UsingClause -> AlterTableAction
Expr.alterColumnType ColumnName
columnName DataType
dataType (UsingClause -> Maybe UsingClause
forall a. a -> Maybe a
Just (UsingClause -> Maybe UsingClause)
-> UsingClause -> Maybe UsingClause
forall a b. (a -> b) -> a -> b
$ ColumnName -> DataType -> UsingClause
Expr.usingCast ColumnName
columnName DataType
dataType)]
nullabilityIsChanged :: Bool
nullabilityIsChanged =
FieldDefinition nullability a -> Bool
forall nullability a. FieldDefinition nullability a -> Bool
Orville.fieldIsNotNullable FieldDefinition nullability a
fieldDef Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= PgAttribute -> Bool
PgCatalog.pgAttributeIsNotNull PgAttribute
attr
nullabilityAction :: AlterNotNull
nullabilityAction =
if FieldDefinition nullability a -> Bool
forall nullability a. FieldDefinition nullability a -> Bool
Orville.fieldIsNotNullable FieldDefinition nullability a
fieldDef
then AlterNotNull
Expr.setNotNull
else AlterNotNull
Expr.dropNotNull
alterNullability :: [AlterTableAction]
alterNullability = do
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
nullabilityIsChanged
[ColumnName -> AlterNotNull -> AlterTableAction
Expr.alterColumnNullability (FieldDefinition nullability a -> ColumnName
forall nullability a. FieldDefinition nullability a -> ColumnName
Orville.fieldColumnName FieldDefinition nullability a
fieldDef) AlterNotNull
nullabilityAction]
maybeExistingDefault :: Maybe PgAttributeDefault
maybeExistingDefault =
PgAttribute -> RelationDescription -> Maybe PgAttributeDefault
PgCatalog.lookupAttributeDefault PgAttribute
attr RelationDescription
relationDesc
maybeDefaultExpr :: Maybe ValueExpression
maybeDefaultExpr =
DefaultValue a -> ValueExpression
forall a. DefaultValue a -> ValueExpression
Orville.defaultValueExpression
(DefaultValue a -> ValueExpression)
-> Maybe (DefaultValue a) -> Maybe ValueExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldDefinition nullability a -> Maybe (DefaultValue a)
forall nullability a.
FieldDefinition nullability a -> Maybe (DefaultValue a)
Orville.fieldDefaultValue FieldDefinition nullability a
fieldDef
(Maybe AlterTableAction
dropDefault, Maybe AlterTableAction
setDefault) =
case (Maybe PgAttributeDefault
maybeExistingDefault, Maybe ValueExpression
maybeDefaultExpr) of
(Maybe PgAttributeDefault
Nothing, Maybe ValueExpression
Nothing) ->
(Maybe AlterTableAction
forall a. Maybe a
Nothing, Maybe AlterTableAction
forall a. Maybe a
Nothing)
(Just PgAttributeDefault
_, Maybe ValueExpression
Nothing) ->
if SqlType a -> Bool
forall a. SqlType a -> Bool
Orville.sqlTypeDontDropImplicitDefaultDuringMigrate SqlType a
sqlType
then (Maybe AlterTableAction
forall a. Maybe a
Nothing, Maybe AlterTableAction
forall a. Maybe a
Nothing)
else
( AlterTableAction -> Maybe AlterTableAction
forall a. a -> Maybe a
Just (ColumnName -> AlterTableAction
Expr.alterColumnDropDefault ColumnName
columnName)
, Maybe AlterTableAction
forall a. Maybe a
Nothing
)
(Maybe PgAttributeDefault
Nothing, Just ValueExpression
newDefault) ->
( Maybe AlterTableAction
forall a. Maybe a
Nothing
, AlterTableAction -> Maybe AlterTableAction
forall a. a -> Maybe a
Just (ColumnName -> ValueExpression -> AlterTableAction
forall valueExpression.
SqlExpression valueExpression =>
ColumnName -> valueExpression -> AlterTableAction
Expr.alterColumnSetDefault ColumnName
columnName ValueExpression
newDefault)
)
(Just PgAttributeDefault
oldDefault, Just ValueExpression
newDefault) ->
let
oldDefaultExprBytes :: ByteString
oldDefaultExprBytes =
Text -> ByteString
Enc.encodeUtf8
(Text -> ByteString)
-> (PgAttributeDefault -> Text) -> PgAttributeDefault -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgAttributeDefault -> Text
PgCatalog.pgAttributeDefaultExpression
(PgAttributeDefault -> ByteString)
-> PgAttributeDefault -> ByteString
forall a b. (a -> b) -> a -> b
$ PgAttributeDefault
oldDefault
newDefaultExprBytes :: ByteString
newDefaultExprBytes =
ValueExpression -> ByteString
forall sql. SqlExpression sql => sql -> ByteString
RawSql.toExampleBytes ValueExpression
newDefault
in
if ByteString
oldDefaultExprBytes ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
newDefaultExprBytes
then (Maybe AlterTableAction
forall a. Maybe a
Nothing, Maybe AlterTableAction
forall a. Maybe a
Nothing)
else
( AlterTableAction -> Maybe AlterTableAction
forall a. a -> Maybe a
Just (ColumnName -> AlterTableAction
Expr.alterColumnDropDefault ColumnName
columnName)
, AlterTableAction -> Maybe AlterTableAction
forall a. a -> Maybe a
Just (ColumnName -> ValueExpression -> AlterTableAction
forall valueExpression.
SqlExpression valueExpression =>
ColumnName -> valueExpression -> AlterTableAction
Expr.alterColumnSetDefault ColumnName
columnName ValueExpression
newDefault)
)
in
Maybe AlterTableAction -> [AlterTableAction]
forall a. Maybe a -> [a]
Maybe.maybeToList Maybe AlterTableAction
dropDefault [AlterTableAction] -> [AlterTableAction] -> [AlterTableAction]
forall a. Semigroup a => a -> a -> a
<> [AlterTableAction]
alterType [AlterTableAction] -> [AlterTableAction] -> [AlterTableAction]
forall a. Semigroup a => a -> a -> a
<> Maybe AlterTableAction -> [AlterTableAction]
forall a. Maybe a -> [a]
Maybe.maybeToList Maybe AlterTableAction
setDefault [AlterTableAction] -> [AlterTableAction] -> [AlterTableAction]
forall a. Semigroup a => a -> a -> a
<> [AlterTableAction]
alterNullability
Maybe PgAttribute
_ ->
[ColumnDefinition -> AlterTableAction
Expr.addColumn (FieldDefinition nullability a -> ColumnDefinition
forall nullability a.
FieldDefinition nullability a -> ColumnDefinition
Orville.fieldColumnDefinition FieldDefinition nullability a
fieldDef)]
mkDropColumnActions ::
Orville.TableDefinition key readEntity writeEntity ->
PgCatalog.PgAttribute ->
[Expr.AlterTableAction]
mkDropColumnActions :: forall key readEntity writeEntity.
TableDefinition key readEntity writeEntity
-> PgAttribute -> [AlterTableAction]
mkDropColumnActions TableDefinition key readEntity writeEntity
tableDef PgAttribute
attr = do
let
attrName :: String
attrName =
AttributeName -> String
PgCatalog.attributeNameToString (AttributeName -> String) -> AttributeName -> String
forall a b. (a -> b) -> a -> b
$ PgAttribute -> AttributeName
PgCatalog.pgAttributeName PgAttribute
attr
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member String
attrName (TableDefinition key readEntity writeEntity -> Set String
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Set String
Orville.columnsToDrop TableDefinition key readEntity writeEntity
tableDef)
[ColumnName -> AlterTableAction
Expr.dropColumn (ColumnName -> AlterTableAction) -> ColumnName -> AlterTableAction
forall a b. (a -> b) -> a -> b
$ String -> ColumnName
Expr.columnName String
attrName]
setDefaultSchemaNameOnConstraintKey ::
PgCatalog.NamespaceName ->
Orville.ConstraintMigrationKey ->
Orville.ConstraintMigrationKey
setDefaultSchemaNameOnConstraintKey :: NamespaceName -> ConstraintMigrationKey -> ConstraintMigrationKey
setDefaultSchemaNameOnConstraintKey NamespaceName
currentNamespace ConstraintMigrationKey
constraintKey =
case ConstraintMigrationKey -> Maybe TableIdentifier
Orville.constraintKeyForeignTable ConstraintMigrationKey
constraintKey of
Maybe TableIdentifier
Nothing ->
ConstraintMigrationKey
constraintKey
Just TableIdentifier
foreignTable ->
case TableIdentifier -> Maybe String
Orville.tableIdSchemaNameString TableIdentifier
foreignTable of
Maybe String
Nothing ->
ConstraintMigrationKey
constraintKey
{ constraintKeyForeignTable :: Maybe TableIdentifier
Orville.constraintKeyForeignTable =
TableIdentifier -> Maybe TableIdentifier
forall a. a -> Maybe a
Just (TableIdentifier -> Maybe TableIdentifier)
-> TableIdentifier -> Maybe TableIdentifier
forall a b. (a -> b) -> a -> b
$
String -> TableIdentifier -> TableIdentifier
Orville.setTableIdSchema
(NamespaceName -> String
PgCatalog.namespaceNameToString NamespaceName
currentNamespace)
TableIdentifier
foreignTable
}
Just String
_ ->
ConstraintMigrationKey
constraintKey
mkAddConstraintActions ::
PgCatalog.NamespaceName ->
Set.Set Orville.ConstraintMigrationKey ->
Orville.ConstraintDefinition ->
[(StepType, Expr.AlterTableAction)]
mkAddConstraintActions :: NamespaceName
-> Set ConstraintMigrationKey
-> ConstraintDefinition
-> [(StepType, AlterTableAction)]
mkAddConstraintActions NamespaceName
currentNamespace Set ConstraintMigrationKey
existingConstraints ConstraintDefinition
constraintDef =
let
constraintKey :: ConstraintMigrationKey
constraintKey =
NamespaceName -> ConstraintMigrationKey -> ConstraintMigrationKey
setDefaultSchemaNameOnConstraintKey NamespaceName
currentNamespace (ConstraintMigrationKey -> ConstraintMigrationKey)
-> ConstraintMigrationKey -> ConstraintMigrationKey
forall a b. (a -> b) -> a -> b
$
ConstraintDefinition -> ConstraintMigrationKey
Orville.constraintMigrationKey ConstraintDefinition
constraintDef
stepType :: StepType
stepType =
case ConstraintMigrationKey -> ConstraintKeyType
Orville.constraintKeyType ConstraintMigrationKey
constraintKey of
ConstraintKeyType
Orville.UniqueConstraint -> StepType
AddUniqueConstraints
ConstraintKeyType
Orville.ForeignKeyConstraint -> StepType
AddForeignKeys
in
if ConstraintMigrationKey -> Set ConstraintMigrationKey -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ConstraintMigrationKey
constraintKey Set ConstraintMigrationKey
existingConstraints
then []
else [(StepType
stepType, TableConstraint -> AlterTableAction
Expr.addConstraint (ConstraintDefinition -> TableConstraint
Orville.constraintSqlExpr ConstraintDefinition
constraintDef))]
mkDropConstraintActions ::
Set.Set Orville.ConstraintMigrationKey ->
PgCatalog.ConstraintDescription ->
[(StepType, Expr.AlterTableAction)]
mkDropConstraintActions :: Set ConstraintMigrationKey
-> ConstraintDescription -> [(StepType, AlterTableAction)]
mkDropConstraintActions Set ConstraintMigrationKey
constraintsToKeep ConstraintDescription
constraint =
case ConstraintDescription -> Maybe ConstraintMigrationKey
pgConstraintMigrationKey ConstraintDescription
constraint of
Maybe ConstraintMigrationKey
Nothing ->
[]
Just ConstraintMigrationKey
constraintKey ->
if ConstraintMigrationKey -> Set ConstraintMigrationKey -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ConstraintMigrationKey
constraintKey Set ConstraintMigrationKey
constraintsToKeep
then []
else
let
constraintName :: ConstraintName
constraintName =
String -> ConstraintName
Expr.constraintName
(String -> ConstraintName)
-> (ConstraintDescription -> String)
-> ConstraintDescription
-> ConstraintName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstraintName -> String
PgCatalog.constraintNameToString
(ConstraintName -> String)
-> (ConstraintDescription -> ConstraintName)
-> ConstraintDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgConstraint -> ConstraintName
PgCatalog.pgConstraintName
(PgConstraint -> ConstraintName)
-> (ConstraintDescription -> PgConstraint)
-> ConstraintDescription
-> ConstraintName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstraintDescription -> PgConstraint
PgCatalog.constraintRecord
(ConstraintDescription -> ConstraintName)
-> ConstraintDescription -> ConstraintName
forall a b. (a -> b) -> a -> b
$ ConstraintDescription
constraint
stepType :: StepType
stepType =
case ConstraintMigrationKey -> ConstraintKeyType
Orville.constraintKeyType ConstraintMigrationKey
constraintKey of
ConstraintKeyType
Orville.UniqueConstraint -> StepType
DropUniqueConstraints
ConstraintKeyType
Orville.ForeignKeyConstraint -> StepType
DropForeignKeys
in
[(StepType
stepType, ConstraintName -> AlterTableAction
Expr.dropConstraint ConstraintName
constraintName)]
pgConstraintMigrationKey ::
PgCatalog.ConstraintDescription ->
Maybe Orville.ConstraintMigrationKey
pgConstraintMigrationKey :: ConstraintDescription -> Maybe ConstraintMigrationKey
pgConstraintMigrationKey ConstraintDescription
constraintDesc =
let
toOrvilleConstraintKeyType :: ConstraintType -> Maybe ConstraintKeyType
toOrvilleConstraintKeyType ConstraintType
pgConType =
case ConstraintType
pgConType of
ConstraintType
PgCatalog.UniqueConstraint -> ConstraintKeyType -> Maybe ConstraintKeyType
forall a. a -> Maybe a
Just ConstraintKeyType
Orville.UniqueConstraint
ConstraintType
PgCatalog.ForeignKeyConstraint -> ConstraintKeyType -> Maybe ConstraintKeyType
forall a. a -> Maybe a
Just ConstraintKeyType
Orville.ForeignKeyConstraint
ConstraintType
_ -> Maybe ConstraintKeyType
forall a. Maybe a
Nothing
constraint :: PgConstraint
constraint =
ConstraintDescription -> PgConstraint
PgCatalog.constraintRecord ConstraintDescription
constraintDesc
pgAttributeNamesToFieldNames :: [PgAttribute] -> [FieldName]
pgAttributeNamesToFieldNames =
(PgAttribute -> FieldName) -> [PgAttribute] -> [FieldName]
forall a b. (a -> b) -> [a] -> [b]
map (String -> FieldName
Orville.stringToFieldName (String -> FieldName)
-> (PgAttribute -> String) -> PgAttribute -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeName -> String
PgCatalog.attributeNameToString (AttributeName -> String)
-> (PgAttribute -> AttributeName) -> PgAttribute -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgAttribute -> AttributeName
PgCatalog.pgAttributeName)
foreignRelationTableId :: PgCatalog.ForeignRelationDescription -> Orville.TableIdentifier
foreignRelationTableId :: ForeignRelationDescription -> TableIdentifier
foreignRelationTableId ForeignRelationDescription
foreignRelationDesc =
let
relationName :: String
relationName =
RelationName -> String
PgCatalog.relationNameToString
(RelationName -> String)
-> (ForeignRelationDescription -> RelationName)
-> ForeignRelationDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgClass -> RelationName
PgCatalog.pgClassRelationName
(PgClass -> RelationName)
-> (ForeignRelationDescription -> PgClass)
-> ForeignRelationDescription
-> RelationName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignRelationDescription -> PgClass
PgCatalog.foreignRelationClass
(ForeignRelationDescription -> String)
-> ForeignRelationDescription -> String
forall a b. (a -> b) -> a -> b
$ ForeignRelationDescription
foreignRelationDesc
namespaceName :: String
namespaceName =
NamespaceName -> String
PgCatalog.namespaceNameToString
(NamespaceName -> String)
-> (ForeignRelationDescription -> NamespaceName)
-> ForeignRelationDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgNamespace -> NamespaceName
PgCatalog.pgNamespaceName
(PgNamespace -> NamespaceName)
-> (ForeignRelationDescription -> PgNamespace)
-> ForeignRelationDescription
-> NamespaceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignRelationDescription -> PgNamespace
PgCatalog.foreignRelationNamespace
(ForeignRelationDescription -> String)
-> ForeignRelationDescription -> String
forall a b. (a -> b) -> a -> b
$ ForeignRelationDescription
foreignRelationDesc
in
String -> TableIdentifier -> TableIdentifier
Orville.setTableIdSchema String
namespaceName (TableIdentifier -> TableIdentifier)
-> TableIdentifier -> TableIdentifier
forall a b. (a -> b) -> a -> b
$
String -> TableIdentifier
Orville.unqualifiedNameToTableId String
relationName
in
do
ConstraintKeyType
keyType <- ConstraintType -> Maybe ConstraintKeyType
toOrvilleConstraintKeyType (PgConstraint -> ConstraintType
PgCatalog.pgConstraintType PgConstraint
constraint)
ConstraintMigrationKey -> Maybe ConstraintMigrationKey
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConstraintMigrationKey -> Maybe ConstraintMigrationKey)
-> ConstraintMigrationKey -> Maybe ConstraintMigrationKey
forall a b. (a -> b) -> a -> b
$
Orville.ConstraintMigrationKey
{ constraintKeyType :: ConstraintKeyType
Orville.constraintKeyType = ConstraintKeyType
keyType
, constraintKeyColumns :: Maybe [FieldName]
Orville.constraintKeyColumns =
([PgAttribute] -> [FieldName])
-> Maybe [PgAttribute] -> Maybe [FieldName]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
[PgAttribute] -> [FieldName]
pgAttributeNamesToFieldNames
(ConstraintDescription -> Maybe [PgAttribute]
PgCatalog.constraintKey ConstraintDescription
constraintDesc)
, constraintKeyForeignTable :: Maybe TableIdentifier
Orville.constraintKeyForeignTable =
(ForeignRelationDescription -> TableIdentifier)
-> Maybe ForeignRelationDescription -> Maybe TableIdentifier
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignRelationDescription -> TableIdentifier
foreignRelationTableId (ConstraintDescription -> Maybe ForeignRelationDescription
PgCatalog.constraintForeignRelation ConstraintDescription
constraintDesc)
, constraintKeyForeignColumns :: Maybe [FieldName]
Orville.constraintKeyForeignColumns =
([PgAttribute] -> [FieldName])
-> Maybe [PgAttribute] -> Maybe [FieldName]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
[PgAttribute] -> [FieldName]
pgAttributeNamesToFieldNames
(ConstraintDescription -> Maybe [PgAttribute]
PgCatalog.constraintForeignKey ConstraintDescription
constraintDesc)
, constraintKeyForeignKeyOnUpdateAction :: Maybe ForeignKeyAction
Orville.constraintKeyForeignKeyOnUpdateAction =
PgConstraint -> Maybe ForeignKeyAction
PgCatalog.pgConstraintForeignKeyOnUpdateType (PgConstraint -> Maybe ForeignKeyAction)
-> PgConstraint -> Maybe ForeignKeyAction
forall a b. (a -> b) -> a -> b
$ ConstraintDescription -> PgConstraint
PgCatalog.constraintRecord ConstraintDescription
constraintDesc
, constraintKeyForeignKeyOnDeleteAction :: Maybe ForeignKeyAction
Orville.constraintKeyForeignKeyOnDeleteAction =
PgConstraint -> Maybe ForeignKeyAction
PgCatalog.pgConstraintForeignKeyOnDeleteType (PgConstraint -> Maybe ForeignKeyAction)
-> PgConstraint -> Maybe ForeignKeyAction
forall a b. (a -> b) -> a -> b
$ ConstraintDescription -> PgConstraint
PgCatalog.constraintRecord ConstraintDescription
constraintDesc
}
mkAddIndexSteps ::
Set.Set IndexDefinition.IndexMigrationKey ->
Expr.Qualified Expr.TableName ->
Orville.IndexDefinition ->
[MigrationStepWithType]
mkAddIndexSteps :: Set IndexMigrationKey
-> Qualified TableName
-> IndexDefinition
-> [MigrationStepWithType]
mkAddIndexSteps Set IndexMigrationKey
existingIndexes Qualified TableName
tableName IndexDefinition
indexDef =
let
indexKey :: IndexMigrationKey
indexKey =
IndexDefinition -> IndexMigrationKey
IndexDefinition.indexMigrationKey IndexDefinition
indexDef
indexStep :: StepType
indexStep =
case IndexDefinition -> IndexCreationStrategy
Orville.indexCreationStrategy IndexDefinition
indexDef of
IndexCreationStrategy
Orville.Transactional -> StepType
AddIndexesTransactionally
IndexCreationStrategy
Orville.Concurrent -> StepType
AddIndexesConcurrently
in
if IndexMigrationKey -> Set IndexMigrationKey -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member IndexMigrationKey
indexKey Set IndexMigrationKey
existingIndexes
then []
else [StepType -> CreateIndexExpr -> MigrationStepWithType
forall sql.
SqlExpression sql =>
StepType -> sql -> MigrationStepWithType
mkMigrationStepWithType StepType
indexStep (IndexDefinition -> Qualified TableName -> CreateIndexExpr
Orville.indexCreateExpr IndexDefinition
indexDef Qualified TableName
tableName)]
mkDropIndexSteps ::
Set.Set IndexDefinition.IndexMigrationKey ->
Set.Set LibPQ.Oid ->
PgCatalog.IndexDescription ->
[MigrationStepWithType]
mkDropIndexSteps :: Set IndexMigrationKey
-> Set Oid -> IndexDescription -> [MigrationStepWithType]
mkDropIndexSteps Set IndexMigrationKey
indexesToKeep Set Oid
systemIndexOids IndexDescription
indexDesc =
case IndexDescription -> [IndexMigrationKey]
pgIndexMigrationKeys IndexDescription
indexDesc of
[] ->
[]
[IndexMigrationKey]
indexKeys ->
let
pgClass :: PgClass
pgClass =
IndexDescription -> PgClass
PgCatalog.indexPgClass IndexDescription
indexDesc
indexName :: IndexName
indexName =
String -> IndexName
Expr.indexName
(String -> IndexName)
-> (PgClass -> String) -> PgClass -> IndexName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationName -> String
PgCatalog.relationNameToString
(RelationName -> String)
-> (PgClass -> RelationName) -> PgClass -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgClass -> RelationName
PgCatalog.pgClassRelationName
(PgClass -> IndexName) -> PgClass -> IndexName
forall a b. (a -> b) -> a -> b
$ PgClass
pgClass
indexOid :: Oid
indexOid =
PgClass -> Oid
PgCatalog.pgClassOid PgClass
pgClass
in
if (IndexMigrationKey -> Bool) -> [IndexMigrationKey] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((IndexMigrationKey -> Set IndexMigrationKey -> Bool)
-> Set IndexMigrationKey -> IndexMigrationKey -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip IndexMigrationKey -> Set IndexMigrationKey -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Set IndexMigrationKey
indexesToKeep) [IndexMigrationKey]
indexKeys
Bool -> Bool -> Bool
|| Oid -> Set Oid -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Oid
indexOid Set Oid
systemIndexOids
then []
else [StepType -> DropIndexExpr -> MigrationStepWithType
forall sql.
SqlExpression sql =>
StepType -> sql -> MigrationStepWithType
mkMigrationStepWithType StepType
DropIndexes (IndexName -> DropIndexExpr
Expr.dropIndexExpr IndexName
indexName)]
pgConstraintImpliedIndexOid :: PgCatalog.PgConstraint -> Maybe LibPQ.Oid
pgConstraintImpliedIndexOid :: PgConstraint -> Maybe Oid
pgConstraintImpliedIndexOid PgConstraint
pgConstraint =
case PgConstraint -> ConstraintType
PgCatalog.pgConstraintType PgConstraint
pgConstraint of
ConstraintType
PgCatalog.PrimaryKeyConstraint ->
Oid -> Maybe Oid
forall a. a -> Maybe a
Just (Oid -> Maybe Oid) -> Oid -> Maybe Oid
forall a b. (a -> b) -> a -> b
$ PgConstraint -> Oid
PgCatalog.pgConstraintIndexOid PgConstraint
pgConstraint
ConstraintType
PgCatalog.UniqueConstraint ->
Oid -> Maybe Oid
forall a. a -> Maybe a
Just (Oid -> Maybe Oid) -> Oid -> Maybe Oid
forall a b. (a -> b) -> a -> b
$ PgConstraint -> Oid
PgCatalog.pgConstraintIndexOid PgConstraint
pgConstraint
ConstraintType
PgCatalog.ExclusionConstraint ->
Oid -> Maybe Oid
forall a. a -> Maybe a
Just (Oid -> Maybe Oid) -> Oid -> Maybe Oid
forall a b. (a -> b) -> a -> b
$ PgConstraint -> Oid
PgCatalog.pgConstraintIndexOid PgConstraint
pgConstraint
ConstraintType
PgCatalog.CheckConstraint ->
Maybe Oid
forall a. Maybe a
Nothing
ConstraintType
PgCatalog.ForeignKeyConstraint ->
Maybe Oid
forall a. Maybe a
Nothing
ConstraintType
PgCatalog.ConstraintTrigger ->
Maybe Oid
forall a. Maybe a
Nothing
pgIndexMigrationKeys ::
PgCatalog.IndexDescription ->
[IndexDefinition.IndexMigrationKey]
pgIndexMigrationKeys :: IndexDescription -> [IndexMigrationKey]
pgIndexMigrationKeys IndexDescription
indexDesc =
let
mkNamedIndexKey :: IndexMigrationKey
mkNamedIndexKey =
String -> IndexMigrationKey
IndexDefinition.NamedIndexKey
(String -> IndexMigrationKey)
-> (IndexDescription -> String)
-> IndexDescription
-> IndexMigrationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationName -> String
PgCatalog.relationNameToString
(RelationName -> String)
-> (IndexDescription -> RelationName) -> IndexDescription -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgClass -> RelationName
PgCatalog.pgClassRelationName
(PgClass -> RelationName)
-> (IndexDescription -> PgClass)
-> IndexDescription
-> RelationName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexDescription -> PgClass
PgCatalog.indexPgClass
(IndexDescription -> IndexMigrationKey)
-> IndexDescription -> IndexMigrationKey
forall a b. (a -> b) -> a -> b
$ IndexDescription
indexDesc
mkAttributeBasedIndexKey :: [IndexMigrationKey]
mkAttributeBasedIndexKey =
case IndexDescription -> Maybe AttributeBasedIndexMigrationKey
pgAttributeBasedIndexMigrationKey IndexDescription
indexDesc of
Just AttributeBasedIndexMigrationKey
standardKey ->
[AttributeBasedIndexMigrationKey -> IndexMigrationKey
IndexDefinition.AttributeBasedIndexKey AttributeBasedIndexMigrationKey
standardKey]
Maybe AttributeBasedIndexMigrationKey
Nothing ->
[]
in
[IndexMigrationKey
mkNamedIndexKey] [IndexMigrationKey] -> [IndexMigrationKey] -> [IndexMigrationKey]
forall a. [a] -> [a] -> [a]
++ [IndexMigrationKey]
mkAttributeBasedIndexKey
pgAttributeBasedIndexMigrationKey ::
PgCatalog.IndexDescription ->
Maybe IndexDefinition.AttributeBasedIndexMigrationKey
pgAttributeBasedIndexMigrationKey :: IndexDescription -> Maybe AttributeBasedIndexMigrationKey
pgAttributeBasedIndexMigrationKey IndexDescription
indexDesc = do
let
indexMemberToFieldName :: IndexMember -> Maybe FieldName
indexMemberToFieldName IndexMember
member =
case IndexMember
member of
PgCatalog.IndexAttribute PgAttribute
attr ->
FieldName -> Maybe FieldName
forall a. a -> Maybe a
Just (String -> FieldName
Orville.stringToFieldName (String -> FieldName)
-> (PgAttribute -> String) -> PgAttribute -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeName -> String
PgCatalog.attributeNameToString (AttributeName -> String)
-> (PgAttribute -> AttributeName) -> PgAttribute -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgAttribute -> AttributeName
PgCatalog.pgAttributeName (PgAttribute -> FieldName) -> PgAttribute -> FieldName
forall a b. (a -> b) -> a -> b
$ PgAttribute
attr)
IndexMember
PgCatalog.IndexExpression ->
Maybe FieldName
forall a. Maybe a
Nothing
uniqueness :: IndexUniqueness
uniqueness =
if PgIndex -> Bool
PgCatalog.pgIndexIsUnique (IndexDescription -> PgIndex
PgCatalog.indexRecord IndexDescription
indexDesc)
then IndexUniqueness
Orville.UniqueIndex
else IndexUniqueness
Orville.NonUniqueIndex
[FieldName]
fieldNames <- (IndexMember -> Maybe FieldName)
-> [IndexMember] -> Maybe [FieldName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse IndexMember -> Maybe FieldName
indexMemberToFieldName (IndexDescription -> [IndexMember]
PgCatalog.indexMembers IndexDescription
indexDesc)
AttributeBasedIndexMigrationKey
-> Maybe AttributeBasedIndexMigrationKey
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttributeBasedIndexMigrationKey
-> Maybe AttributeBasedIndexMigrationKey)
-> AttributeBasedIndexMigrationKey
-> Maybe AttributeBasedIndexMigrationKey
forall a b. (a -> b) -> a -> b
$
IndexDefinition.AttributeBasedIndexMigrationKey
{ indexKeyUniqueness :: IndexUniqueness
IndexDefinition.indexKeyUniqueness = IndexUniqueness
uniqueness
, indexKeyColumns :: [FieldName]
IndexDefinition.indexKeyColumns = [FieldName]
fieldNames
}
schemaItemPgCatalogRelation ::
PgCatalog.NamespaceName ->
SchemaItem ->
(PgCatalog.NamespaceName, PgCatalog.RelationName)
schemaItemPgCatalogRelation :: NamespaceName -> SchemaItem -> (NamespaceName, RelationName)
schemaItemPgCatalogRelation NamespaceName
currentNamespace SchemaItem
item =
case SchemaItem
item of
SchemaTable TableDefinition key writeEntity readEntity
tableDef ->
NamespaceName -> TableIdentifier -> (NamespaceName, RelationName)
tableIdToPgCatalogNames NamespaceName
currentNamespace (TableDefinition key writeEntity readEntity -> TableIdentifier
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableIdentifier
Orville.tableIdentifier TableDefinition key writeEntity readEntity
tableDef)
SchemaDropTable TableIdentifier
tableId ->
NamespaceName -> TableIdentifier -> (NamespaceName, RelationName)
tableIdToPgCatalogNames NamespaceName
currentNamespace TableIdentifier
tableId
SchemaSequence SequenceDefinition
sequenceDef ->
NamespaceName
-> SequenceIdentifier -> (NamespaceName, RelationName)
sequenceIdToPgCatalogNames NamespaceName
currentNamespace (SequenceDefinition -> SequenceIdentifier
Orville.sequenceIdentifier SequenceDefinition
sequenceDef)
SchemaDropSequence SequenceIdentifier
sequenceId ->
NamespaceName
-> SequenceIdentifier -> (NamespaceName, RelationName)
sequenceIdToPgCatalogNames NamespaceName
currentNamespace SequenceIdentifier
sequenceId
tableIdToPgCatalogNames ::
PgCatalog.NamespaceName ->
Orville.TableIdentifier ->
(PgCatalog.NamespaceName, PgCatalog.RelationName)
tableIdToPgCatalogNames :: NamespaceName -> TableIdentifier -> (NamespaceName, RelationName)
tableIdToPgCatalogNames NamespaceName
currentNamespace TableIdentifier
tableId =
let
actualNamespace :: NamespaceName
actualNamespace =
NamespaceName
-> (String -> NamespaceName) -> Maybe String -> NamespaceName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NamespaceName
currentNamespace String -> NamespaceName
forall a. IsString a => String -> a
String.fromString
(Maybe String -> NamespaceName)
-> (TableIdentifier -> Maybe String)
-> TableIdentifier
-> NamespaceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableIdentifier -> Maybe String
Orville.tableIdSchemaNameString
(TableIdentifier -> NamespaceName)
-> TableIdentifier -> NamespaceName
forall a b. (a -> b) -> a -> b
$ TableIdentifier
tableId
relationName :: RelationName
relationName =
String -> RelationName
forall a. IsString a => String -> a
String.fromString
(String -> RelationName)
-> (TableIdentifier -> String) -> TableIdentifier -> RelationName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableIdentifier -> String
Orville.tableIdUnqualifiedNameString
(TableIdentifier -> RelationName)
-> TableIdentifier -> RelationName
forall a b. (a -> b) -> a -> b
$ TableIdentifier
tableId
in
(NamespaceName
actualNamespace, RelationName
relationName)
mkAlterSequenceSteps ::
Orville.SequenceDefinition ->
PgCatalog.PgSequence ->
[MigrationStepWithType]
mkAlterSequenceSteps :: SequenceDefinition -> PgSequence -> [MigrationStepWithType]
mkAlterSequenceSteps SequenceDefinition
sequenceDef PgSequence
pgSequence =
let
ifChanged ::
Eq a =>
(a -> expr) ->
(PgCatalog.PgSequence -> a) ->
(Orville.SequenceDefinition -> a) ->
Maybe expr
ifChanged :: forall a expr.
Eq a =>
(a -> expr)
-> (PgSequence -> a) -> (SequenceDefinition -> a) -> Maybe expr
ifChanged a -> expr
mkChange PgSequence -> a
getOld SequenceDefinition -> a
getNew =
if PgSequence -> a
getOld PgSequence
pgSequence a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== SequenceDefinition -> a
getNew SequenceDefinition
sequenceDef
then Maybe expr
forall a. Maybe a
Nothing
else expr -> Maybe expr
forall a. a -> Maybe a
Just (expr -> Maybe expr)
-> (SequenceDefinition -> expr) -> SequenceDefinition -> Maybe expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> expr
mkChange (a -> expr)
-> (SequenceDefinition -> a) -> SequenceDefinition -> expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SequenceDefinition -> a
getNew (SequenceDefinition -> Maybe expr)
-> SequenceDefinition -> Maybe expr
forall a b. (a -> b) -> a -> b
$ SequenceDefinition
sequenceDef
mbIncrementByExpr :: Maybe IncrementByExpr
mbIncrementByExpr =
(Int64 -> IncrementByExpr)
-> (PgSequence -> Int64)
-> (SequenceDefinition -> Int64)
-> Maybe IncrementByExpr
forall a expr.
Eq a =>
(a -> expr)
-> (PgSequence -> a) -> (SequenceDefinition -> a) -> Maybe expr
ifChanged Int64 -> IncrementByExpr
Expr.incrementBy PgSequence -> Int64
PgCatalog.pgSequenceIncrement SequenceDefinition -> Int64
Orville.sequenceIncrement
mbMinValueExpr :: Maybe MinValueExpr
mbMinValueExpr =
(Int64 -> MinValueExpr)
-> (PgSequence -> Int64)
-> (SequenceDefinition -> Int64)
-> Maybe MinValueExpr
forall a expr.
Eq a =>
(a -> expr)
-> (PgSequence -> a) -> (SequenceDefinition -> a) -> Maybe expr
ifChanged Int64 -> MinValueExpr
Expr.minValue PgSequence -> Int64
PgCatalog.pgSequenceMin SequenceDefinition -> Int64
Orville.sequenceMinValue
mbMaxValueExpr :: Maybe MaxValueExpr
mbMaxValueExpr =
(Int64 -> MaxValueExpr)
-> (PgSequence -> Int64)
-> (SequenceDefinition -> Int64)
-> Maybe MaxValueExpr
forall a expr.
Eq a =>
(a -> expr)
-> (PgSequence -> a) -> (SequenceDefinition -> a) -> Maybe expr
ifChanged Int64 -> MaxValueExpr
Expr.maxValue PgSequence -> Int64
PgCatalog.pgSequenceMax SequenceDefinition -> Int64
Orville.sequenceMaxValue
mbStartWithExpr :: Maybe StartWithExpr
mbStartWithExpr =
(Int64 -> StartWithExpr)
-> (PgSequence -> Int64)
-> (SequenceDefinition -> Int64)
-> Maybe StartWithExpr
forall a expr.
Eq a =>
(a -> expr)
-> (PgSequence -> a) -> (SequenceDefinition -> a) -> Maybe expr
ifChanged Int64 -> StartWithExpr
Expr.startWith PgSequence -> Int64
PgCatalog.pgSequenceStart SequenceDefinition -> Int64
Orville.sequenceStart
mbCacheExpr :: Maybe CacheExpr
mbCacheExpr =
(Int64 -> CacheExpr)
-> (PgSequence -> Int64)
-> (SequenceDefinition -> Int64)
-> Maybe CacheExpr
forall a expr.
Eq a =>
(a -> expr)
-> (PgSequence -> a) -> (SequenceDefinition -> a) -> Maybe expr
ifChanged Int64 -> CacheExpr
Expr.cache PgSequence -> Int64
PgCatalog.pgSequenceCache SequenceDefinition -> Int64
Orville.sequenceCache
mbCycleExpr :: Maybe CycleExpr
mbCycleExpr =
(Bool -> CycleExpr)
-> (PgSequence -> Bool)
-> (SequenceDefinition -> Bool)
-> Maybe CycleExpr
forall a expr.
Eq a =>
(a -> expr)
-> (PgSequence -> a) -> (SequenceDefinition -> a) -> Maybe expr
ifChanged Bool -> CycleExpr
Expr.cycleIfTrue PgSequence -> Bool
PgCatalog.pgSequenceCycle SequenceDefinition -> Bool
Orville.sequenceCycle
applyChange :: (Bool, Maybe a -> b) -> Maybe a -> (Bool, b)
applyChange :: forall a b. (Bool, Maybe a -> b) -> Maybe a -> (Bool, b)
applyChange (Bool
changed, Maybe a -> b
exprF) Maybe a
mbArg =
(Bool
changed Bool -> Bool -> Bool
|| Maybe a -> Bool
forall a. Maybe a -> Bool
Maybe.isJust Maybe a
mbArg, Maybe a -> b
exprF Maybe a
mbArg)
(Bool
anyChanges, AlterSequenceExpr
migrateSequenceExpr) =
(Bool
False, Qualified SequenceName
-> Maybe IncrementByExpr
-> Maybe MinValueExpr
-> Maybe MaxValueExpr
-> Maybe StartWithExpr
-> Maybe CacheExpr
-> Maybe CycleExpr
-> AlterSequenceExpr
Expr.alterSequenceExpr (SequenceDefinition -> Qualified SequenceName
Orville.sequenceName SequenceDefinition
sequenceDef))
(Bool,
Maybe IncrementByExpr
-> Maybe MinValueExpr
-> Maybe MaxValueExpr
-> Maybe StartWithExpr
-> Maybe CacheExpr
-> Maybe CycleExpr
-> AlterSequenceExpr)
-> Maybe IncrementByExpr
-> (Bool,
Maybe MinValueExpr
-> Maybe MaxValueExpr
-> Maybe StartWithExpr
-> Maybe CacheExpr
-> Maybe CycleExpr
-> AlterSequenceExpr)
forall a b. (Bool, Maybe a -> b) -> Maybe a -> (Bool, b)
`applyChange` Maybe IncrementByExpr
mbIncrementByExpr
(Bool,
Maybe MinValueExpr
-> Maybe MaxValueExpr
-> Maybe StartWithExpr
-> Maybe CacheExpr
-> Maybe CycleExpr
-> AlterSequenceExpr)
-> Maybe MinValueExpr
-> (Bool,
Maybe MaxValueExpr
-> Maybe StartWithExpr
-> Maybe CacheExpr
-> Maybe CycleExpr
-> AlterSequenceExpr)
forall a b. (Bool, Maybe a -> b) -> Maybe a -> (Bool, b)
`applyChange` Maybe MinValueExpr
mbMinValueExpr
(Bool,
Maybe MaxValueExpr
-> Maybe StartWithExpr
-> Maybe CacheExpr
-> Maybe CycleExpr
-> AlterSequenceExpr)
-> Maybe MaxValueExpr
-> (Bool,
Maybe StartWithExpr
-> Maybe CacheExpr -> Maybe CycleExpr -> AlterSequenceExpr)
forall a b. (Bool, Maybe a -> b) -> Maybe a -> (Bool, b)
`applyChange` Maybe MaxValueExpr
mbMaxValueExpr
(Bool,
Maybe StartWithExpr
-> Maybe CacheExpr -> Maybe CycleExpr -> AlterSequenceExpr)
-> Maybe StartWithExpr
-> (Bool, Maybe CacheExpr -> Maybe CycleExpr -> AlterSequenceExpr)
forall a b. (Bool, Maybe a -> b) -> Maybe a -> (Bool, b)
`applyChange` Maybe StartWithExpr
mbStartWithExpr
(Bool, Maybe CacheExpr -> Maybe CycleExpr -> AlterSequenceExpr)
-> Maybe CacheExpr -> (Bool, Maybe CycleExpr -> AlterSequenceExpr)
forall a b. (Bool, Maybe a -> b) -> Maybe a -> (Bool, b)
`applyChange` Maybe CacheExpr
mbCacheExpr
(Bool, Maybe CycleExpr -> AlterSequenceExpr)
-> Maybe CycleExpr -> (Bool, AlterSequenceExpr)
forall a b. (Bool, Maybe a -> b) -> Maybe a -> (Bool, b)
`applyChange` Maybe CycleExpr
mbCycleExpr
in
if Bool
anyChanges
then [StepType -> AlterSequenceExpr -> MigrationStepWithType
forall sql.
SqlExpression sql =>
StepType -> sql -> MigrationStepWithType
mkMigrationStepWithType StepType
AddRemoveTablesAndColumns AlterSequenceExpr
migrateSequenceExpr]
else []
sequenceIdToPgCatalogNames ::
PgCatalog.NamespaceName ->
Orville.SequenceIdentifier ->
(PgCatalog.NamespaceName, PgCatalog.RelationName)
sequenceIdToPgCatalogNames :: NamespaceName
-> SequenceIdentifier -> (NamespaceName, RelationName)
sequenceIdToPgCatalogNames NamespaceName
currentNamespace SequenceIdentifier
sequenceId =
let
actualNamespace :: NamespaceName
actualNamespace =
NamespaceName
-> (String -> NamespaceName) -> Maybe String -> NamespaceName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NamespaceName
currentNamespace String -> NamespaceName
forall a. IsString a => String -> a
String.fromString
(Maybe String -> NamespaceName)
-> (SequenceIdentifier -> Maybe String)
-> SequenceIdentifier
-> NamespaceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SequenceIdentifier -> Maybe String
Orville.sequenceIdSchemaNameString
(SequenceIdentifier -> NamespaceName)
-> SequenceIdentifier -> NamespaceName
forall a b. (a -> b) -> a -> b
$ SequenceIdentifier
sequenceId
relationName :: RelationName
relationName =
String -> RelationName
forall a. IsString a => String -> a
String.fromString
(String -> RelationName)
-> (SequenceIdentifier -> String)
-> SequenceIdentifier
-> RelationName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SequenceIdentifier -> String
Orville.sequenceIdUnqualifiedNameString
(SequenceIdentifier -> RelationName)
-> SequenceIdentifier -> RelationName
forall a b. (a -> b) -> a -> b
$ SequenceIdentifier
sequenceId
in
(NamespaceName
actualNamespace, RelationName
relationName)
currentNamespaceQuery :: Expr.QueryExpr
currentNamespaceQuery :: QueryExpr
currentNamespaceQuery =
SelectClause -> SelectList -> Maybe TableExpr -> QueryExpr
Expr.queryExpr
(SelectExpr -> SelectClause
Expr.selectClause (Maybe Distinct -> SelectExpr
Expr.selectExpr Maybe Distinct
forall a. Maybe a
Nothing))
( [DerivedColumn] -> SelectList
Expr.selectDerivedColumns
[ ValueExpression -> ColumnName -> DerivedColumn
Expr.deriveColumnAs
(String -> ValueExpression
forall a. SqlExpression a => String -> a
RawSql.unsafeSqlExpression String
"current_schema")
(FieldDefinition NotNull NamespaceName -> ColumnName
forall nullability a. FieldDefinition nullability a -> ColumnName
Orville.fieldColumnName FieldDefinition NotNull NamespaceName
PgCatalog.namespaceNameField)
]
)
Maybe TableExpr
forall a. Maybe a
Nothing
findCurrentNamespace :: Orville.MonadOrville m => m PgCatalog.NamespaceName
findCurrentNamespace :: forall (m :: * -> *). MonadOrville m => m NamespaceName
findCurrentNamespace = do
[NamespaceName]
results <-
QueryType
-> QueryExpr
-> AnnotatedSqlMarshaller NamespaceName NamespaceName
-> m [NamespaceName]
forall (m :: * -> *) sql writeEntity readEntity.
(MonadOrville m, SqlExpression sql) =>
QueryType
-> sql
-> AnnotatedSqlMarshaller writeEntity readEntity
-> m [readEntity]
Orville.executeAndDecode
QueryType
Orville.SelectQuery
QueryExpr
currentNamespaceQuery
(SqlMarshaller NamespaceName NamespaceName
-> AnnotatedSqlMarshaller NamespaceName NamespaceName
forall writeEntity readEntity.
SqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
Orville.annotateSqlMarshallerEmptyAnnotation (SqlMarshaller NamespaceName NamespaceName
-> AnnotatedSqlMarshaller NamespaceName NamespaceName)
-> SqlMarshaller NamespaceName NamespaceName
-> AnnotatedSqlMarshaller NamespaceName NamespaceName
forall a b. (a -> b) -> a -> b
$ (NamespaceName -> NamespaceName)
-> FieldDefinition NotNull NamespaceName
-> SqlMarshaller NamespaceName NamespaceName
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Orville.marshallField NamespaceName -> NamespaceName
forall a. a -> a
id FieldDefinition NotNull NamespaceName
PgCatalog.namespaceNameField)
IO NamespaceName -> m NamespaceName
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NamespaceName -> m NamespaceName)
-> IO NamespaceName -> m NamespaceName
forall a b. (a -> b) -> a -> b
$
case [NamespaceName]
results of
[NamespaceName
schemaAndCatalog] ->
NamespaceName -> IO NamespaceName
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NamespaceName
schemaAndCatalog
[] ->
MigrationDataError -> IO NamespaceName
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (MigrationDataError -> IO NamespaceName)
-> MigrationDataError -> IO NamespaceName
forall a b. (a -> b) -> a -> b
$ String -> MigrationDataError
UnableToDiscoverCurrentSchema String
"No results returned by current_schema query"
[NamespaceName]
_ ->
MigrationDataError -> IO NamespaceName
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (MigrationDataError -> IO NamespaceName)
-> MigrationDataError -> IO NamespaceName
forall a b. (a -> b) -> a -> b
$ String -> MigrationDataError
UnableToDiscoverCurrentSchema String
"Multiple results returned by current_schema query"