haskell/haskell-ide-engine
1
1
Fork 0
mirror of https://github.com/haskell/haskell-ide-engine.git synced 2024-08-15 22:10:31 +03:00
Code Issues Projects Releases Wiki Activity

Display which cradle was used when testing for mismatching GHC versions

Browse Source
This commit is contained in:
Luke Lau 2019-12-16 14:17:30 +00:00
parent 43cf0d1d3e
commit eb4ce4cf3d
3 changed files with 21 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
hie-plugin-api/Haskell/Ide/Engine/Cradle.hs
View File

@ -15,14 +15,16 @@ import Distribution.Helper (Package, projectPackages, pUnits,
Unit, unitInfo, uiComponents,
ChEntrypoint(..))
import Distribution.Helper.Discover (findProjects, getDefaultDistDir)
import Data.Char (toLower)
import Data.Function ((&))
import Data.List (isPrefixOf)
import Data.List (isPrefixOf, isInfixOf)
import qualified Data.List.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map as M
import Data.List (sortOn, find)
import Data.Maybe (listToMaybe, mapMaybe, isJust)
import Data.Ord (Down(..))
import Data.String (IsString(..))
import Data.Foldable (toList)
import Control.Exception (IOException, try)
import System.FilePath
@ -680,3 +682,17 @@ ancestors dir
relativeTo :: FilePath -> [FilePath] -> Maybe FilePath
relativeTo file sourceDirs = listToMaybe
$ mapMaybe (`stripFilePath` file) sourceDirs
-- | Returns a user facing display name for the cradle type,
-- e.g. "Stack project" or "GHC session"
cradleDisplay :: IsString a => BIOS.Cradle -> a
cradleDisplay cradle = fromString result
where
result
| "stack" `isInfixOf` name = "Stack project"
| "cabal-v1" `isInfixOf` name = "Cabal (V1) project"
| "cabal" `isInfixOf` name = "Cabal project"
| "direct" `isInfixOf` name = "GHC session"
| otherwise = "project"
name = map toLower $ BIOS.actionName (BIOS.cradleOptsProg cradle)

15
hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs
View File

@ -32,9 +32,7 @@ import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Control
import Control.Monad.Trans.Free
import Data.Char
import Data.Dynamic (toDyn, fromDynamic, Dynamic)
import Data.List
import Data.Generics (Proxy(..), TypeRep, typeRep, typeOf)
import qualified Data.Map as Map
import Data.Maybe
@ -52,11 +50,10 @@ import qualified Data.Text as Text
import qualified Data.Yaml as Yaml
import qualified HIE.Bios as BIOS
import qualified HIE.Bios.Ghc.Api as BIOS
import qualified HIE.Bios.Types as BIOS
import qualified Data.ByteString.Char8 as B
import Haskell.Ide.Engine.ArtifactMap
import Haskell.Ide.Engine.Cradle (findLocalCradle)
import Haskell.Ide.Engine.Cradle (findLocalCradle, cradleDisplay)
import Haskell.Ide.Engine.TypeMap
import Haskell.Ide.Engine.GhcModuleCache
import Haskell.Ide.Engine.MultiThreadState
@ -157,16 +154,6 @@ loadCradle iniDynFlags (NewCradle fp) def action = do
}
where
-- | Get a user facing display name for the cradle type.
cradleDisplay :: BIOS.Cradle -> Text.Text
cradleDisplay cradle
| "stack" `isInfixOf` name = "Stack project"
| "cabal-v1" `isInfixOf` name = "Cabal (V1) project"
| "cabal" `isInfixOf` name = "Cabal project"
| "direct" `isInfixOf` name = "GHC session"
| otherwise = "project"
where name = map toLower $ BIOS.actionName (BIOS.cradleOptsProg cradle)
-- | Initialise the given cradle. This might fail and return an error via `IdeResultFail`.
-- Reports its progress to the client.
initialiseCradle :: (MonadIde m, HasGhcModuleCache m, GHC.GhcMonad m, MonadBaseControl IO m)

5
src/Haskell/Ide/Engine/Transport/LspStdio.hs
View File

@ -38,7 +38,7 @@ import qualified Data.SortedList as SL
import qualified Data.Text as T
import Data.Text.Encoding
import qualified Data.Yaml as Yaml
import Haskell.Ide.Engine.Cradle (findLocalCradle)
import Haskell.Ide.Engine.Cradle (findLocalCradle, cradleDisplay)
import Haskell.Ide.Engine.Config
import qualified Haskell.Ide.Engine.Ghc as HIE
import Haskell.Ide.Engine.LSP.CodeActions
@ -411,7 +411,8 @@ reactor inp diagIn = do
Just cradle -> do
projGhcVersion <- liftIO $ getProjectGhcVersion cradle
when (projGhcVersion /= hieGhcVersion) $ do
let msg = T.pack $ "Mismatching GHC versions: Project is " ++ projGhcVersion ++ ", HIE is " ++ hieGhcVersion
let msg = T.pack $ "Mismatching GHC versions: " ++ cradleDisplay cradle ++
" is " ++ projGhcVersion ++ ", HIE is " ++ hieGhcVersion
++ "\nYou may want to use hie-wrapper. Check the README for more information"
reactorSend $ NotShowMessage $ fmServerShowMessageNotification J.MtWarning msg
reactorSend $ NotLogMessage $ fmServerLogMessageNotification J.MtWarning msg