From e645794af39ec6a04d5a25ac18b94a3cb324d394 Mon Sep 17 00:00:00 2001 From: alexwl Date: Wed, 27 Mar 2019 23:26:22 +0300 Subject: Add GHC version check --- app/Indexer.hs | 23 +---------- src/HaskellCodeExplorer/PackageInfo.hs | 74 +++++++++++++++++++++++++++++++++- 2 files changed, 73 insertions(+), 24 deletions(-) diff --git a/app/Indexer.hs b/app/Indexer.hs index 7fc560e..6284f06 100644 --- a/app/Indexer.hs +++ b/app/Indexer.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} @@ -21,7 +20,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.Time (getZonedTime) import Data.Version (Version(..),showVersion) -import HaskellCodeExplorer.PackageInfo (createPackageInfo) +import HaskellCodeExplorer.PackageInfo (createPackageInfo, ghcVersion) import qualified HaskellCodeExplorer.Types as HCE import Network.URI.Encode (encode) import Options.Applicative @@ -75,26 +74,6 @@ data Compression | NoCompression deriving (Show, Eq) -#if MIN_VERSION_GLASGOW_HASKELL(8,6,4,0) -ghcVersion :: Version -ghcVersion = Version {versionBranch = [8, 6, 4, 0], versionTags = []} -#elif MIN_VERSION_GLASGOW_HASKELL(8,6,3,0) -ghcVersion :: Version -ghcVersion = Version {versionBranch = [8, 6, 3, 0], versionTags = []} -#elif MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) -ghcVersion :: Version -ghcVersion = Version {versionBranch = [8, 4, 4, 0], versionTags = []} -#elif MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) -ghcVersion :: Version -ghcVersion = Version {versionBranch = [8, 4, 3, 0], versionTags = []} -#elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) -ghcVersion :: Version -ghcVersion = Version {versionBranch = [8, 2, 2, 0], versionTags = []} -#else -ghcVersion :: Version -ghcVersion = Version {versionBranch = [8, 0, 2, 0], versionTags = []} -#endif - versionInfo :: String versionInfo = "haskell-code-indexer version " ++ diff --git a/src/HaskellCodeExplorer/PackageInfo.hs b/src/HaskellCodeExplorer/PackageInfo.hs index fc09915..8ba3abd 100644 --- a/src/HaskellCodeExplorer/PackageInfo.hs +++ b/src/HaskellCodeExplorer/PackageInfo.hs @@ -10,6 +10,7 @@ module HaskellCodeExplorer.PackageInfo ( createPackageInfo + , ghcVersion ) where import Control.DeepSeq(deepseq) @@ -32,6 +33,7 @@ import Control.Monad.Logger , logInfoN ) import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC import qualified Data.HashMap.Strict as HM import Data.IORef (readIORef) import qualified Data.IntMap.Strict as IM @@ -40,6 +42,8 @@ import Data.Maybe (fromMaybe, isJust, maybeToList) import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.Encoding as TE +import Data.Version (Version(..), showVersion, parseVersion) +import Text.ParserCombinators.ReadP (readP_to_S) import Digraph (flattenSCCs) import Distribution.Helper ( ChComponentName(..) @@ -102,6 +106,7 @@ import System.Directory , makeAbsolute ) import qualified System.Directory.Tree as DT +import System.Exit (exitFailure) import System.FilePath ( () , addTrailingPathSeparator @@ -115,7 +120,7 @@ import System.FilePath , splitDirectories ) import System.FilePath.Find -import System.Exit (exitFailure) +import System.IO (IOMode(..), withFile) import System.Process (readProcess) createPackageInfo :: @@ -138,6 +143,18 @@ createPackageInfo packageDirectoryPath mbDistDirRelativePath sourceCodePreproces Right distDir -> return distDir Left errorMessage -> logErrorN (T.pack errorMessage) >> liftIO exitFailure + eitherPackageGhcVersion <- liftIO $ getPackageGhcVersion distDir + case eitherPackageGhcVersion of + Right packageGhcVersion -> + if take 2 (versionBranch packageGhcVersion) == take 2 (versionBranch ghcVersion) + then return () + else let message = + "GHC version mismatch. haskell-code-indexer: " ++ + showVersion ghcVersion ++ + ", package: " ++ + showVersion packageGhcVersion + in logErrorN (T.pack message) >> liftIO exitFailure + Left err -> logErrorN (T.pack err) >> liftIO exitFailure let cabalHelperQueryEnv = mkQueryEnv packageDirectoryAbsPath distDir ((packageName, packageVersion), compInfo) <- liftIO $ @@ -248,7 +265,60 @@ createPackageInfo packageDirectoryPath mbDistDirRelativePath sourceCodePreproces chComponentNameToComponentId (ChBenchName name) = HCE.ComponentId . T.append "bench-" . T.pack $ name chComponentNameToComponentId ChSetupHsName = HCE.ComponentId "setup" - + +-- | Parses the header of setup-config file. +-- The header is generated by Cabal: +-- https://github.com/haskell/cabal/blob/5be57c0d251be40a6263cd996d99703b8de1ed79/Cabal/Distribution/Simple/Configure.hs#L286-L295 +getPackageGhcVersion :: FilePath -> IO (Either String Version) +getPackageGhcVersion distDir = + withFile (distDir "setup-config") ReadMode $ \handle -> do + header <- BSC.hGetLine handle + let parseHeader :: BSC.ByteString -> Maybe BSC.ByteString + parseHeader hdr = + case BSC.words hdr of + ["Saved", "package", "config", "for", _package, "written", "by", _cabal, "using", compiler] -> + Just compiler + _ -> Nothing + parseCompiler :: BSC.ByteString -> Maybe BSC.ByteString + parseCompiler compiler = + case BSC.split '-' compiler of + ["ghc", version] -> Just version + _ -> Nothing + parseGhcVersion :: BSC.ByteString -> Maybe Version + parseGhcVersion version = + case filter ((== "") . snd) $ + readP_to_S parseVersion $ BSC.unpack version of + [(ver, "")] -> Just ver + _ -> Nothing + case parseHeader header >>= parseCompiler >>= parseGhcVersion of + Just version -> return $ Right version + _ -> + return $ + Left $ + "Unexpected setup-config header: \"" ++ + BSC.unpack header ++ + "\"\nIt may mean that the version of Cabal used to build this package is not supported by haskell-code-indexer yet." + +#if MIN_VERSION_GLASGOW_HASKELL(8,6,4,0) +ghcVersion :: Version +ghcVersion = Version {versionBranch = [8, 6, 4, 0], versionTags = []} +#elif MIN_VERSION_GLASGOW_HASKELL(8,6,3,0) +ghcVersion :: Version +ghcVersion = Version {versionBranch = [8, 6, 3, 0], versionTags = []} +#elif MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +ghcVersion :: Version +ghcVersion = Version {versionBranch = [8, 4, 4, 0], versionTags = []} +#elif MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +ghcVersion :: Version +ghcVersion = Version {versionBranch = [8, 4, 3, 0], versionTags = []} +#elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) +ghcVersion :: Version +ghcVersion = Version {versionBranch = [8, 2, 2, 0], versionTags = []} +#else +ghcVersion :: Version +ghcVersion = Version {versionBranch = [8, 0, 2, 0], versionTags = []} +#endif + buildDirectoryTree :: FilePath -> [FilePath] -> (FilePath -> Bool) -> IO HCE.DirTree buildDirectoryTree path ignoreDirectories isHaskellModule = do (_dir DT.:/ tree) <- DT.readDirectoryWith (const . return $ ()) path -- cgit v1.2.3