Skip to content

Commit 5d2189c

Browse files
jneirajneira
authored
Revert "Send unhandled exceptions to the user (#2484)" (#2497)
This reverts commit 0211f75.
1 parent eee4c63 commit 5d2189c

File tree

2 files changed

+46
-63
lines changed

2 files changed

+46
-63
lines changed

‎ghcide/src/Development/IDE/Core/Rules.hs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -150,6 +150,9 @@ import Ide.Types (DynFlagsModificat
150150
PluginId)
151151
import Control.Concurrent.STM.Stats (atomically)
152152
import Language.LSP.Server (LspT)
153+
import System.Environment (getExecutablePath)
154+
import System.Process.Extra (readProcessWithExitCode)
155+
import Text.Read (readMaybe)
153156
import System.Info.Extra (isMac)
154157
import HIE.Bios.Ghc.Gap (hostIsDynamic)
155158

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

Lines changed: 43 additions & 63 deletions
Original file line numberDiff line numberDiff line change
@@ -38,12 +38,8 @@ import Development.IDE.Core.Tracing
3838
import Development.IDE.LSP.HoverDefinition
3939
import Development.IDE.Types.Logger
4040

41-
import Control.Monad.IO.Unlift (MonadUnliftIO)
4241
import System.IO.Unsafe (unsafeInterleaveIO)
4342

44-
issueTrackerUrl :: T.Text
45-
issueTrackerUrl = "https://github.com/haskell/haskell-language-server/issues"
46-
4743
runLanguageServer
4844
:: forall config. (Show config)
4945
=> LSP.Options
@@ -58,16 +54,11 @@ runLanguageServer
5854
runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChange userHandlers getIdeState = do
5955

6056
-- This MVar becomes full when the server thread exits or we receive exit message from client.
61-
-- LSP server will be canceled when it's full.
57+
-- LSP loop will be canceled when it's full.
6258
clientMsgVar <- newEmptyMVar
6359
-- Forcefully exit
6460
let exit = void $ tryPutMVar clientMsgVar ()
6561

66-
-- An MVar to control the lifetime of the reactor loop.
67-
-- The loop will be stopped and resources freed when it's full
68-
reactorLifetime <- newEmptyMVar
69-
let stopReactorLoop = void $ tryPutMVar reactorLifetime ()
70-
7162
-- The set of requests ids that we have received but not finished processing
7263
pendingRequests <- newTVarIO Set.empty
7364
-- The set of requests that have been cancelled and are also in pendingRequests
@@ -102,7 +93,7 @@ runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChan
10293
[ ideHandlers
10394
, cancelHandler cancelRequest
10495
, exitHandler exit
105-
, shutdownHandler stopReactorLoop
96+
, shutdownHandler
10697
]
10798
-- Cancel requests are special since they need to be handled
10899
-- out of order to be useful. Existing handlers are run afterwards.
@@ -111,23 +102,25 @@ runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChan
111102
let serverDefinition = LSP.ServerDefinition
112103
{ LSP.onConfigurationChange = onConfigurationChange
113104
, LSP.defaultConfig = defaultConfig
114-
, LSP.doInitialize = handleInit reactorLifetime exit clearReqId waitForCancel clientMsgChan
105+
, LSP.doInitialize = handleInit exit clearReqId waitForCancel clientMsgChan
115106
, LSP.staticHandlers = asyncHandlers
116107
, LSP.interpretHandler = \(env, st) -> LSP.Iso (LSP.runLspT env . flip runReaderT (clientMsgChan,st)) liftIO
117108
, LSP.options = modifyOptions options
118109
}
119110

120-
void $ untilMVar clientMsgVar $
121-
void $ LSP.runServerWithHandles
111+
void $ waitAnyCancel =<< traverse async
112+
[ void $ LSP.runServerWithHandles
122113
inH
123114
outH
124115
serverDefinition
116+
, void $ readMVar clientMsgVar
117+
]
125118

126119
where
127120
handleInit
128-
:: MVar () -> IO () -> (SomeLspId -> IO ()) -> (SomeLspId -> IO ()) -> Chan ReactorMessage
121+
:: IO () -> (SomeLspId -> IO ()) -> (SomeLspId -> IO ()) -> Chan ReactorMessage
129122
-> LSP.LanguageContextEnv config -> RequestMessage Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState))
130-
handleInit lifetime exitClientMsg clearReqId waitForCancel clientMsgChan env (RequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do
123+
handleInit exitClientMsg clearReqId waitForCancel clientMsgChan env (RequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do
131124
traceWithSpan sp params
132125
let root = LSP.resRootPath env
133126
dir <- maybe getCurrentDirectory return root
@@ -145,71 +138,58 @@ runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChan
145138
registerIdeConfiguration (shakeExtras ide) initConfig
146139

147140
let handleServerException (Left e) = do
148-
logError logger $
141+
logError (ideLogger ide) $
149142
T.pack $ "Fatal error in server thread: " <> show e
150-
sendErrorMessage e
151143
exitClientMsg
152-
handleServerException (Right _) = pure ()
153-
154-
sendErrorMessage (e :: SomeException) = do
155-
LSP.runLspT env $ LSP.sendNotification SWindowShowMessage $
156-
ShowMessageParams MtError $ T.unlines
157-
[ "Unhandled exception, please [report](" <> issueTrackerUrl <> "): "
158-
, T.pack(show e)
159-
]
160-
161-
exceptionInHandler e = do
162-
logError logger $ T.pack $
163-
"Unexpected exception, please report!\n" ++
164-
"Exception: " ++ show e
165-
sendErrorMessage e
166-
144+
handleServerException _ = pure ()
167145
logger = ideLogger ide
168-
169-
checkCancelled _id act k =
170-
flip finally (clearReqId _id) $
171-
catch (do
172-
-- We could optimize this by first checking if the id
173-
-- is in the cancelled set. However, this is unlikely to be a
174-
-- bottleneck and the additional check might hide
175-
-- issues with async exceptions that need to be fixed.
176-
cancelOrRes <- race (waitForCancel _id) act
177-
case cancelOrRes of
178-
Left () -> do
179-
logDebug (ideLogger ide) $ T.pack $ "Cancelled request " <> show _id
180-
k $ ResponseError RequestCancelled "" Nothing
181-
Right res -> pure res
182-
) $ \(e :: SomeException) -> do
183-
exceptionInHandler e
184-
k $ ResponseError InternalError (T.pack $ show e) Nothing
185-
_ <- flip forkFinally handleServerException $ untilMVar lifetime $ runWithDb logger dbLoc $ \hiedb hieChan -> do
146+
_ <- flip forkFinally handleServerException $ runWithDb logger dbLoc $ \hiedb hieChan -> do
186147
putMVar dbMVar (hiedb,hieChan)
187148
forever $ do
188149
msg <- readChan clientMsgChan
189150
-- We dispatch notifications synchronously and requests asynchronously
190151
-- This is to ensure that all file edits and config changes are applied before a request is handled
191152
case msg of
192-
ReactorNotification act -> handle exceptionInHandler act
193-
ReactorRequest _id act k -> void $ async $ checkCancelled _id act k
153+
ReactorNotification act -> do
154+
catch act $ \(e :: SomeException) ->
155+
logError (ideLogger ide) $ T.pack $
156+
"Unexpected exception on notification, please report!\n" ++
157+
"Exception: " ++ show e
158+
ReactorRequest _id act k -> void $ async $
159+
checkCancelled ide clearReqId waitForCancel _id act k
194160
pure $ Right (env,ide)
195161

162+
checkCancelled
163+
:: IdeState -> (SomeLspId -> IO ()) -> (SomeLspId -> IO ()) -> SomeLspId
164+
-> IO () -> (ResponseError -> IO ()) -> IO ()
165+
checkCancelled ide clearReqId waitForCancel _id act k =
166+
flip finally (clearReqId _id) $
167+
catch (do
168+
-- We could optimize this by first checking if the id
169+
-- is in the cancelled set. However, this is unlikely to be a
170+
-- bottleneck and the additional check might hide
171+
-- issues with async exceptions that need to be fixed.
172+
cancelOrRes <- race (waitForCancel _id) act
173+
case cancelOrRes of
174+
Left () -> do
175+
logDebug (ideLogger ide) $ T.pack $ "Cancelled request " <> show _id
176+
k $ ResponseError RequestCancelled "" Nothing
177+
Right res -> pure res
178+
) $ \(e :: SomeException) -> do
179+
logError (ideLogger ide) $ T.pack $
180+
"Unexpected exception on request, please report!\n" ++
181+
"Exception: " ++ show e
182+
k $ ResponseError InternalError (T.pack $ show e) Nothing
196183

197-
-- | Runs the action until it ends or until the given MVar is put.
198-
-- Rethrows any exceptions.
199-
untilMVar :: MonadUnliftIO m => MVar () -> m () -> m ()
200-
untilMVar mvar io = void $
201-
waitAnyCancel =<< traverse async [ io , readMVar mvar ]
202184

203185
cancelHandler :: (SomeLspId -> IO ()) -> LSP.Handlers (ServerM c)
204186
cancelHandler cancelRequest = LSP.notificationHandler SCancelRequest $ \NotificationMessage{_params=CancelParams{_id}} ->
205187
liftIO $ cancelRequest (SomeLspId _id)
206188

207-
shutdownHandler :: IO () -> LSP.Handlers (ServerM c)
208-
shutdownHandler stopReactor = LSP.requestHandler SShutdown $ \_ resp -> do
189+
shutdownHandler :: LSP.Handlers (ServerM c)
190+
shutdownHandler = LSP.requestHandler SShutdown $ \_ resp -> do
209191
(_, ide) <- ask
210-
liftIO $ logDebug (ideLogger ide) "Received shutdown message"
211-
-- stop the reactor to free up the hiedb connection
212-
liftIO stopReactor
192+
liftIO $ logDebug (ideLogger ide) "Received exit message"
213193
-- flush out the Shake session to record a Shake profile if applicable
214194
liftIO $ shakeShut ide
215195
resp $ Right Empty

0 commit comments

Comments
 (0)