Fix stuck at exit alternative

ghcide/src/Development/IDE/LSP/LanguageServer.hs

@@ -125,14 +125,15 @@ runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigCh
 setupLSP ::
      forall config err.
      Recorder (WithPriority Log)
+  -> MVar IdeState
   -> (FilePath -> IO FilePath) -- ^ Map root paths to the location of the hiedb for the project
   -> LSP.Handlers (ServerM config)
   -> (LSP.LanguageContextEnv config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState)
   -> MVar ()
   -> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)),
          LSP.Handlers (ServerM config),
          (LanguageContextEnv config, IdeState) -> ServerM config <~> IO)
-setupLSP  recorder getHieDbLoc userHandlers getIdeState clientMsgVar = do
+setupLSP recorder ideStateVar getHieDbLoc userHandlers getIdeState clientMsgVar = do
   -- Send everything over a channel, since you need to wait until after initialise before
   -- LspFuncs is available
   clientMsgChan :: Chan ReactorMessage <- newChan
@@ -170,7 +171,7 @@ setupLSP  recorder getHieDbLoc userHandlers getIdeState clientMsgVar = do
         [ userHandlers
         , cancelHandler cancelRequest
         , exitHandler exit
-        , shutdownHandler stopReactorLoop
+        , shutdownHandler stopReactorLoop ideStateVar
         ]
         -- Cancel requests are special since they need to be handled
         -- out of order to be useful. Existing handlers are run afterwards.
@@ -261,9 +262,10 @@ cancelHandler cancelRequest = LSP.notificationHandler SMethod_CancelRequest $ \T
         toLspId (InL x) = IdInt x
         toLspId (InR y) = IdString y
 
-shutdownHandler :: IO () -> LSP.Handlers (ServerM c)
-shutdownHandler stopReactor = LSP.requestHandler SMethod_Shutdown $ \_ resp -> do
-    (_, ide) <- ask
+shutdownHandler :: IO () -> MVar IdeState -> LSP.Handlers (ServerM c)
+shutdownHandler stopReactor ideStateVar = LSP.requestHandler SMethod_Shutdown $ \_ resp -> do
+    -- take away the ideStateVar to prevent onConfigChange from running and hangs.
+    ide <- liftIO $ takeMVar ideStateVar
     liftIO $ logDebug (ideLogger ide) "Received shutdown message"
     -- stop the reactor to free up the hiedb connection
     liftIO stopReactor

ghcide/src/Development/IDE/Main.hs

@@ -11,15 +11,18 @@ module Development.IDE.Main
 ,Log(..)
 ) where
 
-import           Control.Concurrent.Extra                 (withNumCapabilities)
+import           Control.Concurrent.Extra                 (tryTakeMVar,
+                                                           withNumCapabilities)
 import           Control.Concurrent.MVar                  (newEmptyMVar,
                                                            putMVar, tryReadMVar)
 import           Control.Concurrent.STM.Stats             (dumpSTMStats)
+import           Control.Exception                        (bracket)
 import           Control.Exception.Safe                   (SomeException,
                                                            catchAny,
                                                            displayException)
-import           Control.Monad.Extra                      (concatMapM, unless,
-                                                           when)
+import           Control.Monad.Extra                      (concatMapM, maybeM,
+                                                           unless, when,
+                                                           whenJust, whenJustM)
 import           Control.Monad.IO.Class                   (liftIO)
 import qualified Data.Aeson                               as J
 import           Data.Coerce                              (coerce)
@@ -90,7 +93,8 @@ import           Development.IDE.Types.Options            (IdeGhcSession,
                                                            optModifyDynFlags,
                                                            optTesting)
 import           Development.IDE.Types.Shake              (WithHieDb, toKey)
-import           GHC.Conc                                 (getNumProcessors)
+import           GHC.Conc                                 (getNumProcessors,
+                                                           withMVar)
 import           GHC.IO.Encoding                          (setLocaleEncoding)
 import           GHC.IO.Handle                            (hDuplicate)
 import           HIE.Bios.Cradle                          (findCradle)
@@ -190,7 +194,7 @@ isLSP _   = False
 
 commandP :: IdePlugins IdeState -> Parser Command
 commandP plugins =
-    hsubparser(command "typecheck" (info (Check <$> fileCmd) fileInfo)
+    hsubparser (command "typecheck" (info (Check <$> fileCmd) fileInfo)
             <> command "hiedb" (info (Db <$> HieDb.optParser "" True <*> HieDb.cmdParser) hieInfo)
             <> command "lsp" (info (pure LSP) lspInfo)
             <> pluginCommands
@@ -310,6 +314,10 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
             ioT <- offsetTime
             logWith recorder Info $ LogLspStart (pluginId <$> ipMap argsHlsPlugins)
 
+            -- Notice why we are using `ideStateVar`:
+            -- 1. to pass the ide state to config update callback after the initialization
+            -- 2. guard against the case when the server is still starting up and
+            --    and after shutdown handler has been called(empty in this case).
             ideStateVar <- newEmptyMVar
             let getIdeState :: LSP.LanguageContextEnv Config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState
                 getIdeState env rootPath withHieDb hieChan = do
@@ -356,19 +364,20 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
                   putMVar ideStateVar ide
                   pure ide
 
-            let setup = setupLSP (cmapWithPrio LogLanguageServer recorder) argsGetHieDbLoc (pluginHandlers plugins) getIdeState
+            let setup = setupLSP (cmapWithPrio LogLanguageServer recorder) ideStateVar argsGetHieDbLoc (pluginHandlers plugins) getIdeState
                 -- See Note [Client configuration in Rules]
                 onConfigChange cfg = do
                   -- TODO: this is nuts, we're converting back to JSON just to get a fingerprint
                   let cfgObj = J.toJSON cfg
-                  mide <- liftIO $ tryReadMVar ideStateVar
-                  case mide of
-                    Nothing -> pure ()
-                    Just ide -> liftIO $ do
-                        let msg = T.pack $ show cfg
-                        logDebug (Shake.ideLogger ide) $ "Configuration changed: " <> msg
-                        modifyClientSettings ide (const $ Just cfgObj)
-                        setSomethingModified Shake.VFSUnmodified ide [toKey Rules.GetClientSettings emptyFilePath] "config change"
+                  -- tryTakeMVar is essential here, as the MVar might be empty if the server is still starting up
+                  -- and it might be gone if the server shut down.
+                  liftIO $ bracket (liftIO $ tryTakeMVar ideStateVar) (`whenJust` putMVar ideStateVar) $ \case
+                      Nothing -> pure ()
+                      Just ide -> liftIO $ do
+                          let msg = T.pack $ show cfg
+                          logDebug (Shake.ideLogger ide) $ "Configuration changed: " <> msg
+                          modifyClientSettings ide (const $ Just cfgObj)
+                          setSomethingModified Shake.VFSUnmodified ide [toKey Rules.GetClientSettings emptyFilePath] "config change"
 
             runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig onConfigChange setup
             dumpSTMStats