From eceb7e2a7e8c7a9942d612e778711f7c9196b70c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Thu, 26 Nov 2015 16:21:05 +0100
Subject: [PATCH] Implement GHC version check warnings/errors

Still have to find a suitable place to actually perform the check so we
don't have to do another call into cabal-helper (which is as slow as
cabal configure because it has to read dist/setup-config)
---
 Language/Haskell/GhcMod/CabalHelper.hs | 67 +++++++++++++++++++++++++-
 1 file changed, 66 insertions(+), 1 deletion(-)

diff --git a/Language/Haskell/GhcMod/CabalHelper.hs b/Language/Haskell/GhcMod/CabalHelper.hs
index 7785613b3..bbde70514 100644
--- a/Language/Haskell/GhcMod/CabalHelper.hs
+++ b/Language/Haskell/GhcMod/CabalHelper.hs
@@ -29,11 +29,13 @@ module Language.Haskell.GhcMod.CabalHelper
 import Control.Applicative
 import Control.Monad
 import Control.Category ((.))
+import Config (cProjectVersion)
 import Data.Maybe
 import Data.Monoid
 import Data.Version
 import Data.Binary (Binary)
-import Data.Traversable
+import Data.Traversable hiding (mapM)
+import Data.Char
 import Distribution.Helper hiding (Programs(..))
 import qualified Distribution.Helper as CH
 import qualified Language.Haskell.GhcMod.Types as T
@@ -46,6 +48,7 @@ import Language.Haskell.GhcMod.Output
 import Language.Haskell.GhcMod.CustomPackageDb
 import Language.Haskell.GhcMod.Stack
 import System.FilePath
+import System.Directory
 import System.Process
 import System.Exit
 import Prelude hiding ((.))
@@ -260,6 +263,68 @@ withCabal action = do
        ExitFailure _ -> return False
 
 
+numericVersion :: FilePath -> IO String
+numericVersion prog =
+    trim <$> readProcess prog ["--numeric-version"] ""
+
+ghcPkgVersion :: FilePath -> IO String
+ghcPkgVersion prog = do
+    trim . dropWhile (not . isDigit) <$> readProcess prog ["--version"] ""
+
+trim :: String -> String
+trim = dropWhileEnd isSpace
+
+
+data GhcVersionProblem = GVPSimpleMismatch FilePath String String -- only a warning really since user could have picked a different ghc version via cabal or something
+                       | GVPQualNotFound FilePath String
+                       | GVPUnqualNotFound FilePath String
+                       | GVPNotFound FilePath String
+                       | GVPWTF String String
+                       | GVPCabal Project String String
+
+ppGhcVersionProblem (GVPSimpleMismatch ghcProg ghv gmGhv) =
+    "ghc-mod was compiled with GHC version " ++ gmGhv ++ " but the 'ghc' executable on your PATH is version " ++ ghv ++ " ."
+ppGhcVersionProblem (GVPQualNotFound ghcProg ghv) =
+    "Could not find 'ghc-"++ghv++"' even though '"++ghcProg++"' exists on your PATH, please fix your GHC installation."
+ppGhcVersionProblem (GVPUnqualNotFound ghcProg gmGhv) =
+    "Could not find '"++ghcProg++"' executable even though 'ghc-"++gmGhv++"' exists on your PATH, please fix your GHC installation."
+ppGhcVersionProblem (GVPNotFound ghcProg gmGhv) =
+    "Could not find any GHC executables on your PATH. Neither '"++ghcProg++"' nor 'ghc-"++gmGhv++"' exist, please fix your GHC installation."
+ppGhcVersionProblem (GVPWTF gmGhv cProjectVersion) =
+    "The 'ghc-"++cProjectVersion++"' executable on your PATH claims to be GHC version "++gmGhv++". WTF? Please fix your installation of GHC."
+ppGhcVersionProblem (GVPCabal projType cabalGhcVer gmGhv) =
+    "The current project is configured to use GHC version "++cabalGhcVer++" but ghc-mod was compiled with GHC version "++gmGhv++"." ++ suggestion
+
+ where
+   suggestion
+       | StackProject _ <- projType = " This usually happens when the GHC version your of your resolver is different from the one ghc-mod was compiled with during installation." -- TODO: mention per-project install?
+       | otherwise = " This usually happens when the 'ghc' executable on your PATH is a different version from the one used to compile ghc-mod as 'cabal configure' will just pick whatever GHC you have on your PATH and ghc-mod complies with the configuration generated by Cabal."
+
+checkGhcVersion :: FilePath -> Project -> Maybe Version -> IO [GhcVersionProblem]
+checkGhcVersion ghcProg projType mCabalGhcVersion =
+  case mCabalGhcVersion of
+    Nothing ->
+        maybeToList <$> checkPathGhcVersions
+    Just (showVersion -> cabalGhcVersion)
+        | cabalGhcVersion /= cProjectVersion -> do
+           mpgvp <- checkPathGhcVersions
+           let cgvp = GVPCabal projType cabalGhcVersion cProjectVersion
+           return $ cgvp:maybeToList mpgvp
+        | otherwise -> return []
+
+ where
+   checkPathGhcVersions = do
+     let ghcs = [ghcProg, "ghc-" ++ cProjectVersion]
+     [mGhv, mGmGhv] <- (traverse numericVersion <=< findExecutable) `mapM` ghcs
+     return $ case (mGhv, mGmGhv) of
+       (Just ghv, Just gmGhv)
+           | gmGhv /= cProjectVersion
+                             -> Just $ GVPWTF gmGhv cProjectVersion
+           | ghv /= gmGhv    -> Just $ GVPSimpleMismatch ghcProg ghv gmGhv
+           | ghv == gmGhv    -> Nothing
+       (Nothing, Just gmGhv) -> Just $ GVPQualNotFound ghcProg gmGhv
+       (Just ghv, Nothing)   -> Just $ GVPUnqualNotFound ghcProg ghv
+       (Nothing, Nothing)    -> Just $ GVPNotFound ghcProg cProjectVersion
 
 pkgDbArg :: GhcPkgDb -> String
 pkgDbArg GlobalDb      = "--package-db=global"