Skip to content
This repository has been archived by the owner on Apr 25, 2020. It is now read-only.

Commit

Permalink
Implement GHC version check warnings/errors
Browse files Browse the repository at this point in the history
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)
  • Loading branch information
DanielG committed Nov 26, 2015
1 parent 0d97646 commit f6e581a
Showing 1 changed file with 66 additions and 1 deletion.
67 changes: 66 additions & 1 deletion Language/Haskell/GhcMod/CabalHelper.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 ((.))
Expand Down Expand Up @@ -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"
Expand Down

0 comments on commit f6e581a

Please sign in to comment.