@@ -12,9 +12,6 @@ module Development.IDE.LSP.LanguageServer
1212 ( runLanguageServer
1313 ) where
1414
15- import Control.Concurrent.Extra (newBarrier ,
16- signalBarrier ,
17- waitBarrier )
1815import Control.Concurrent.STM
1916import Control.Monad.Extra
2017import Control.Monad.IO.Class
@@ -56,12 +53,11 @@ runLanguageServer
5653 -> IO ()
5754runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChange userHandlers getIdeState = do
5855
59- -- These barriers are signaled when the threads reading from these chans exit.
60- -- This should not happen but if it does, we will make sure that the whole server
61- -- dies and can be restarted instead of losing threads silently.
62- clientMsgBarrier <- newBarrier
56+ -- This MVar becomes full when the server thread exits or we receive exit message from client.
57+ -- LSP loop will be canceled when it's full.
58+ clientMsgVar <- newEmptyMVar
6359 -- Forcefully exit
64- let exit = signalBarrier clientMsgBarrier ()
60+ let exit = void $ tryPutMVar clientMsgVar ()
6561
6662 -- The set of requests ids that we have received but not finished processing
6763 pendingRequests <- newTVarIO Set. empty
@@ -116,7 +112,7 @@ runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChan
116112 inH
117113 outH
118114 serverDefinition
119- , void $ waitBarrier clientMsgBarrier
115+ , void $ readMVar clientMsgVar
120116 ]
121117
122118 where
@@ -192,6 +188,7 @@ cancelHandler cancelRequest = LSP.notificationHandler SCancelRequest $ \Notifica
192188exitHandler :: IO () -> LSP. Handlers (ServerM c )
193189exitHandler exit = LSP. notificationHandler SExit $ const $ do
194190 (_, ide) <- ask
191+ liftIO $ logDebug (ideLogger ide) " Received exit message"
195192 -- flush out the Shake session to record a Shake profile if applicable
196193 liftIO $ shakeShut ide
197194 liftIO exit
0 commit comments