diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/HaskellCodeExplorer/PackageInfo.hs | 74 |
1 files changed, 72 insertions, 2 deletions
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 |