@@ -38,7 +38,8 @@ import qualified Data.SortedList as SL
38
38
import qualified Data.Text as T
39
39
import Data.Text.Encoding
40
40
import qualified Data.Yaml as Yaml
41
- import Haskell.Ide.Engine.Cradle (findLocalCradle , cradleDisplay )
41
+ import Haskell.Ide.Engine.Cradle (findLocalCradle , cradleDisplay
42
+ , isCabalCradle )
42
43
import Haskell.Ide.Engine.Config
43
44
import qualified Haskell.Ide.Engine.Ghc as HIE
44
45
import Haskell.Ide.Engine.CodeActions
@@ -151,12 +152,64 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do
151
152
(Debounce. forMonoid $ react . dispatchDiagnostics)
152
153
(Debounce. def { Debounce. delay = debounceDuration, Debounce. alwaysResetTimer = True })
153
154
155
+
156
+ let lspRootDir = Core. rootPath lf
157
+ currentDir <- liftIO getCurrentDirectory
158
+
159
+ -- Check for mismatching GHC versions
160
+ let dummyCradleFile = fromMaybe currentDir lspRootDir </> " File.hs"
161
+ debugm $ " Dummy Cradle file result: " ++ dummyCradleFile
162
+ cradleRes <- liftIO $ E. try (findLocalCradle dummyCradleFile)
163
+ let sf = Core. sendFunc lf
164
+
165
+ case cradleRes of
166
+ Right cradle -> do
167
+ projGhcVersion <- liftIO $ getProjectGhcVersion cradle
168
+ when (projGhcVersion /= hieGhcVersion) $ do
169
+ let msg = T. pack $ " Mismatching GHC versions: " ++ cradleDisplay cradle ++
170
+ " is " ++ projGhcVersion ++ " , HIE is " ++ hieGhcVersion
171
+ ++ " \n You may want to use hie-wrapper. Check the README for more information"
172
+ sf $ NotShowMessage $ fmServerShowMessageNotification J. MtWarning msg
173
+ sf $ NotLogMessage $ fmServerLogMessageNotification J. MtWarning msg
174
+
175
+ -- Check cabal is installed
176
+ when (isCabalCradle cradle) $ do
177
+ hasCabal <- liftIO checkCabalInstall
178
+ unless hasCabal $ do
179
+ let cabalMsg = T. pack " cabal-install is not installed. Check the README for more information"
180
+ sf $ NotShowMessage $ fmServerShowMessageNotification J. MtWarning cabalMsg
181
+ sf $ NotLogMessage $ fmServerLogMessageNotification J. MtWarning cabalMsg
182
+
183
+ Left (e :: Yaml. ParseException ) -> do
184
+ logm $ " Failed to parse `hie.yaml`: " ++ show e
185
+ sf $ NotShowMessage $ fmServerShowMessageNotification J. MtError (" Couldn't parse hie.yaml: \n " <> T. pack (show e))
186
+
187
+ let mcradle = case cradleRes of
188
+ Left _ -> Nothing
189
+ Right c -> Just c
190
+
154
191
-- haskell lsp sets the current directory to the project root in the InitializeRequest
155
192
-- We launch the dispatcher after that so that the default cradle is
156
193
-- recognized properly by ghc-mod
157
- flip labelThread " scheduler" =<< (forkIO $ Scheduler. runScheduler scheduler errorHandler callbackHandler (Just lf))
158
- flip labelThread " reactor" =<< (forkIO reactorFunc)
159
- flip labelThread " diagnostics" =<< (forkIO $ diagnosticsQueue tr)
194
+ flip labelThread " scheduler" =<<
195
+ (forkIO (
196
+ Scheduler. runScheduler scheduler errorHandler callbackHandler (Just lf) mcradle
197
+ `E.catch` \ (e :: E. SomeException ) ->
198
+ (errorm $ " Scheduler thread exited unexpectedly: " ++ show e)
199
+ ))
200
+ flip labelThread " reactor" =<<
201
+ (forkIO (
202
+ reactorFunc
203
+ `E.catch` \ (e :: E. SomeException ) ->
204
+ (errorm $ " Reactor thread exited unexpectedly: " ++ show e)
205
+ ))
206
+ flip labelThread " diagnostics" =<<
207
+ (forkIO (
208
+ diagnosticsQueue tr
209
+ `E.catch` \ (e :: E. SomeException ) ->
210
+ (errorm $ " Diagnostic thread exited unexpectedly: " ++ show e)
211
+ ))
212
+
160
213
return Nothing
161
214
162
215
diagnosticProviders :: Map. Map DiagnosticTrigger [(PluginId ,DiagnosticProviderFunc )]
@@ -396,35 +449,6 @@ reactor inp diagIn = do
396
449
reactorSend $ NotLogMessage $
397
450
fmServerLogMessageNotification J. MtLog $ " Using hie version: " <> T. pack hieVersion
398
451
399
- lspRootDir <- asksLspFuncs Core. rootPath
400
- currentDir <- liftIO getCurrentDirectory
401
-
402
- -- Check for mismatching GHC versions
403
- -- Ignore hie.yaml parse errors. They get reported in ModuleCache.hs
404
- let parseErrorHandler (_ :: Yaml. ParseException ) = return Nothing
405
- dummyCradleFile = (fromMaybe currentDir lspRootDir) </> " File.hs"
406
- cradleRes <- liftIO $ E. catch (Just <$> findLocalCradle dummyCradleFile) parseErrorHandler
407
-
408
- case cradleRes of
409
- Just cradle -> do
410
- projGhcVersion <- liftIO $ getProjectGhcVersion cradle
411
- when (projGhcVersion /= hieGhcVersion) $ do
412
- let msg = T. pack $ " Mismatching GHC versions: " ++ cradleDisplay cradle ++
413
- " is " ++ projGhcVersion ++ " , HIE is " ++ hieGhcVersion
414
- ++ " \n You may want to use hie-wrapper. Check the README for more information"
415
- reactorSend $ NotShowMessage $ fmServerShowMessageNotification J. MtWarning msg
416
- reactorSend $ NotLogMessage $ fmServerLogMessageNotification J. MtWarning msg
417
-
418
- -- Check cabal is installed
419
- -- TODO: only do this check if its a cabal cradle
420
- hasCabal <- liftIO checkCabalInstall
421
- unless hasCabal $ do
422
- let cabalMsg = T. pack " cabal-install is not installed. Check the README for more information"
423
- reactorSend $ NotShowMessage $ fmServerShowMessageNotification J. MtWarning cabalMsg
424
- reactorSend $ NotLogMessage $ fmServerLogMessageNotification J. MtWarning cabalMsg
425
-
426
- Nothing -> return ()
427
-
428
452
renv <- ask
429
453
let hreq = GReq tn " init-hoogle" Nothing Nothing Nothing callback Nothing $ IdeResultOk <$> Hoogle. initializeHoogleDb
430
454
callback Nothing = flip runReaderT renv $
0 commit comments