Delay app start until postgres is ready. Fixes #1210

digitallyinduced · Nov 10, 2021 · d291bf7 · d291bf7
1 parent a7869e2
commit d291bf7
Showing 1 changed file with 17 additions and 13 deletions.
diff --git a/exe/IHP/IDE/DevServer.hs b/exe/IHP/IDE/DevServer.hs
@@ -69,15 +69,12 @@ handleAction state@(AppState { appGHCIState }) (UpdatePostgresState postgresStat
         PostgresStarted {} -> do
             -- If the app is already running before the postgres started up correctly,
             -- we need to trigger a restart, otherwise e.g. background jobs will not start correctly
-            newAppGHCIState <- case appGHCIState of
-                RunningAppGHCI { .. } -> do
+            case appGHCIState of
+                AppGHCIModulesLoaded { .. } -> do
                     sendGhciCommand process "ClassyPrelude.uninterruptibleCancel app"
                     sendGhciCommand process ":r"
-                    pure AppGHCILoading { .. }
-                otherwise -> pure otherwise
-
-
-            pure state { appGHCIState = newAppGHCIState, postgresState }
+                    pure state { appGHCIState = AppGHCILoading { .. }, postgresState }
+                otherwise -> pure state { postgresState }
         otherwise -> pure state { postgresState }
 handleAction state (UpdateAppGHCIState appGHCIState) = pure state { appGHCIState }
 handleAction state (UpdateToolServerState toolServerState) = pure state { toolServerState }
@@ -93,14 +90,21 @@ handleAction state@(AppState { appGHCIState, statusServerState, postgresState })
         AppGHCILoading { .. } -> do
             let appGHCIState' = AppGHCIModulesLoaded { .. }
 
-            stopStatusServer statusServerState
-            startLoadedApp appGHCIState
+            case postgresState of
+                PostgresStarted {} -> do
+                    stopStatusServer statusServerState
+                    startLoadedApp appGHCIState
+
+
+                    let statusServerState' = case statusServerState of
+                            StatusServerStarted { .. } -> StatusServerPaused { .. }
+                            _ -> statusServerState
 
-            let statusServerState' = case statusServerState of
-                    StatusServerStarted { .. } -> StatusServerPaused { .. }
-                    _ -> statusServerState
+                    pure state { appGHCIState = appGHCIState', statusServerState = statusServerState' }
+                _ -> do
+                    when (get #isDebugMode ?context) (Log.debug ("AppModulesLoaded but db not in PostgresStarted state, therefore not starting app yet" :: Text))
+                    pure state { appGHCIState = appGHCIState' }
 
-            pure state { appGHCIState = appGHCIState', statusServerState = statusServerState' }
         RunningAppGHCI { } -> pure state -- Do nothing as app is already in running state
         AppGHCINotStarted -> error "Unreachable AppGHCINotStarted"
         AppGHCIModulesLoaded { } -> do