From eb4ce4cf3d0d1e6c8a8a1d89cbed509eb2fd2890 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Mon, 16 Dec 2019 14:17:30 +0000
Subject: [PATCH] Display which cradle was used when testing for mismatching
 GHC versions

---
 hie-plugin-api/Haskell/Ide/Engine/Cradle.hs    | 18 +++++++++++++++++-
 .../Haskell/Ide/Engine/ModuleCache.hs          | 15 +--------------
 src/Haskell/Ide/Engine/Transport/LspStdio.hs   |  5 +++--
 3 files changed, 21 insertions(+), 17 deletions(-)

diff --git a/hie-plugin-api/Haskell/Ide/Engine/Cradle.hs b/hie-plugin-api/Haskell/Ide/Engine/Cradle.hs
index ae32c156..79042947 100644
--- a/hie-plugin-api/Haskell/Ide/Engine/Cradle.hs
+++ b/hie-plugin-api/Haskell/Ide/Engine/Cradle.hs
@@ -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)
+
diff --git a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs
index 716e061e..be8753b9 100644
--- a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs
+++ b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs
@@ -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)
diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs
index 8b15bf29..69aaf0d8 100644
--- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs
+++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs
@@ -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