aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/HaskellCodeExplorer/PackageInfo.hs74
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