Fix Cabal version selection for Stack (esp. build-type:Custom)

Previously we would pick up Stack's Cabal version with ghc-pkg on the
global package-db. This however ignores that Stack also supports custom
Setup.hs with the Cabal version from the snapshot instead.

4 files changed, 53 insertions, 66 deletions

diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs
index 507adad..4a03619 100644
--- a/lib/Distribution/Helper.hs
+++ b/lib/Distribution/Helper.hs
@@ -537,43 +537,37 @@ getFileModTime f = do
 
 readProjInfo
     :: QueryEnvI c pt -> ProjConf pt -> ProjConfModTimes -> PreInfo pt -> IO (ProjInfo pt)
-readProjInfo qe pc pcm pi = withVerbosity $ do
+readProjInfo qe pc pcm _pi = withVerbosity $ do
   let projloc = qeProjLoc qe
   case (qeDistDir qe, pc) of
     (DistDirCabal SCV1 distdir, ProjConfV1{pcV1CabalFile}) -> do
       setup_config_path <- canonicalizePath (distdir </> "setup-config")
-      mhdr <- readSetupConfigHeader setup_config_path
-      case mhdr of
-        Just hdr@(UnitHeader (pkg_name_bs, _pkg_ver) ("Cabal", hdrCabalVersion) _compId) -> do
-          let
-            v3_0_0_0 = makeVersion [3,0,0,0]
-            pkg_name
-              | hdrCabalVersion >= v3_0_0_0 = BSU.toString pkg_name_bs
-              | otherwise = BS8.unpack pkg_name_bs
-            pkg = Package
-              { pPackageName = pkg_name
-              , pSourceDir = plCabalProjectDir projloc
-              , pCabalFile = CabalFile pcV1CabalFile
-              , pFlags = []
-              , pUnits = (:|[]) Unit
-                { uUnitId = UnitId pkg_name
-                , uPackage = pkg { pUnits = () }
-                , uDistDir = DistDirLib distdir
-                , uImpl = UnitImplV1
-                }
-              }
-            piImpl = ProjInfoV1 { piV1SetupHeader = hdr }
-          return ProjInfo
-            { piCabalVersion = hdrCabalVersion
-            , piProjConfModTimes = pcm
-            , piPackages = pkg :| []
-            , piImpl
+      hdr@(UnitHeader (pkg_name_bs, _pkg_ver) ("Cabal", hdrCabalVersion) _)
+          <- readSetupConfigHeader setup_config_path
+      let
+        v3_0_0_0 = makeVersion [3,0,0,0]
+        pkg_name
+          | hdrCabalVersion >= v3_0_0_0 = BSU.toString pkg_name_bs
+          | otherwise = BS8.unpack pkg_name_bs
+        pkg = Package
+          { pPackageName = pkg_name
+          , pSourceDir = plCabalProjectDir projloc
+          , pCabalFile = CabalFile pcV1CabalFile
+          , pFlags = []
+          , pUnits = (:|[]) Unit
+            { uUnitId = UnitId pkg_name
+            , uPackage = pkg { pUnits = () }
+            , uDistDir = DistDirLib distdir
+            , uImpl = UnitImplV1
             }
-        Just UnitHeader {uhSetupId=(setup_name, _)} ->
-          panicIO $ printf "Unknown Setup package-id in setup-config header '%s': '%s'"
-                      (BS8.unpack setup_name) setup_config_path
-        Nothing ->
-          panicIO $ printf "Could not read '%s' header" setup_config_path
+          }
+        piImpl = ProjInfoV1 { piV1SetupHeader = hdr }
+      return ProjInfo
+        { piCabalVersion = hdrCabalVersion
+        , piProjConfModTimes = pcm
+        , piPackages = pkg :| []
+        , piImpl
+        }
 
     (DistDirCabal SCV2 distdirv2, _) -> do
       let plan_path = distdirv2 </> "cache" </> "plan.json"
@@ -602,11 +596,9 @@ readProjInfo qe pc pcm pi = withVerbosity $ do
     (DistDirStack{}, _) -> do
       Just cabal_files <- NonEmpty.nonEmpty <$> Stack.listPackageCabalFiles qe
       pkgs <- mapM (Stack.getPackage qe) cabal_files
-      Just (cabalVer:_) <- runMaybeT $
-        let ?progs = qePrograms qe in
-        let PreInfoStack {piStackProjPaths} = pi in
-        GHC.listCabalVersions (Just (sppGlobalPkgDb piStackProjPaths))
-        --  ^ See [Note Stack Cabal Version]
+      let DistDirLib distdir = uDistDir $ NonEmpty.head $ pUnits $ NonEmpty.head pkgs
+      hdr <- readSetupConfigHeader $ distdir </> "setup-config"
+      let ("Cabal", cabalVer) = uhSetupId hdr
       return ProjInfo
         { piCabalVersion = cabalVer
         , piProjConfModTimes = pcm
@@ -614,20 +606,6 @@ readProjInfo qe pc pcm pi = withVerbosity $ do
         , piImpl = ProjInfoStack
         }
 
--- [Note Stack Cabal Version]
---
--- Stack just uses ghc-pkg on the global-pkg-db to determine the
--- appropriate Cabal version for a resolver when building, see
--- Stack.Setup.pathsFromCompiler(cabalPkgVer). We do essentially the same
--- thing here.
---
--- The code for building Setup.hs is in Stack.Build.Execute and the version
--- of cabal is set in withSingleContext.withCabal.getPackageArgs.
---
--- Note there is some special casing going on (see 'depsMinusCabal'), they
--- use the packages from the snapshot pkg-db except Cabal which comes from
--- the global pkg-db.
-
 readUnitInfo :: Helper pt -> Unit pt -> UnitModTimes -> IO UnitInfo
 readUnitInfo helper unit@Unit {uUnitId=uiUnitId} uiModTimes = do
     res <- runHelper helper unit
@@ -815,7 +793,7 @@ mkCompHelperEnv
     { cheCabalVer = CabalVersion piCabalVersion
     , cheProjDir  = plCabalProjectDir projloc
     , cheProjLocalCacheDir = distdir
-    , chePkgDb    = Nothing
+    , chePkgDb    = []
     , chePlanJson = Nothing
     , cheDistV2 = Nothing
     }
@@ -829,7 +807,7 @@ mkCompHelperEnv
     cheProjDir  = plCabalProjectDir projloc
     cheCabalVer = CabalVersion $ makeDataVersion pjCabalLibVersion
     cheProjLocalCacheDir = distdir </> "cache"
-    chePkgDb    = Nothing
+    chePkgDb    = []
     chePlanJson = Just plan
     cheDistV2   = Just distdir
     PlanJson {pjCabalLibVersion=Ver pjCabalLibVersion } = plan
@@ -838,7 +816,7 @@ mkCompHelperEnv
   (DistDirStack mworkdir)
   PreInfoStack
     { piStackProjPaths=StackProjPaths
-      { sppGlobalPkgDb }
+      { sppGlobalPkgDb, sppSnapPkgDb, sppLocalPkgDb }
     }
   ProjInfo { piCabalVersion }
   = let workdir = fromMaybe ".stack-work" $ unRelativePath <$> mworkdir in
@@ -847,7 +825,7 @@ mkCompHelperEnv
     { cheCabalVer = CabalVersion $ piCabalVersion
     , cheProjDir  = projdir
     , cheProjLocalCacheDir = projdir </> workdir
-    , chePkgDb    = Just sppGlobalPkgDb
+    , chePkgDb    = [sppGlobalPkgDb, sppSnapPkgDb, sppLocalPkgDb]
     , chePlanJson = Nothing
     , cheDistV2 = Nothing
     }
diff --git a/src/CabalHelper/Compiletime/Cabal.hs b/src/CabalHelper/Compiletime/Cabal.hs
index b565152..88e53a7 100644
--- a/src/CabalHelper/Compiletime/Cabal.hs
+++ b/src/CabalHelper/Compiletime/Cabal.hs
@@ -268,9 +268,18 @@ complainIfNoCabalFile pkgdir Nothing =
 bultinCabalVersion :: Version
 bultinCabalVersion = parseVer VERSION_Cabal
 
-readSetupConfigHeader :: FilePath -> IO (Maybe UnitHeader)
+readSetupConfigHeader :: FilePath -> IO UnitHeader
 readSetupConfigHeader file = bracket (openFile file ReadMode) hClose $ \h -> do
-  parseSetupHeader <$> BS.hGetLine h
+  mhdr <- parseSetupHeader <$> BS.hGetLine h
+  case mhdr of
+    Just hdr@(UnitHeader _PkgId ("Cabal", _hdrCabalVersion) _compId) -> do
+      return hdr
+    Just UnitHeader {uhSetupId=(setup_name, _)} -> panicIO $
+      printf "Unknown Setup package-id in setup-config header '%s': '%s'"
+        (BS8.unpack setup_name) file
+    Nothing -> panicIO $
+      printf "Could not read '%s' header" file
+
 
 parseSetupHeader :: BS.ByteString -> Maybe UnitHeader
 parseSetupHeader header = case BS8.words header of
diff --git a/src/CabalHelper/Compiletime/Compile.hs b/src/CabalHelper/Compiletime/Compile.hs
index d2886e8..a55ee93 100644
--- a/src/CabalHelper/Compiletime/Compile.hs
+++ b/src/CabalHelper/Compiletime/Compile.hs
@@ -90,7 +90,7 @@ data CompilationProductScope = CPSGlobal | CPSProject
 type CompHelperEnv = CompHelperEnv' CabalVersion
 data CompHelperEnv' cv = CompHelperEnv
   { cheCabalVer :: !cv
-  , chePkgDb    :: !(Maybe PackageDbDir)
+  , chePkgDb    :: ![PackageDbDir]
   -- ^ A package-db where we are guaranteed to find Cabal-`cheCabalVer`.
   , cheProjDir  :: !FilePath
   , chePlanJson :: !(Maybe PlanJson)
@@ -119,7 +119,7 @@ compileHelper' CompHelperEnv {..} = do
     CabalVersion cabalVerPlain -> do
       runMaybeT $ msum $ map (\f -> f ghcVer cabalVerPlain) $
         case chePkgDb of
-          Nothing ->
+          [] ->
             [ compileWithCabalV2Inplace
             , compileWithCabalV2GhcEnv
             , compileCabalSource
@@ -127,8 +127,8 @@ compileHelper' CompHelperEnv {..} = do
             , compileGlobal
             , compileWithCabalInPrivatePkgDb
             ]
-          Just db ->
-            [ ((.).(.)) liftIO (compilePkgDb db)
+          dbs ->
+            [ ((.).(.)) liftIO (compilePkgDbs dbs)
             ]
   appdir <- appCacheDir
   let cp@CompPaths {compExePath} = compPaths appdir cheProjLocalCacheDir comp
@@ -148,11 +148,11 @@ compileHelper' CompHelperEnv {..} = do
 
 -- for relaxed deps: find (sameMajorVersionAs cheCabalVer) . reverse . sort
 
-   compilePkgDb db _ghcVer cabalVer  = return $
+   compilePkgDbs dbs _ghcVer cabalVer = return $
        (,)
          (pure ())
          CompileWithCabalPackage
-           { compPackageSource = GPSPackageDBs [db]
+           { compPackageSource = GPSPackageDBs dbs
            , compCabalVersion  = CabalVersion cabalVer
            , compProductTarget = CPSProject
            }
diff --git a/tests/CompileTest.hs b/tests/CompileTest.hs
index 77698c5..88ba44e 100644
--- a/tests/CompileTest.hs
+++ b/tests/CompileTest.hs
@@ -152,11 +152,11 @@ testCabalVersions versions = do
         mcabalVersions <- runMaybeT $ listCabalVersions (Just db)
         case mcabalVersions of
           Just [hdver] ->
-            return $ che0 (CabalVersion hdver) (Just db)
+            return $ che0 (CabalVersion hdver) [db]
           _ ->
-            return $ che0 (CabalHEAD ()) Nothing
+            return $ che0 (CabalHEAD ()) []
       (CabalVersion ver) ->
-        return $ che0 (CabalVersion ver) Nothing
+        return $ che0 (CabalVersion ver) []
 
     compileHelper che