From 4ad872ac715e212c2c2c86e4a1a87f9c3a09ee91 Mon Sep 17 00:00:00 2001
From: alexwl <alexey.a.kiryushin@gmail.com>
Date: Sun, 28 Apr 2019 13:24:31 +0300
Subject: Fix GHC version check

---
 src/HaskellCodeExplorer/PackageInfo.hs | 67 ++++++++--------------------------
 1 file changed, 16 insertions(+), 51 deletions(-)

(limited to 'src/HaskellCodeExplorer')

diff --git a/src/HaskellCodeExplorer/PackageInfo.hs b/src/HaskellCodeExplorer/PackageInfo.hs
index 8ba3abd..7019221 100644
--- a/src/HaskellCodeExplorer/PackageInfo.hs
+++ b/src/HaskellCodeExplorer/PackageInfo.hs
@@ -33,7 +33,6 @@ 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
@@ -42,8 +41,7 @@ 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 Data.Version (Version(..), showVersion)
 import Digraph (flattenSCCs)
 import Distribution.Helper
   ( ChComponentName(..)
@@ -56,6 +54,7 @@ import Distribution.Helper
   , packageId
   , runQuery
   , sourceDirs
+  , compilerVersion  
   )
 import DynFlags
   ( DynFlags(..)
@@ -120,7 +119,6 @@ import System.FilePath
   , splitDirectories  
   )
 import System.FilePath.Find
-import System.IO (IOMode(..), withFile)
 import System.Process (readProcess)
 
 createPackageInfo ::
@@ -143,28 +141,28 @@ 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) <-
+  ((packageName, packageVersion), (_packageCompilerName, packageCompilerVersion), compInfo) <-
     liftIO $
     runQuery
       cabalHelperQueryEnv
-      ((,) <$> packageId <*>
+      ((,,) <$> packageId <*> compilerVersion <*>
        (zip3 <$> components ((,) <$> ghcOptions) <*>
         components ((,) <$> entrypoints) <*>
         components ((,) <$> sourceDirs)))
   let currentPackageId = HCE.PackageId (T.pack packageName) packageVersion
+  unless
+    (take 3 (versionBranch packageCompilerVersion) ==
+     take 3 (versionBranch ghcVersion)) $
+    logInfoN $
+    T.concat
+      [ "GHC version mismatch. haskell-code-indexer: "
+      , T.pack $ showVersion ghcVersion
+      , ", package: "
+      , T.pack $ showVersion packageCompilerVersion
+      , ". "
+      , "The indexing might fail."
+      ]
   logInfoN $ T.append "Indexing " $ HCE.packageIdToText currentPackageId
   let buildComponents =
         L.map
@@ -266,39 +264,6 @@ createPackageInfo packageDirectoryPath mbDistDirRelativePath sourceCodePreproces
       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 = []}
-- 
cgit v1.2.3