fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

More printf debugging

Browse Source
This commit is contained in:
Gregor Kleen 2019-04-27 10:50:35 +02:00
parent 996d04574f
commit 87ecacbcce
1 changed files with 6 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Model/Migration.hs
View File

@ -52,23 +52,28 @@ share [mkPersist sqlSettings, mkMigrate "migrateDBVersioning"]
migrateAll :: (MonadLogger m, MonadBaseControl IO m, MonadIO m) => ReaderT SqlBackend m () migrateAll :: (MonadLogger m, MonadBaseControl IO m, MonadIO m) => ReaderT SqlBackend m ()
migrateAll = do migrateAll = do
$logDebugS "Migration" "Initial migration"
mapM_ ($logInfoS "Migration") <=< runMigrationSilent $ do mapM_ ($logInfoS "Migration") <=< runMigrationSilent $ do
-- Manual migrations to go to InitialVersion below: -- Manual migrations to go to InitialVersion below:
migrateEnableExtension "citext" migrateEnableExtension "citext"
migrateDBVersioning migrateDBVersioning
appliedMigrations <- map entityKey <$> selectList [] [] $logDebugS "Migration" "Retrieve applied migrations"
appliedMigrations <- selectKeysList [] []
let let
missingMigrations = customMigrations `Map.withoutKeys` Set.fromList appliedMigrations missingMigrations = customMigrations `Map.withoutKeys` Set.fromList appliedMigrations
doCustomMigration acc desc migration = acc <* do doCustomMigration acc desc migration = acc <* do
let AppliedMigrationKey appliedMigrationFrom appliedMigrationTo = desc let AppliedMigrationKey appliedMigrationFrom appliedMigrationTo = desc
$logInfoS "Migration" [st|#{tshow appliedMigrationFrom} -> #{tshow appliedMigrationTo}|]
appliedMigrationTime <- liftIO getCurrentTime appliedMigrationTime <- liftIO getCurrentTime
_ <- migration _ <- migration
insert AppliedMigration{..} insert AppliedMigration{..}
-- Map.foldlWithKey traverses migrations in ascending order of AppliedMigrationKey -- Map.foldlWithKey traverses migrations in ascending order of AppliedMigrationKey
$logDebugS "Migration" "Apply missing migrations"
Map.foldlWithKey doCustomMigration (return ()) missingMigrations Map.foldlWithKey doCustomMigration (return ()) missingMigrations
$logDebugS "Migration" "Persistent automatic migration"
mapM_ ($logInfoS "Migration") =<< runMigrationSilent migrateAll' mapM_ ($logInfoS "Migration") =<< runMigrationSilent migrateAll'
{- {-