Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit 21f894a

Browse files
committed
Move version check into onInitialisation
1 parent b5290e0 commit 21f894a

File tree

1 file changed

+36
-42
lines changed

1 file changed

+36
-42
lines changed

src/Haskell/Ide/Engine/Server.hs

+36-42
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,8 @@ import qualified Data.SortedList as SL
3838
import qualified Data.Text as T
3939
import Data.Text.Encoding
4040
import qualified Data.Yaml as Yaml
41-
import Haskell.Ide.Engine.Cradle (findLocalCradle, cradleDisplay)
41+
import Haskell.Ide.Engine.Cradle (findLocalCradle, cradleDisplay
42+
, isCabalCradle)
4243
import Haskell.Ide.Engine.Config
4344
import qualified Haskell.Ide.Engine.Ghc as HIE
4445
import Haskell.Ide.Engine.CodeActions
@@ -156,13 +157,36 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do
156157
currentDir <- liftIO getCurrentDirectory
157158

158159
-- Check for mismatching GHC versions
159-
-- Ignore hie.yaml parse errors. They get reported in ModuleCache.hs
160-
let parseErrorHandler (_ :: Yaml.ParseException) = do
161-
logm "Caught a yaml parse exception"
162-
return Nothing
163-
dummyCradleFile = fromMaybe currentDir lspRootDir </> "File.hs"
164-
logm $ "Dummy Cradle File: " ++ dummyCradleFile
165-
mcradle <- liftIO $ E.catch (Just <$> findLocalCradle dummyCradleFile) parseErrorHandler
160+
let dummyCradleFile = fromMaybe currentDir lspRootDir </> "File.hs"
161+
logm $ "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+
++ "\nYou 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 (_ :: Yaml.ParseException) -> do
184+
logm "Failed to parse it"
185+
sf $ NotShowMessage $ fmServerShowMessageNotification J.MtError "Couldn't parse hie.yaml"
186+
187+
let mcradle = case cradleRes of
188+
Left _ -> Nothing
189+
Right c -> Just c
166190

167191
-- haskell lsp sets the current directory to the project root in the InitializeRequest
168192
-- We launch the dispatcher after that so that the default cradle is
@@ -176,14 +200,14 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do
176200
flip labelThread "reactor" =<<
177201
(forkIO (
178202
reactorFunc
179-
`E.onException`
180-
errorm "Reactor thread exited unexpectedly"
203+
`E.catch` \(e :: E.SomeException) ->
204+
(errorm $ "Reactor thread exited unexpectedly: " ++ show e)
181205
))
182206
flip labelThread "diagnostics" =<<
183207
(forkIO (
184208
diagnosticsQueue tr
185-
`E.onException`
186-
errorm "diagnostics thread exited unexpectedly"
209+
`E.catch` \(e :: E.SomeException) ->
210+
(errorm $ "Diagnostic thread exited unexpectedly: " ++ show e)
187211
))
188212

189213
return Nothing
@@ -425,36 +449,6 @@ reactor inp diagIn = do
425449
reactorSend $ NotLogMessage $
426450
fmServerLogMessageNotification J.MtLog $ "Using hie version: " <> T.pack hieVersion
427451

428-
lspRootDir <- asksLspFuncs Core.rootPath
429-
currentDir <- liftIO getCurrentDirectory
430-
431-
-- Check for mismatching GHC versions
432-
let dummyCradleFile = (fromMaybe currentDir lspRootDir) </> "File.hs"
433-
logm $ "Dummy Cradle file result: " ++ dummyCradleFile
434-
cradleRes <- liftIO $ E.try (findLocalCradle dummyCradleFile)
435-
436-
case cradleRes of
437-
Right cradle -> do
438-
projGhcVersion <- liftIO $ getProjectGhcVersion cradle
439-
when (projGhcVersion /= hieGhcVersion) $ do
440-
let msg = T.pack $ "Mismatching GHC versions: " ++ cradleDisplay cradle ++
441-
" is " ++ projGhcVersion ++ ", HIE is " ++ hieGhcVersion
442-
++ "\nYou may want to use hie-wrapper. Check the README for more information"
443-
reactorSend $ NotShowMessage $ fmServerShowMessageNotification J.MtWarning msg
444-
reactorSend $ NotLogMessage $ fmServerLogMessageNotification J.MtWarning msg
445-
446-
-- Check cabal is installed
447-
-- TODO: only do this check if its a cabal cradle
448-
hasCabal <- liftIO checkCabalInstall
449-
unless hasCabal $ do
450-
let cabalMsg = T.pack "cabal-install is not installed. Check the README for more information"
451-
reactorSend $ NotShowMessage $ fmServerShowMessageNotification J.MtWarning cabalMsg
452-
reactorSend $ NotLogMessage $ fmServerLogMessageNotification J.MtWarning cabalMsg
453-
454-
Left (_ :: Yaml.ParseException) -> do
455-
logm "Failed to parse it"
456-
reactorSend $ NotShowMessage $ fmServerShowMessageNotification J.MtError "Couldn't parse hie.yaml"
457-
458452
renv <- ask
459453
let hreq = GReq tn "init-hoogle" Nothing Nothing Nothing callback Nothing $ IdeResultOk <$> Hoogle.initializeHoogleDb
460454
callback Nothing = flip runReaderT renv $

0 commit comments

Comments
 (0)