Fixed migrate command not outputing the sql statements. Fixes #890

IHP/SchemaMigration.hs

@@ -26,11 +26,6 @@ migrate :: (?modelContext :: ModelContext) => IO ()
 migrate = do
     createSchemaMigrationsTable
 
-    -- Print out all sql queries during the migration. This might be set to false in it's called inside a production env
-    let modelContext = ?modelContext
-    logger <- defaultLogger
-    let ?modelContext = modelContext { logger }
-
     openMigrations <- findOpenMigrations
     forEach openMigrations runMigration
 
@@ -57,19 +52,27 @@ withTransaction block = do
 -- | Creates the @schema_migrations@ table if it doesn't exist yet
 createSchemaMigrationsTable :: (?modelContext :: ModelContext) => IO ()
 createSchemaMigrationsTable = do
-    -- Hide the "NOTICE: relation schema_migrations already exists, skipping" message
-    -- This sometimes confuses users as they don't know if the this is an error or not (it's not)
-    -- https://github.com/digitallyinduced/ihp/issues/818
+    -- Hide this query from the log
     let modelContext = ?modelContext
     let ?modelContext = modelContext { logger = (get #logger modelContext) { write = \_ -> pure ()} }
 
-    let ddl = "CREATE TABLE IF NOT EXISTS schema_migrations (revision BIGINT NOT NULL UNIQUE)"
-    _ <- sqlExec ddl ()
-    pure ()
+    -- We don't use CREATE TABLE IF NOT EXISTS as adds a "NOTICE: relation schema_migrations already exists, skipping"
+    -- This sometimes confuses users as they don't know if the this is an error or not (it's not)
+    -- https://github.com/digitallyinduced/ihp/issues/818
+    maybeTableName :: Maybe Text <- sqlQueryScalar "SELECT (to_regclass('schema_migrations')) :: text" ()
+    let schemaMigrationTableExists = isJust maybeTableName
+
+    unless schemaMigrationTableExists do
+        let ddl = "CREATE TABLE IF NOT EXISTS schema_migrations (revision BIGINT NOT NULL UNIQUE)"
+        _ <- sqlExec ddl ()
+        pure ()
 
 -- | Returns all migrations that haven't been executed yet. The result is sorted so that the oldest revision is first.
 findOpenMigrations :: (?modelContext :: ModelContext) => IO [Migration]
 findOpenMigrations = do
+    let modelContext = ?modelContext
+    let ?modelContext = modelContext { logger = (get #logger modelContext) { write = \_ -> pure ()} }
+
     migratedRevisions <- findMigratedRevisions
     migrations <- findAllMigrations
     migrations

exe/IHP/CLI/Migrate.hs

@@ -4,15 +4,25 @@ import IHP.Prelude
 import IHP.SchemaMigration
 import IHP.ModelSupport
 import IHP.FrameworkConfig
+import IHP.Log.Types
 
 main :: IO ()
 main = do
     frameworkConfig <- buildFrameworkConfig (pure ())
+
+    -- We need a debug logger to print out all sql queries during the migration.
+    -- The production env logger could be set to a different log level, therefore
+    -- we don't use the logger in 'frameworkConfig'
+    --
+    logger <- defaultLogger
+
     modelContext <- createModelContext
         (get #dbPoolIdleTime frameworkConfig)
         (get #dbPoolMaxConnections frameworkConfig)
         (get #databaseUrl frameworkConfig)
-        (get #logger frameworkConfig)
+        logger
 
     let ?modelContext = modelContext
-    migrate
+    migrate
+
+    logger |> cleanup