persistent-postgresql 2.14.1.0 → 2.14.2.0
raw patch · 4 files changed
+115/−45 lines, 4 files
Files
- ChangeLog.md +5/−0
- Database/Persist/Postgresql/Internal/Migration.hs +51/−44
- persistent-postgresql.cabal +1/−1
- test/MigrationSpec.hs +58/−0
ChangeLog.md view
@@ -1,5 +1,10 @@ # Changelog for persistent-postgresql +# 2.14.2.0++* [#1614](https://github.com/yesodweb/persistent/pull/1614)+ * Generate migrations to create foreign key constraints while adding new foreign key columns (previously you had to generate migrations twice to create foreign key constraints)+ # 2.14.1.0 * [#1612](https://github.com/yesodweb/persistent/pull/1612)
Database/Persist/Postgresql/Internal/Migration.hs view
@@ -1097,80 +1097,87 @@ -> EntityDef -- ^ The entity definition for the entity that we're working on. -> Column- -- ^ The column that we're searching for potential alterations for.+ -- ^ The column that we're searching for potential alterations for, derived+ -- from the Persistent EntityDef. That is: this is how we _want_ the column+ -- to look, and not necessarily how it actually looks in the database right+ -- now. -> [Column]+ -- ^ The columns for this table, as they currently exist in the database. -> ([AlterColumn], [Column])-findAlters defs edef col@(Column name isNull sqltype def _gen _defConstraintName _maxLen ref) cols =- case List.find (\c -> cName c == name) cols of+findAlters defs edef newCol oldCols =+ case List.find (\c -> cName c == cName newCol) oldCols of Nothing ->- ([AddColumn col], cols)+ ([AddColumn newCol] ++ refAdd (cReference newCol), oldCols) Just- (Column _oldName isNull' sqltype' def' _gen' _defConstraintName' _maxLen' ref') ->+ oldCol -> let refDrop Nothing = [] refDrop (Just ColumnReference{crConstraintName = cname}) = [DropReference cname] - refAdd Nothing = []- refAdd (Just colRef) =- case find ((== crTableName colRef) . getEntityDBName) defs of- Just refdef- | Just _oldName /= fmap fieldDB (getEntityIdField edef) ->- [ AddReference- (crTableName colRef)- (crConstraintName colRef)- (name NEL.:| [])- (NEL.toList $ Util.dbIdColumnsEsc escapeF refdef)- (crFieldCascade colRef)- ]- Just _ -> []- Nothing ->- error $- "could not find the entityDef for reftable["- ++ show (crTableName colRef)- ++ "]" modRef =- if equivalentRef ref ref'+ if equivalentRef (cReference oldCol) (cReference newCol) then []- else refDrop ref' ++ refAdd ref- modNull = case (isNull, isNull') of+ else refDrop (cReference oldCol) ++ refAdd (cReference newCol)+ modNull = case (cNull newCol, cNull oldCol) of (True, False) -> do- guard $ Just name /= fmap fieldDB (getEntityIdField edef)- pure (IsNull col)+ guard $ Just (cName newCol) /= fmap fieldDB (getEntityIdField edef)+ pure (IsNull newCol) (False, True) -> let- up = case def of+ up = case cDefault newCol of Nothing -> id- Just s -> (:) (UpdateNullToValue col s)+ Just s -> (:) (UpdateNullToValue newCol s) in- up [NotNull col]+ up [NotNull newCol] _ -> [] modType- | sqlTypeEq sqltype sqltype' = []+ | sqlTypeEq (cSqlType newCol) (cSqlType oldCol) = [] -- When converting from Persistent pre-2.0 databases, we -- need to make sure that TIMESTAMP WITHOUT TIME ZONE is -- treated as UTC.- | sqltype == SqlDayTime && sqltype' == SqlOther "timestamp" =- [ ChangeType col sqltype $+ | cSqlType newCol == SqlDayTime && cSqlType oldCol == SqlOther "timestamp" =+ [ ChangeType newCol (cSqlType newCol) $ T.concat [ " USING "- , escapeF name+ , escapeF (cName newCol) , " AT TIME ZONE 'UTC'" ] ]- | otherwise = [ChangeType col sqltype ""]+ | otherwise = [ChangeType newCol (cSqlType newCol) ""] modDef =- if def == def'- || isJust (T.stripPrefix "nextval" =<< def')+ if cDefault newCol == cDefault oldCol+ || isJust (T.stripPrefix "nextval" =<< cDefault oldCol) then []- else case def of- Nothing -> [NoDefault col]- Just s -> [Default col s]+ else case cDefault newCol of+ Nothing -> [NoDefault newCol]+ Just s -> [Default newCol s] dropSafe =- if safeToRemove edef name- then error "wtf" [Drop col (SafeToRemove True)]+ if safeToRemove edef (cName newCol)+ then error "wtf" [Drop newCol (SafeToRemove True)] else [] in ( modRef ++ modDef ++ modNull ++ modType ++ dropSafe- , filter (\c -> cName c /= name) cols+ , filter (\c -> cName c /= cName newCol) oldCols )+ where+ refAdd Nothing = []+ -- This check works around a bug where persistent will sometimes+ -- generate an erroneous ForeignRef for ID fields.+ -- See: https://github.com/yesodweb/persistent/issues/1615+ refAdd _ | fmap fieldDB (getEntityIdField edef) == Just (cName newCol) = []+ refAdd (Just colRef) =+ case find ((== crTableName colRef) . getEntityDBName) defs of+ Just refdef ->+ [ AddReference+ (crTableName colRef)+ (crConstraintName colRef)+ (cName newCol NEL.:| [])+ (NEL.toList $ Util.dbIdColumnsEsc escapeF refdef)+ (crFieldCascade colRef)+ ]+ Nothing ->+ error $+ "could not find the entityDef for reftable["+ ++ show (crTableName colRef)+ ++ "]"
persistent-postgresql.cabal view
@@ -1,5 +1,5 @@ name: persistent-postgresql-version: 2.14.1.0+version: 2.14.2.0 license: MIT license-file: LICENSE author: Felipe Lessa, Michael Snoyman <michael@snoyman.com>
test/MigrationSpec.hs view
@@ -60,6 +60,17 @@ promotedByUserId UserId UniquePromotedByUserId promotedByUserId++FKParent sql=migration_fk_parent++FKChildV1 sql=migration_fk_child++-- Simulate creating a new FK field on an existing table+FKChildV2 sql=migration_fk_child+ parentId FKParentId++ExplicitPrimaryKey sql=explicit_primary_key+ Id Text |] userEntityDef :: EntityDef@@ -77,6 +88,20 @@ adminUserEntityDef :: EntityDef adminUserEntityDef = entityDef (Proxy :: Proxy AdminUser) +fkParentEntityDef :: EntityDef+fkParentEntityDef = entityDef (Proxy :: Proxy FKParent)++fkChildV1EntityDef :: EntityDef+fkChildV1EntityDef = entityDef (Proxy :: Proxy FKChildV1)++fkChildV2EntityDef :: EntityDef+fkChildV2EntityDef = entityDef (Proxy :: Proxy FKChildV2)++explicitPrimaryKeyEntityDef :: EntityDef+explicitPrimaryKeyEntityDef = entityDef (Proxy :: Proxy ExplicitPrimaryKey)++-- Note that FKChild is deliberately omitted here because we have two+-- versions of it allEntityDefs :: [EntityDef] allEntityDefs = [ userEntityDef@@ -84,8 +109,11 @@ , passwordEntityDef , password2EntityDef , adminUserEntityDef+ , fkParentEntityDef+ , explicitPrimaryKeyEntityDef ] +-- Note that this function migrates to the schema expected by FKChildV1 migrateManually :: (HasCallStack, MonadIO m) => SqlPersistT m () migrateManually = do cleanDB@@ -150,6 +178,9 @@ , " ADD CONSTRAINT unique_promoted_by_user_id" , " UNIQUE(promoted_by_user_id);" ]+ rawEx "CREATE TABLE migration_fk_parent(id int8 primary key);"+ rawEx "CREATE TABLE migration_fk_child(id int8 primary key);"+ rawEx "CREATE TABLE explicit_primary_key(id text primary key);" rawEx "CREATE TABLE ignored(id int8 primary key);" cleanDB :: (HasCallStack, MonadIO m) => SqlPersistT m ()@@ -162,6 +193,9 @@ rawEx "DROP TABLE IF EXISTS ignored;" rawEx "DROP TABLE IF EXISTS admin_users;" rawEx "DROP TABLE IF EXISTS users;"+ rawEx "DROP TABLE IF EXISTS migration_fk_child;"+ rawEx "DROP TABLE IF EXISTS migration_fk_parent;"+ rawEx "DROP TABLE IF EXISTS explicit_primary_key;" spec :: Spec spec = describe "MigrationSpec" $ do@@ -582,3 +616,27 @@ result2 <- liftIO $ migrateEntitiesStructured getter allEntityDefs allEntityDefs result2 `shouldBe` Right []++ it "suggests FK constraints for new fields first time" $ runConnAssert $ do+ migrateManually++ getter <- getStmtGetter+ result <-+ liftIO $+ migrateEntitiesStructured+ getter+ (fkChildV2EntityDef : allEntityDefs)+ [fkChildV2EntityDef]++ cleanDB++ case result of+ Right [] ->+ pure ()+ Left err ->+ expectationFailure $ show err+ Right alters ->+ map (snd . showAlterDb) alters+ `shouldBe` [ "ALTER TABLE \"migration_fk_child\" ADD COLUMN \"parent_id\" INT8 NOT NULL"+ , "ALTER TABLE \"migration_fk_child\" ADD CONSTRAINT \"migration_fk_child_parent_id_fkey\" FOREIGN KEY(\"parent_id\") REFERENCES \"migration_fk_parent\"(\"id\") ON DELETE RESTRICT ON UPDATE RESTRICT"+ ]