Increase verbosity

obsidiansystems · Sep 11, 2023 · 9f4e5cc · 9f4e5cc
1 parent 1b1ac6c
commit 9f4e5cc
Show file tree

Hide file tree

Showing 2 changed files with 11 additions and 2 deletions.
diff --git a/src/Database/Beam/AutoMigrate.hs b/src/Database/Beam/AutoMigrate.hs
@@ -712,7 +712,9 @@ tryRunMigrationsWithEditUpdate
  -> IO ()
 tryRunMigrationsWithEditUpdate annotatedDb editUpdate conn = do
  let expectedHaskellSchema = fromAnnotatedDbSettings annotatedDb (Proxy @'[])
+ putStrLn "Acquiring actual schema."
  actualDatabaseSchema <- getSchema conn
+ putStrLn "Calculating the difference between actual and expected schemas."
  case diff expectedHaskellSchema actualDatabaseSchema of
  Left err -> do
  putStrLn "Error detecting database migration requirements: "

diff --git a/src/Database/Beam/AutoMigrate/Postgres.hs b/src/Database/Beam/AutoMigrate/Postgres.hs
@@ -205,12 +205,16 @@ referenceActionsQ =
 -- | Connects to a running PostgreSQL database and extract the relevant 'Schema' out of it.
 getSchema :: Pg.Connection -> IO Schema
 getSchema conn = do
+ putStrLn "Getting constraints."
  allTableConstraints <- getAllConstraints conn
+ putStrLn "Getting defaults."
  allDefaults <- getAllDefaults conn
+ putStrLn "Getting enumerations."
  enumerationData <- Pg.fold_ conn enumerationsQ mempty getEnumeration
+ putStrLn "Getting sequences."
  sequences <- Pg.fold_ conn sequencesQ mempty getSequence
- tables <-
-   Pg.fold_ conn userTablesQ mempty (getTable allDefaults enumerationData allTableConstraints)
+ putStrLn "Getting tables."
+ tables <- Pg.fold_ conn userTablesQ mempty (getTable allDefaults enumerationData allTableConstraints)
  pure $ Schema tables (M.fromList $ M.elems enumerationData) sequences
  where
  getEnumeration ::
@@ -454,8 +458,11 @@ getAllDefaults conn = Pg.fold_ conn defaultsQ mempty (\acc -> pure . addDefault
 
 getAllConstraints :: Pg.Connection -> IO AllTableConstraints
 getAllConstraints conn = do
+ putStrLn "Get all actions."
  allActions <- mkActions <$> Pg.query_ conn referenceActionsQ
+ putStrLn "Get all foreign keys."
  allForeignKeys <- Pg.fold_ conn foreignKeysQ mempty (\acc -> pure . addFkConstraint allActions acc)
+ putStrLn "Get other constraints."
  Pg.fold_ conn otherConstraintsQ allForeignKeys (\acc -> pure . addOtherConstraint acc)
  where
  addFkConstraint ::