Apply suggestions from code review

Co-authored-by: fendor <fendor@users.noreply.github.com>

Author: soulomoon

ghcide/src/Development/IDE/Core/WorkerThread.hs

@@ -52,17 +52,20 @@ Originally we used various ways to implement this, but it was hard to maintain a
 Moreover, we can not stop these threads uniformly when we are shutting down the server.
 -}
 data TaskQueue a = TaskQueue (TQueue a)
+
+data ExitOrTask t = Exit | Task t
+
 newTaskQueueIO :: IO (TaskQueue a)
 newTaskQueueIO = TaskQueue <$> newTQueueIO
-data ExitOrTask t = Exit | Task t
 
 -- | 'withWorkerQueue' creates a new 'TQueue', and launches a worker
 -- thread which polls the queue for requests and runs the given worker
 -- function on them.
 withWorkerQueueSimple :: Recorder (WithPriority LogWorkerThread) -> T.Text -> ContT () IO (TaskQueue (IO ()))
-withWorkerQueueSimple log title = withWorkerQueue log title id
+withWorkerQueueSimple recorder title = withWorkerQueue recorder title id
+
 withWorkerQueue :: Recorder (WithPriority LogWorkerThread) -> T.Text -> (t -> IO ()) -> ContT () IO (TaskQueue t)
-withWorkerQueue log title workerAction = ContT $ \mainAction -> do
+withWorkerQueue recorder title workerAction = ContT $ \mainAction -> do
   q <- newTaskQueueIO
   -- Use a TMVar as a stop flag to coordinate graceful shutdown.
   -- The worker thread checks this flag before dequeuing each job; if set, it exits immediately,
@@ -80,7 +83,6 @@ withWorkerQueue log title workerAction = ContT $ \mainAction -> do
     logWith log Debug (LogThreadEnding title)
   logWith log Debug (LogThreadEnded title)
   where
-    -- writerThread :: TaskQueue t -> TMVar () -> (forall a. IO a -> IO a) -> IO ()
     writerThread q b =
       -- See above: check stop flag before dequeuing, exit if set, otherwise run next job.
       do

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

@@ -13,7 +13,6 @@ module Development.IDE.LSP.LanguageServer
     , runWithWorkerThreads
     , Setup (..)
     , InitializationContext (..)
-    , untilMVar'
     ) where
 
 import           Control.Concurrent.STM
@@ -74,15 +73,15 @@ instance Pretty Log where
     LogReactorShutdownRequested b ->
       "Requested reactor shutdown; stop signal posted: " <+> pretty b
     LogReactorShutdownConfirmed msg ->
-        "Reactor shutdown confirmed: " <+> pretty msg
+      "Reactor shutdown confirmed: " <+> pretty msg
     LogServerExitWith (Right 0) ->
       "Server exited successfully"
     LogServerExitWith (Right code) ->
       "Server exited with failure code" <+> pretty code
-    LogServerExitWith (Left _) ->
+    LogServerExitWith (Left ()) ->
       "Server forcefully exited due to exception in reactor thread"
     LogShutDownTimeout seconds ->
-        "Shutdown timeout, the server will exit now after waiting for" <+> pretty seconds  <+> "seconds"
+      "Shutdown timeout, the server will exit now after waiting for" <+> pretty seconds  <+> "seconds"
     LogRegisteringIdeConfig ideConfig ->
       -- This log is also used to identify if HLS starts successfully in vscode-haskell,
       -- don't forget to update the corresponding test in vscode-haskell if the text in
@@ -103,7 +102,7 @@ instance Pretty Log where
     LogSession msg -> pretty msg
     LogLspServer msg -> pretty msg
 
--- | Context for initializing the LSP language server.
+-- | Context of the LSP language server.
 -- This record encapsulates all the configuration and callback functions
 -- needed to set up and run the language server initialization process.
 data InitializationContext config = InitializationContext
@@ -117,7 +116,7 @@ data InitializationContext config = InitializationContext
     -- ^ Function to create and initialize the IDE state with the given environment
   , ctxUntilReactorStopSignal :: IO () -> IO ()
     -- ^ Lifetime control: MVar to signal reactor shutdown
-  , ctxconfirmReactorShutdown :: T.Text -> IO ()
+  , ctxConfirmReactorShutdown :: T.Text -> IO ()
     -- ^ Callback to log/confirm reactor shutdown with a reason
   , ctxForceShutdown :: IO ()
     -- ^ Action to forcefully exit the server when exception occurs
@@ -291,17 +290,18 @@ handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Init
     logWith recorder Info $ LogRegisteringIdeConfig initConfig
     ideMVar <- newEmptyMVar
 
-    let handleServerExceptionOrShutDown me = do
-            -- shutdown shake
-            tryReadMVar ideMVar >>= mapM_ shutdown
-            case me of
-                Left e -> do
-                    lifetimeConfirm "due to exception in reactor thread"
-                    logWith recorder Error $ LogReactorThreadException e
-                    ctxForceShutdown initParams
-                _ -> do
-                    lifetimeConfirm "due to shutdown message"
-                    return ()
+    let 
+      handleServerExceptionOrShutDown me = do
+        -- shutdown shake
+        tryReadMVar ideMVar >>= mapM_ shutdown
+          case me of
+            Left e -> do
+              lifetimeConfirm "due to exception in reactor thread"
+              logWith recorder Error $ LogReactorThreadException e
+              ctxForceShutdown initParams
+            _ -> do
+              lifetimeConfirm "due to shutdown message"
+              return ()
 
         exceptionInHandler e = do
             logWith recorder Error $ LogReactorMessageActionException e
@@ -329,7 +329,7 @@ handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Init
                 do
                 ide <- ctxGetIdeState initParams env root withHieDb' threadQueue'
                 putMVar ideMVar ide
-                -- We might be blocked indefinitly at initialization if reactorStop is signaled
+                -- We might indefinitly at initialization if reactorStop is signaled
                 -- before we putMVar.
                 untilReactorStopSignal $ forever $ do
                     msg <- readChan $ ctxClientMsgChan initParams