From 9d875c2ee5bb7a009c68af0c375b8bc5f0d3d319 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Mon, 13 Dec 2021 23:14:14 +0000
Subject: [PATCH] send message in server exception too

---
 .../src/Development/IDE/LSP/LanguageServer.hs | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index 14be0b356d..997ceb327e 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -141,18 +141,23 @@ runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChan
             let handleServerException (Left e) = do
                     logError logger $
                         T.pack $ "Fatal error in server thread: " <> show e
+                    sendErrorMessage e
                     exitClientMsg
                 handleServerException _ = pure ()
 
-                uncaughtError (e :: SomeException) = do
-                    logError logger $ T.pack $
-                        "Unexpected exception on notification, please report!\n" ++
-                        "Exception: " ++ show e
+                sendErrorMessage (e :: SomeException) = do
                     LSP.runLspT env $ LSP.sendNotification SWindowShowMessage $
                         ShowMessageParams MtError $ T.unlines
-                        [ "Unhandled error, please [report](" <> issueTrackerUrl <> "): "
+                        [ "Unhandled exception, please [report](" <> issueTrackerUrl <> "): "
                         , T.pack(show e)
                         ]
+
+                exceptionInHandler e = do
+                    logError logger $ T.pack $
+                        "Unexpected exception, please report!\n" ++
+                        "Exception: " ++ show e
+                    sendErrorMessage e
+
                 logger = ideLogger ide
 
                 checkCancelled _id act k =
@@ -169,7 +174,7 @@ runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChan
                                     k $ ResponseError RequestCancelled "" Nothing
                                 Right res -> pure res
                         ) $ \(e :: SomeException) -> do
-                            uncaughtError e
+                            exceptionInHandler e
                             k $ ResponseError InternalError (T.pack $ show e) Nothing
             _ <- flip forkFinally handleServerException $ runWithDb logger dbLoc $ \hiedb hieChan -> do
               putMVar dbMVar (hiedb,hieChan)
@@ -178,7 +183,7 @@ runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChan
                 -- We dispatch notifications synchronously and requests asynchronously
                 -- This is to ensure that all file edits and config changes are applied before a request is handled
                 case msg of
-                    ReactorNotification act -> handle uncaughtError act
+                    ReactorNotification act -> handle exceptionInHandler act
                     ReactorRequest _id act k -> void $ async $ checkCancelled _id act k
             pure $ Right (env,ide)