persistent-postgresql 2.14.2.0 → 2.14.3.0
raw patch · 5 files changed
+92/−30 lines, 5 filesdep ~persistent
Dependency ranges changed: persistent
Files
- ChangeLog.md +5/−0
- Database/Persist/Postgresql.hs +11/−7
- Database/Persist/Postgresql/Internal/Migration.hs +26/−18
- persistent-postgresql.cabal +2/−2
- test/MigrationSpec.hs +48/−3
ChangeLog.md view
@@ -1,5 +1,10 @@ # Changelog for persistent-postgresql +# 2.14.3.0++* [#1616](https://github.com/yesodweb/persistent/pull/1616)+ * Allow overriding the default cascade option for foreign keys. + # 2.14.2.0 * [#1614](https://github.com/yesodweb/persistent/pull/1614)
Database/Persist/Postgresql.hs view
@@ -506,7 +506,7 @@ , connStmtMap = smap , connInsertSql = insertSql' , connClose = PG.close conn- , connMigrateSql = migrate'+ , connMigrateSql = migrate' emptyBackendSpecificOverrides , connBegin = \_ mIsolation -> case mIsolation of Nothing -> PG.begin conn Just iso ->@@ -683,11 +683,14 @@ Ok v -> return v migrate'- :: [EntityDef]+ :: BackendSpecificOverrides+ -> [EntityDef] -> (Text -> IO Statement) -> EntityDef -> IO (Either [Text] CautiousMigration)-migrate' allDefs getter entity = fmap (fmap $ map showAlterDb) $ migrateStructured allDefs getter entity+migrate' overrides allDefs getter entity =+ fmap (fmap $ map showAlterDb) $+ migrateStructured overrides allDefs getter entity -- | Get the SQL string for the table that a PersistEntity represents. -- Useful for raw SQL queries.@@ -821,15 +824,16 @@ } mockMigrate- :: [EntityDef]+ :: BackendSpecificOverrides+ -> [EntityDef] -> (Text -> IO Statement) -> EntityDef -> IO (Either [Text] [(Bool, Text)])-mockMigrate allDefs _ entity =+mockMigrate overrides allDefs _ entity = fmap (fmap $ map showAlterDb) $ return $ Right $- mockMigrateStructured allDefs entity+ mockMigrateStructured overrides allDefs entity -- | Mock a migration even when the database is not present. -- This function performs the same functionality of 'printMigration'@@ -852,7 +856,7 @@ , connInsertSql = undefined , connStmtMap = smap , connClose = undefined- , connMigrateSql = mockMigrate+ , connMigrateSql = mockMigrate emptyBackendSpecificOverrides , connBegin = undefined , connCommit = undefined , connRollback = undefined
Database/Persist/Postgresql/Internal/Migration.hs view
@@ -39,12 +39,13 @@ -- -- @since 2.17.1.0 migrateStructured- :: [EntityDef]+ :: BackendSpecificOverrides+ -> [EntityDef] -> (Text -> IO Statement) -> EntityDef -> IO (Either [Text] [AlterDB])-migrateStructured allDefs getter entity =- migrateEntitiesStructured getter allDefs [entity]+migrateStructured overrides allDefs getter entity =+ migrateEntitiesStructured overrides getter allDefs [entity] -- | Returns a structured representation of all of the DB changes required to -- migrate the listed entities from their current state in the database to the@@ -54,15 +55,16 @@ -- -- @since 2.14.1.0 migrateEntitiesStructured- :: (Text -> IO Statement)+ :: BackendSpecificOverrides+ -> (Text -> IO Statement) -> [EntityDef] -> [EntityDef] -> IO (Either [Text] [AlterDB])-migrateEntitiesStructured getStmt allDefs defsToMigrate = do+migrateEntitiesStructured overrides getStmt allDefs defsToMigrate = do r <- collectSchemaState getStmt (map getEntityDBName defsToMigrate) pure $ case r of Right schemaState ->- migrateEntitiesFromSchemaState schemaState allDefs defsToMigrate+ migrateEntitiesFromSchemaState overrides schemaState allDefs defsToMigrate Left err -> Left [err] @@ -73,11 +75,12 @@ -- -- @since 2.17.1.0 mockMigrateStructured- :: [EntityDef]+ :: BackendSpecificOverrides+ -> [EntityDef] -> EntityDef -> [AlterDB]-mockMigrateStructured allDefs entity =- migrateEntityFromSchemaState EntityDoesNotExist allDefs entity+mockMigrateStructured overrides allDefs entity =+ migrateEntityFromSchemaState overrides EntityDoesNotExist allDefs entity -- | In order to ensure that generating migrations is fast and avoids N+1 -- queries, we split it into two phases. The first phase involves querying the@@ -532,11 +535,12 @@ mapLeft f (Left x) = Left (f x) migrateEntitiesFromSchemaState- :: SchemaState+ :: BackendSpecificOverrides+ -> SchemaState -> [EntityDef] -> [EntityDef] -> Either [Text] [AlterDB]-migrateEntitiesFromSchemaState (SchemaState schemaStateMap) allDefs defsToMigrate =+migrateEntitiesFromSchemaState overrides (SchemaState schemaStateMap) allDefs defsToMigrate = let go :: EntityDef -> Either Text [AlterDB] go entity = do@@ -544,7 +548,7 @@ name = getEntityDBName entity case Map.lookup name schemaStateMap of Just entityState ->- Right $ migrateEntityFromSchemaState entityState allDefs entity+ Right $ migrateEntityFromSchemaState overrides entityState allDefs entity Nothing -> Left $ T.pack $ "No entry for entity in schemaState: " <> show name in@@ -553,11 +557,12 @@ (errs, _) -> Left errs migrateEntityFromSchemaState- :: EntitySchemaState+ :: BackendSpecificOverrides+ -> EntitySchemaState -> [EntityDef] -> EntityDef -> [AlterDB]-migrateEntityFromSchemaState schemaState allDefs entity =+migrateEntityFromSchemaState overrides schemaState allDefs entity = case schemaState of EntityDoesNotExist -> (addTable newcols entity) : uniques ++ references ++ foreignsAlt@@ -577,7 +582,7 @@ acs' ++ ats' where name = getEntityDBName entity- (newcols', udefs, fdefs) = postgresMkColumns allDefs entity+ (newcols', udefs, fdefs) = postgresMkColumns overrides allDefs entity newcols = filter (not . safeToRemove entity . cName) newcols' udspair = map udToPair udefs @@ -822,10 +827,13 @@ | otherwise = shortenNames overhead (x, y - 1) postgresMkColumns- :: [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])-postgresMkColumns allDefs t =+ :: BackendSpecificOverrides+ -> [EntityDef]+ -> EntityDef+ -> ([Column], [UniqueDef], [ForeignDef])+postgresMkColumns overrides allDefs t = mkColumns allDefs t $- setBackendSpecificForeignKeyName refName emptyBackendSpecificOverrides+ setBackendSpecificForeignKeyName refName overrides -- | Check if a column name is listed as the "safe to remove" in the entity -- list.
persistent-postgresql.cabal view
@@ -1,5 +1,5 @@ name: persistent-postgresql-version: 2.14.2.0+version: 2.14.3.0 license: MIT license-file: LICENSE author: Felipe Lessa, Michael Snoyman <michael@snoyman.com>@@ -28,7 +28,7 @@ , file-embed >=0.0.16 , monad-logger >=0.3.25 , mtl- , persistent >=2.18 && <3+ , persistent >=2.18.1 && <3 , postgresql-libpq >=0.9.4.2 && <0.12 , postgresql-simple >=0.6.1 && <0.8 , postgresql-simple-interval >=1 && <1.1
test/MigrationSpec.hs view
@@ -585,7 +585,12 @@ getter <- getStmtGetter result <-- liftIO $ migrateEntitiesStructured getter allEntityDefs allEntityDefs+ liftIO $+ migrateEntitiesStructured+ emptyBackendSpecificOverrides+ getter+ allEntityDefs+ allEntityDefs cleanDB @@ -602,7 +607,12 @@ getter <- getStmtGetter result <-- liftIO $ migrateEntitiesStructured getter allEntityDefs allEntityDefs+ liftIO $+ migrateEntitiesStructured+ emptyBackendSpecificOverrides+ getter+ allEntityDefs+ allEntityDefs cleanDB @@ -614,7 +624,12 @@ Right alters -> do traverse_ (flip rawExecute [] . snd . showAlterDb) alters result2 <-- liftIO $ migrateEntitiesStructured getter allEntityDefs allEntityDefs+ liftIO $+ migrateEntitiesStructured+ emptyBackendSpecificOverrides+ getter+ allEntityDefs+ allEntityDefs result2 `shouldBe` Right [] it "suggests FK constraints for new fields first time" $ runConnAssert $ do@@ -624,6 +639,7 @@ result <- liftIO $ migrateEntitiesStructured+ emptyBackendSpecificOverrides getter (fkChildV2EntityDef : allEntityDefs) [fkChildV2EntityDef]@@ -639,4 +655,33 @@ 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"+ ]++ it "Uses overrides for empty cascade action" $ runConnAssert $ do+ migrateManually++ getter <- getStmtGetter++ let+ overrideWithDefault =+ setBackendSpecificForeignKeyCascadeDefault Cascade emptyBackendSpecificOverrides+ result <-+ liftIO $+ migrateEntitiesStructured+ overrideWithDefault+ 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 CASCADE ON UPDATE CASCADE" ]