Skip to content

Commit 3d5080a

Browse files
eddiemundoeddiemundo
authored
Merge branch 'haskell:master' into master
2 parents ec1cc78 + 0211f75 commit 3d5080a

File tree

3 files changed

+117
-118
lines changed

3 files changed

+117
-118
lines changed

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

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -150,9 +150,6 @@ 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)
156153
import System.Info.Extra (isMac)
157154
import HIE.Bios.Ghc.Gap (hostIsDynamic)
158155

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

Lines changed: 63 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -38,8 +38,12 @@ 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)
4142
import System.IO.Unsafe (unsafeInterleaveIO)
4243

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

5660
-- 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.
61+
-- LSP server will be canceled when it's full.
5862
clientMsgVar <- newEmptyMVar
5963
-- Forcefully exit
6064
let exit = void $ tryPutMVar clientMsgVar ()
6165

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+
6271
-- The set of requests ids that we have received but not finished processing
6372
pendingRequests <- newTVarIO Set.empty
6473
-- The set of requests that have been cancelled and are also in pendingRequests
@@ -93,7 +102,7 @@ runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChan
93102
[ ideHandlers
94103
, cancelHandler cancelRequest
95104
, exitHandler exit
96-
, shutdownHandler
105+
, shutdownHandler stopReactorLoop
97106
]
98107
-- Cancel requests are special since they need to be handled
99108
-- out of order to be useful. Existing handlers are run afterwards.
@@ -102,25 +111,23 @@ runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChan
102111
let serverDefinition = LSP.ServerDefinition
103112
{ LSP.onConfigurationChange = onConfigurationChange
104113
, LSP.defaultConfig = defaultConfig
105-
, LSP.doInitialize = handleInit exit clearReqId waitForCancel clientMsgChan
114+
, LSP.doInitialize = handleInit reactorLifetime exit clearReqId waitForCancel clientMsgChan
106115
, LSP.staticHandlers = asyncHandlers
107116
, LSP.interpretHandler = \(env, st) -> LSP.Iso (LSP.runLspT env . flip runReaderT (clientMsgChan,st)) liftIO
108117
, LSP.options = modifyOptions options
109118
}
110119

111-
void $ waitAnyCancel =<< traverse async
112-
[ void $ LSP.runServerWithHandles
120+
void $ untilMVar clientMsgVar $
121+
void $ LSP.runServerWithHandles
113122
inH
114123
outH
115124
serverDefinition
116-
, void $ readMVar clientMsgVar
117-
]
118125

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

140147
let handleServerException (Left e) = do
141-
logError (ideLogger ide) $
148+
logError logger $
142149
T.pack $ "Fatal error in server thread: " <> show e
150+
sendErrorMessage e
143151
exitClientMsg
144-
handleServerException _ = pure ()
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+
145167
logger = ideLogger ide
146-
_ <- flip forkFinally handleServerException $ runWithDb logger dbLoc $ \hiedb hieChan -> do
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
147186
putMVar dbMVar (hiedb,hieChan)
148187
forever $ do
149188
msg <- readChan clientMsgChan
150189
-- We dispatch notifications synchronously and requests asynchronously
151190
-- This is to ensure that all file edits and config changes are applied before a request is handled
152191
case msg of
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
192+
ReactorNotification act -> handle exceptionInHandler act
193+
ReactorRequest _id act k -> void $ async $ checkCancelled _id act k
160194
pure $ Right (env,ide)
161195

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
183196

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 ]
184202

185203
cancelHandler :: (SomeLspId -> IO ()) -> LSP.Handlers (ServerM c)
186204
cancelHandler cancelRequest = LSP.notificationHandler SCancelRequest $ \NotificationMessage{_params=CancelParams{_id}} ->
187205
liftIO $ cancelRequest (SomeLspId _id)
188206

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

‎stack-9.0.1.yaml

Lines changed: 54 additions & 72 deletions
Original file line numberDiff line numberDiff line change
@@ -1,93 +1,75 @@
1-
resolver: nightly-2021-11-06
1+
resolver: nightly-2021-12-14
22

33
packages:
4-
- .
5-
- ./hie-compat
6-
- ./hls-graph
7-
- ./ghcide/
8-
- ./hls-plugin-api
9-
- ./hls-test-utils
10-
- ./shake-bench
11-
- ./plugins/hls-call-hierarchy-plugin
12-
- ./plugins/hls-class-plugin
13-
- ./plugins/hls-haddock-comments-plugin
14-
- ./plugins/hls-eval-plugin
15-
- ./plugins/hls-explicit-imports-plugin
16-
- ./plugins/hls-qualify-imported-names-plugin
17-
- ./plugins/hls-refine-imports-plugin
18-
- ./plugins/hls-hlint-plugin
19-
- ./plugins/hls-rename-plugin
20-
- ./plugins/hls-retrie-plugin
21-
- ./plugins/hls-splice-plugin
22-
# - ./plugins/hls-tactics-plugin
23-
# - ./plugins/hls-brittany-plugin
24-
# - ./plugins/hls-stylish-haskell-plugin
25-
- ./plugins/hls-floskell-plugin
26-
- ./plugins/hls-fourmolu-plugin
27-
- ./plugins/hls-pragmas-plugin
28-
- ./plugins/hls-module-name-plugin
29-
- ./plugins/hls-ormolu-plugin
30-
- ./plugins/hls-alternate-number-format-plugin
31-
32-
ghc-options:
33-
"$everything": -haddock
4+
- .
5+
- ./hie-compat
6+
- ./hls-graph
7+
- ./ghcide/
8+
- ./hls-plugin-api
9+
- ./hls-test-utils
10+
- ./shake-bench
11+
- ./plugins/hls-call-hierarchy-plugin
12+
- ./plugins/hls-class-plugin
13+
- ./plugins/hls-haddock-comments-plugin
14+
- ./plugins/hls-eval-plugin
15+
- ./plugins/hls-explicit-imports-plugin
16+
- ./plugins/hls-qualify-imported-names-plugin
17+
- ./plugins/hls-refine-imports-plugin
18+
- ./plugins/hls-hlint-plugin
19+
- ./plugins/hls-rename-plugin
20+
- ./plugins/hls-retrie-plugin
21+
- ./plugins/hls-splice-plugin
22+
# - ./plugins/hls-tactics-plugin
23+
# - ./plugins/hls-brittany-plugin
24+
# - ./plugins/hls-stylish-haskell-plugin
25+
- ./plugins/hls-floskell-plugin
26+
- ./plugins/hls-fourmolu-plugin
27+
- ./plugins/hls-pragmas-plugin
28+
- ./plugins/hls-module-name-plugin
29+
- ./plugins/hls-ormolu-plugin
30+
- ./plugins/hls-alternate-number-format-plugin
3431

3532
extra-deps:
36-
37-
- blaze-textual-0.2.2.1
38-
- bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727
39-
- dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657
40-
- dependent-sum-0.7.1.0@sha256:0e419237f5b86da3659772afff9cab355c0f8d5b3fdb15a5b30e673d8dc83941,2147
41-
- extra-1.7.9
42-
- floskell-0.10.5
43-
- heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417
33+
- bytestring-encoding-0.1.1.0
34+
- dependent-map-0.4.0.0
35+
- dependent-sum-0.7.1.0
36+
- extra-1.7.9 # for ghcide, https://github.com/haskell/haskell-language-server/pull/2131
37+
- hspec-2.7.10 # for hls-test-utils
38+
- hspec-core-2.7.10 # for hls-test-utils
39+
- some-1.0.2 # for dependent-sum, https://github.com/obsidiansystems/dependent-sum/issues/66
40+
- dependent-sum-template-0.1.1.1
41+
- floskell-0.10.6
42+
- heapsize-0.3.0.1
4443
- hiedb-0.4.1.0
45-
- hspec-2.7.10
46-
- hspec-core-2.7.10
47-
- hspec-discover-2.7.10
4844
- implicit-hie-0.1.2.6
4945
- implicit-hie-cradle-0.3.0.5
50-
- monad-dijkstra-0.1.1.2
51-
- refinery-0.4.0.0
52-
- retrie-1.0.0.0
53-
- some-1.0.2
46+
- monad-dijkstra-0.1.1.3
47+
- retrie-1.1.0.0
5448
- lsp-1.2.0.1
5549
- lsp-types-1.3.0.1
5650
- lsp-test-0.14.0.1
57-
- sqlite-simple-0.4.18.0
58-
59-
- github: anka-213/th-extras
60-
commit: 57a97b4df128eb7b360e8ab9c5759392de8d1659
61-
# https://github.com/mokus0/th-extras/pull/8
62-
# https://github.com/mokus0/th-extras/issues/7
63-
64-
- github: anka-213/dependent-sum
65-
commit: 8cf4c7fbc3bfa2be475a17bb7c94a1e1e9a830b5
66-
subdirs:
67-
- dependent-sum-template
68-
# https://github.com/obsidiansystems/dependent-sum/pull/57
6951

7052
# shake-bench dependencies
71-
72-
- SVGFonts-1.7.0.1@sha256:44f0e5ee69a0c41de72bfc1408d1384719ec44b2f1a83fd4da31071d9da21f84,4004
73-
- diagrams-postscript-1.5@sha256:ea9ef970f653072cfde9715fad92481eedcc72a94da543c52a68ca33100902ab,2369
74-
- Chart-1.9.3@sha256:640a38463318b070d80a049577e4f0b3322df98290abb7afcf0cb74a4ad5b512,2948
75-
- Chart-diagrams-1.9.3@sha256:1535d5d0d3febca63138cecfde234315212611c21bb7f4358b2dae8c55c59003,1801
76-
- statestack-0.3@sha256:be43ce2cd790a4732b88cdc9480458503cb5e307b4f79a502d99d5b3d417730e,1135
77-
- operational-0.2.4.0
78-
79-
# end of shake-bench dpendencies
80-
81-
# due to floskell-0.10.5 and diagrams-core-1.5.0
53+
- Chart-1.9.3
54+
- Chart-diagrams-1.9.3
55+
- SVGFonts-1.7.0.1 # for Chart-diagrams, https://github.com/timbod7/haskell-chart/issues/232
56+
- diagrams-postscript-1.5
57+
- statestack-0.3
58+
- operational-0.2.4.1
59+
60+
# currently needed for ghcide>extra, etc.
8261
allow-newer: true
8362

63+
ghc-options:
64+
"$everything": -haddock
65+
8466
configure-options:
8567
ghcide:
86-
- --disable-library-for-ghci
68+
- --disable-library-for-ghci
8769
haskell-language-server:
88-
- --disable-library-for-ghci
70+
- --disable-library-for-ghci
8971
heapsize:
90-
- --disable-library-for-ghci
72+
- --disable-library-for-ghci
9173

9274
flags:
9375
haskell-language-server:

0 commit comments

Comments
 (0)