Fixed running a broken migration causes a bad error message

Fixes #1549
digitallyinduced · Oct 17, 2022 · bd51649 · bd51649
1 parent 9ef4b9d
commit bd51649
Showing 1 changed file with 13 additions and 4 deletions.
diff --git a/IHP/IDE/SchemaDesigner/Controller/Migrations.hs b/IHP/IDE/SchemaDesigner/Controller/Migrations.hs
@@ -63,9 +63,18 @@ instance Controller MigrationsController where
                 setSuccessMessage ("Migration generated: " <> path)
                 openEditor path 0 0
             else do
-                migrateAppDB revision
-
-        clearDatabaseNeedsMigration
+                result <- Exception.try (migrateAppDB revision)
+                case result of
+                    Left (exception :: SomeException) -> do
+                        let errorMessage = case fromException exception of
+                                Just (exception :: EnhancedSqlError) -> cs exception.sqlError.sqlErrorMsg
+                                Nothing -> tshow exception
+
+                        setErrorMessage errorMessage
+                        redirectTo MigrationsAction
+                    Right _ -> do
+                        clearDatabaseNeedsMigration
+                        redirectTo MigrationsAction
 
         redirectTo MigrationsAction
 
@@ -98,7 +107,7 @@ instance Controller MigrationsController where
         case result of
             Left (exception :: SomeException) -> do
                 let errorMessage = case fromException exception of
-                        Just (exception :: EnhancedSqlError) -> cs $ get #sqlErrorMsg (get #sqlError exception)
+                        Just (exception :: EnhancedSqlError) -> cs exception.sqlError.sqlErrorMsg
                         Nothing -> tshow exception
 
                 setErrorMessage errorMessage