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"