From d291bf771b29358f17574a7161ff530bd6715cdd Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Wed, 10 Nov 2021 15:45:39 +0100
Subject: [PATCH] Delay app start until postgres is ready. Fixes #1210

---
 exe/IHP/IDE/DevServer.hs | 30 +++++++++++++++++-------------
 1 file changed, 17 insertions(+), 13 deletions(-)

diff --git a/exe/IHP/IDE/DevServer.hs b/exe/IHP/IDE/DevServer.hs
index d78ce695c..8333ee8de 100644
--- 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