Refactor Compile (for v2-install)

6 files changed, 366 insertions, 156 deletions

diff --git a/src/CabalHelper/Compiletime/Cabal.hs b/src/CabalHelper/Compiletime/Cabal.hs
index 8f55473..9d0d00a 100644
--- a/src/CabalHelper/Compiletime/Cabal.hs
+++ b/src/CabalHelper/Compiletime/Cabal.hs
@@ -20,10 +20,13 @@ Description : cabal-install program interface
 License     : GPL-3
 -}
 
+{-# LANGUAGE DeriveFunctor #-}
+
 module CabalHelper.Compiletime.Cabal where
 
 import Control.Exception (bracket)
 import Control.Monad.IO.Class
+import Data.Char
 import Data.List
 import Data.Maybe
 import Data.Version
@@ -34,30 +37,40 @@ import System.FilePath
 import CabalHelper.Compiletime.Types
 import CabalHelper.Compiletime.Process
 import CabalHelper.Shared.Common (trim, replace)
-import Paths_cabal_helper (version)
+
+type UnpackedCabalVersion = CabalVersion' (CommitId, CabalSourceDir)
+type ResolvedCabalVersion = CabalVersion' CommitId
+type CabalVersion = CabalVersion' ()
+
+unpackedToResolvedCabalVersion :: UnpackedCabalVersion -> ResolvedCabalVersion
+unpackedToResolvedCabalVersion (CabalHEAD (commit, _)) = CabalHEAD commit
+unpackedToResolvedCabalVersion (CabalVersion ver) = CabalVersion ver
 
 -- | Cabal library version we're compiling the helper exe against.
-data CabalVersion
-    = CabalHEAD { cvCommitId :: CommitId }
-    | CabalVersion { cabalVersion :: Version }
+data CabalVersion' a
+    = CabalHEAD a
+    | CabalVersion { cvVersion :: Version }
+      deriving (Eq, Ord, Functor)
 
 newtype CommitId = CommitId { unCommitId :: String }
 
-showCabalVersion :: CabalVersion -> String
-showCabalVersion (CabalHEAD commitid) =
+showUnpackedCabalVersion :: UnpackedCabalVersion -> String
+showUnpackedCabalVersion (CabalHEAD (commitid, _)) =
   "HEAD-" ++ unCommitId commitid
-showCabalVersion CabalVersion {cabalVersion} =
-  showVersion cabalVersion
+showUnpackedCabalVersion CabalVersion {cvVersion} =
+  showVersion cvVersion
 
-exeName :: CabalVersion -> String
-exeName (CabalHEAD commitid) = intercalate "--"
-  [ "cabal-helper-" ++ showVersion version
-  , "Cabal-HEAD" ++ unCommitId commitid
-  ]
-exeName CabalVersion {cabalVersion} = intercalate "--"
-  [ "cabal-helper-" ++ showVersion version
-  , "Cabal-" ++ showVersion cabalVersion
-  ]
+showResolvedCabalVersion :: ResolvedCabalVersion -> String
+showResolvedCabalVersion (CabalHEAD commitid) =
+  "HEAD-" ++ unCommitId commitid
+showResolvedCabalVersion CabalVersion {cvVersion} =
+  showVersion cvVersion
+
+showCabalVersion :: CabalVersion -> String
+showCabalVersion (CabalHEAD ()) =
+  "HEAD"
+showCabalVersion CabalVersion {cvVersion} =
+  showVersion cvVersion
 
 data CabalPatchDescription = CabalPatchDescription
   { cpdVersions      :: [Version]
@@ -123,23 +136,41 @@ patchyCabalVersions = [
 
 unpackPatchedCabal :: Env => Version -> FilePath -> IO CabalSourceDir
 unpackPatchedCabal cabalVer tmpdir = do
-    res@(CabalSourceDir dir) <- unpackCabal cabalVer tmpdir variant
+    res@(CabalSourceDir dir) <- unpackCabalHackage cabalVer tmpdir variant
     patch dir
     return res
   where
     CabalPatchDescription _ variant patch = fromMaybe nopCabalPatchDescription $
       find ((cabalVer `elem`) . cpdVersions) patchyCabalVersions
 
+-- legacy, for `installCabalLib` v1
+unpackCabalV1
+  :: Env
+  => UnpackedCabalVersion
+  -> FilePath
+  -> IO CabalSourceDir
+unpackCabalV1 (CabalVersion ver) tmpdir = do
+  csdir <- unpackPatchedCabal ver tmpdir
+  return csdir
+unpackCabalV1 (CabalHEAD (_commit, csdir)) _tmpdir =
+  return csdir
+
+unpackCabal :: Env => CabalVersion -> FilePath -> IO UnpackedCabalVersion
+unpackCabal (CabalVersion ver) _tmpdir = do
+  return $ CabalVersion ver
+unpackCabal (CabalHEAD ()) tmpdir = do
+  (commit, csdir) <- unpackCabalHEAD tmpdir
+  return $ CabalHEAD (commit, csdir)
 
 data UnpackCabalVariant = Pristine | LatestRevision
 newtype CabalSourceDir = CabalSourceDir { unCabalSourceDir :: FilePath }
-unpackCabal
+unpackCabalHackage
     :: (Verbose, Progs)
     => Version
     -> FilePath
     -> UnpackCabalVariant
     -> IO CabalSourceDir
-unpackCabal cabalVer tmpdir variant = do
+unpackCabalHackage cabalVer tmpdir variant = do
   let cabal = "Cabal-" ++ showVersion cabalVer
       dir = tmpdir </> cabal
       variant_opts = case variant of Pristine -> [ "--pristine" ]; _ -> []
@@ -147,14 +178,14 @@ unpackCabal cabalVer tmpdir variant = do
   callProcessStderr (Just tmpdir) (cabalProgram ?progs) args
   return $ CabalSourceDir dir
 
-unpackCabalHEAD :: Env => FilePath -> IO (CabalSourceDir, CommitId)
+unpackCabalHEAD :: Env => FilePath -> IO (CommitId, CabalSourceDir)
 unpackCabalHEAD tmpdir = do
   let dir = tmpdir </> "cabal-head.git"
       url = "https://github.com/haskell/cabal.git"
   ExitSuccess <- rawSystem "git" [ "clone", "--depth=1", url, dir]
   commit <-
       withDirectory_ dir $ trim <$> readProcess' "git" ["rev-parse", "HEAD"] ""
-  return (CabalSourceDir $ dir </> "Cabal", CommitId commit)
+  return (CommitId commit, CabalSourceDir $ dir </> "Cabal")
  where
    withDirectory_ :: FilePath -> IO a -> IO a
    withDirectory_ dir action =
@@ -163,6 +194,14 @@ unpackCabalHEAD tmpdir = do
          (liftIO . setCurrentDirectory)
          (\_ -> liftIO (setCurrentDirectory dir) >> action)
 
+resolveCabalVersion :: Verbose => CabalVersion -> IO ResolvedCabalVersion
+resolveCabalVersion (CabalVersion ver) = return $ CabalVersion ver
+resolveCabalVersion (CabalHEAD ()) = do
+  out <- readProcess' "git"
+    [ "ls-remote", "https://github.com/haskell/cabal.git", "-h", "master" ] ""
+  let commit = takeWhile isHexDigit out
+  return $ CabalHEAD $ CommitId commit
+
 findCabalFile :: FilePath -> IO FilePath
 findCabalFile pkgdir = do
     [cfile] <- filter isCabalFile <$> getDirectoryContents pkgdir
diff --git a/src/CabalHelper/Compiletime/Compile.hs b/src/CabalHelper/Compiletime/Compile.hs
index 2f4b0a9..78c052e 100644
--- a/src/CabalHelper/Compiletime/Compile.hs
+++ b/src/CabalHelper/Compiletime/Compile.hs
@@ -43,6 +43,7 @@ import System.Directory
 import System.FilePath
 import System.Exit
 import System.IO
+import System.IO.Temp
 import Prelude
 
 import qualified Data.Text as Text
@@ -64,15 +65,17 @@ import CabalHelper.Compiletime.Types
 
 import CabalHelper.Shared.Common
 
+import Paths_cabal_helper (version)
+
+
 data Compile
     = CompileWithCabalSource
       { compCabalSourceDir     :: CabalSourceDir
       , compCabalSourceVersion :: Version
       }
     | CompileWithCabalPackage
-      { compPackageDb      :: Maybe PackageDbDir
-      , compCabalVersion   :: CabalVersion
-      , compPackageDeps    :: [String]
+      { compPackageSource  :: GhcPackageSource
+      , compCabalVersion   :: ResolvedCabalVersion
       , compProductTarget  :: CompilationProductScope
       }
 
@@ -88,100 +91,170 @@ data CompPaths = CompPaths
 -- executable.
 data CompilationProductScope = CPSGlobal | CPSProject
 
-data CompHelperEnv = CompHelperEnv
-  { cheCabalVer :: Version
-  , chePkgDb    :: Maybe PackageDbDir
-  , cheProjDir  :: FilePath
-  , cheNewstyle :: Maybe (PlanJson, FilePath)
-  , cheCacheDir :: FilePath
+type CompHelperEnv = CompHelperEnv' CabalVersion
+data CompHelperEnv' cv = CompHelperEnv
+  { cheCabalVer :: !cv
+  , chePkgDb    :: !(Maybe PackageDbDir)
+  -- ^ A package-db where we are guaranteed to find Cabal-`cheCabalVer`.
+  , cheProjDir  :: !FilePath
+  , chePlanJson :: !(Maybe PlanJson)
+  , cheDistV2   :: !(Maybe FilePath)
+  , cheProjLocalCacheDir :: FilePath
   }
 
-compileHelper :: Env => CompHelperEnv -> IO (Either ExitCode FilePath)
-compileHelper CompHelperEnv{..}   = do
-    ghcVer <- ghcVersion
-    Just (prepare, comp) <- runMaybeT $ msum $
-      case chePkgDb of
-        Nothing ->
-          [ compileCabalSource
-          , compileNewBuild ghcVer
-          , compileSandbox ghcVer
-          , compileGlobal
-          , MaybeT $ Just <$> compileWithCabalInPrivatePkgDb
-          ]
-        Just db ->
-          [ pure $ (pure (), compileWithPkg (Just db) cheCabalVer CPSProject)
-          ]
-
-    appdir <- appCacheDir
-
-    let cp@CompPaths {compExePath} = compPaths appdir cheCacheDir comp
-    exists <- doesFileExist compExePath
-    if exists
-      then do
-        vLog $ "helper already compiled, using exe: "++compExePath
-        return (Right compExePath)
-      else do
-        vLog $ "helper exe does not exist, compiling "++compExePath
-        prepare >> compile comp cp
+compileHelper
+    :: Env => CompHelperEnv -> IO (Either ExitCode FilePath)
+compileHelper che@CompHelperEnv {cheCabalVer} = do
+  withSystemTempDirectory "cabal-helper.compile-tmp" $ \tmpdir -> do
+    ucv <- unpackCabal cheCabalVer tmpdir
+    compileHelper' che { cheCabalVer = ucv }
+
+compileHelper'
+    :: Env
+    => CompHelperEnv' UnpackedCabalVersion
+    -> IO (Either ExitCode FilePath)
+compileHelper' CompHelperEnv {..} = do
+  ghcVer <- ghcVersion
+  Just (prepare, comp) <- case cheCabalVer of
+    cabalVer@CabalHEAD {} -> do
+      Just <$> compileWithCabalInPrivatePkgDb' ghcVer cabalVer
+    CabalVersion cabalVerPlain -> do
+      runMaybeT $ msum $ map (\f -> f ghcVer cabalVerPlain) $
+        case chePkgDb of
+          Nothing ->
+            [ compileWithCabalV2Inplace
+            , compileWithCabalV2GhcEnv
+            , compileCabalSource
+            , compileSandbox
+            , compileGlobal
+            , compileWithCabalInPrivatePkgDb
+            ]
+          Just db ->
+            [ ((.).(.)) liftIO (compilePkgDb db)
+            ]
+  appdir <- appCacheDir
+  let cp@CompPaths {compExePath} = compPaths appdir cheProjLocalCacheDir comp
+  helper_exists <- doesFileExist compExePath
+  rv <- if helper_exists
+    then do
+      vLog $ "helper already compiled, using exe: "++compExePath
+      return (Right compExePath)
+    else do
+      vLog $ "helper exe does not exist, compiling "++compExePath
+      prepare >> compile cp comp
+
+  return rv
+
 
   where
    logMsg = "using helper compiled with Cabal from "
 
 -- for relaxed deps: find (sameMajorVersionAs cheCabalVer) . reverse . sort
 
+   compilePkgDb db _ghcVer cabalVer  = return $
+       (,)
+         (pure ())
+         CompileWithCabalPackage
+           { compPackageSource = GPSPackageDBs [db]
+           , compCabalVersion  = CabalVersion cabalVer
+           , compProductTarget = CPSProject
+           }
+
    -- | Check if this version is globally available
-   compileGlobal :: Env => MaybeT IO (IO (), Compile)
-   compileGlobal = do
+   compileGlobal :: Env => gv -> Version -> MaybeT IO (IO (), Compile)
+   compileGlobal _ghcVer cabalVer = do
        cabal_versions <- listCabalVersions Nothing
-       ver <- MaybeT $ return $ find (== cheCabalVer) cabal_versions
+       _ <- MaybeT $ return $ find (== cabalVer) cabal_versions
        vLog $ logMsg ++ "user/global package-db"
-       return $ (return (), compileWithPkg Nothing ver CPSGlobal)
+       return $ (return (), compileWithPkg GPSAmbient cabalVer CPSGlobal)
 
    -- | Check if this version is available in the project sandbox
-   compileSandbox :: Env => Version -> MaybeT IO (IO (), Compile)
-   compileSandbox ghcVer = do
+   compileSandbox :: Env => GhcVersion -> Version -> MaybeT IO (IO (), Compile)
+   compileSandbox  ghcVer cabalVer = do
        let mdb_path = getSandboxPkgDb (display buildPlatform) ghcVer cheProjDir
        sandbox <- PackageDbDir <$> MaybeT mdb_path
        cabal_versions <- listCabalVersions (Just sandbox)
-       ver <- MaybeT $ return $ find (== cheCabalVer) cabal_versions
+       _ <- MaybeT $ return $ find (== cabalVer) cabal_versions
        vLog $ logMsg ++ "sandbox package-db"
-       return $ (return (), compileWithPkg (Just sandbox) ver CPSProject)
-
-   compileNewBuild :: Env => Version -> MaybeT IO (IO (), Compile)
-   compileNewBuild ghcVer = do
-       (PlanJson {pjUnits}, distdir_newstyle) <- maybe mzero pure cheNewstyle
+       return $ (return (), compileWithPkg (GPSPackageDBs [sandbox]) cabalVer CPSProject)
+
+   -- | Check if the requested Cabal version is available in a v2-build
+   -- project's inplace package-db.
+   --
+   -- This is likely only the case if Cabal was vendored by this project or if
+   -- we're operating on Cabal itself!
+   compileWithCabalV2Inplace :: Env => GhcVersion -> Version -> MaybeT IO (IO (), Compile)
+   compileWithCabalV2Inplace ghcVer cabalVer = do
+       PlanJson {pjUnits} <- maybe mzero pure chePlanJson
+       distdir_newstyle   <- maybe mzero pure cheDistV2
        let cabal_pkgid =
-               PkgId (PkgName (Text.pack "Cabal"))
-                        (Ver $ versionBranch cheCabalVer)
+             PkgId (PkgName (Text.pack "Cabal")) (Ver $ versionBranch cabalVer)
            mcabal_unit = listToMaybe $
              Map.elems $ Map.filter (\CP.Unit{..} -> uPId == cabal_pkgid) pjUnits
        CP.Unit {} <- maybe mzero pure mcabal_unit
        let inplace_db_path = distdir_newstyle
-             </> "packagedb" </> ("ghc-" ++ showVersion ghcVer)
+             </> "packagedb" </> ("ghc-" ++ showGhcVersion ghcVer)
            inplace_db = PackageDbDir inplace_db_path
        cabal_versions <- listCabalVersions (Just inplace_db)
-       ver <- MaybeT $ return $ find (== cheCabalVer) cabal_versions
+       _ <- MaybeT $ return $ find (== cabalVer) cabal_versions
        vLog $ logMsg ++ "v2-build package-db " ++ inplace_db_path
-       return $ (return (), compileWithPkg (Just inplace_db) ver CPSProject)
+       return $ (return (), compileWithPkg (GPSPackageDBs [inplace_db]) cabalVer CPSProject)
+
+   -- | If this is a v2-build project it makes sense to use @v2-install@ for
+   -- installing Cabal as this will use the @~/.cabal/store@. We use
+   -- @--package-env@ to instruct cabal to not meddle with the user's package
+   -- environment.
+   compileWithCabalV2GhcEnv :: Env => GhcVersion -> Version -> MaybeT IO (IO (), Compile)
+   compileWithCabalV2GhcEnv ghcVer cabalVer = do
+       _ <- maybe mzero pure cheDistV2 -- bail if this isn't a v2-build project
+       CabalInstallVersion instVer <- liftIO cabalInstallVersion
+       guard $ instVer >= (Version [2,4,1,0] [])
+       --  ^ didn't test with older versions
+       env@(PackageEnvFile env_file)
+           <- liftIO $ getPrivateCabalPkgEnv ghcVer cabalVer
+       vLog $ logMsg ++ "v2-build package-env " ++ env_file
+       return $ (prepare env, compileWithPkg (GPSPackageEnv env) cabalVer CPSGlobal)
+     where
+       prepare env = do
+         -- exists_in_env <- liftIO $ cabalVersionExistsInPkgDb cheCabalVer db
+         void $ installCabalLibV2 ghcVer cheCabalVer env `E.catch`
+           \(SomeException _) ->
+               case cheCabalVer of
+                 CabalHEAD _ -> panicIO "Installing Cabal HEAD failed."
+                 CabalVersion ver -> errorInstallCabal (CabalVersion ver)
+
+
+
+   compileWithCabalInPrivatePkgDb
+       :: (Env, MonadIO m) => GhcVersion -> Version -> m (IO (), Compile)
+   compileWithCabalInPrivatePkgDb ghcVer cabalVer =
+       liftIO $ compileWithCabalInPrivatePkgDb' ghcVer (CabalVersion cabalVer)
 
    -- | Compile the requested Cabal version into an isolated package-db if it's
    -- not there already
-   compileWithCabalInPrivatePkgDb :: Env => IO (IO (), Compile)
-   compileWithCabalInPrivatePkgDb = do
+   compileWithCabalInPrivatePkgDb'
+       :: Env => GhcVersion -> UnpackedCabalVersion -> IO (IO (), Compile)
+   compileWithCabalInPrivatePkgDb' ghcVer cabalVer = do
        db@(PackageDbDir db_path)
-           <- getPrivateCabalPkgDb (CabalVersion cheCabalVer)
+           <- getPrivateCabalPkgDb $ unpackedToResolvedCabalVersion cabalVer
        vLog $ logMsg ++ "private package-db in " ++ db_path
-       return (prepare db, compileWithPkg (Just db) cheCabalVer CPSGlobal)
+       return $ (,)
+         (prepare db)
+         CompileWithCabalPackage
+           { compPackageSource = GPSPackageDBs [db]
+           , compCabalVersion  = unpackedToResolvedCabalVersion cabalVer
+           , compProductTarget = CPSGlobal
+           }
      where
        prepare db = do
-         db_exists <- liftIO $ cabalVersionExistsInPkgDb cheCabalVer db
+         db_exists <- liftIO $ cabalVersionExistsInPkgDb cabalVer db
          when (not db_exists) $
-           void $ installCabalLib (Right cheCabalVer) `E.catch`
-             \(SomeException _) -> errorInstallCabal cheCabalVer
+           void (installCabalLibV1 ghcVer cabalVer) `E.catch`
+             \(SomeException _) -> errorInstallCabal cabalVer
 
    -- | See if we're in a cabal source tree
-   compileCabalSource :: Env => MaybeT IO (IO (), Compile)
-   compileCabalSource = do
+--   compileCabalSource :: Env => MaybeT IO (IO (), Compile)
+   compileCabalSource _ghcVer _cabalVer = do
        let cabalFile = cheProjDir </> "Cabal.cabal"
        cabalSrc <- liftIO $ doesFileExist cabalFile
        let projdir = CabalSourceDir cheProjDir
@@ -208,18 +281,15 @@ compileHelper CompHelperEnv{..}   = do
           , compCabalSourceVersion   = ver
           }
 
-   compileWithPkg mdb ver target =
+   compileWithPkg pkg_src ver target =
        CompileWithCabalPackage
-          { compPackageDb            = mdb
+          { compPackageSource        = pkg_src
           , compCabalVersion         = CabalVersion ver
-          , compPackageDeps          = [cabalPkgId ver]
           , compProductTarget        = target
           }
 
-   cabalPkgId v = "Cabal-" ++ showVersion v
-
-compile :: Env => Compile -> CompPaths -> IO (Either ExitCode FilePath)
-compile comp paths@CompPaths {..} = do
+compile :: Env => CompPaths -> Compile -> IO (Either ExitCode FilePath)
+compile paths@CompPaths {..} comp = do
     createDirectoryIfMissing True compOutDir
     createHelperSources compBuildDir
 
@@ -230,30 +300,45 @@ compile comp paths@CompPaths {..} = do
     invokeGhc $ compGhcInvocation comp paths
 
 compPaths :: FilePath -> FilePath -> Compile -> CompPaths
-compPaths appdir cachedir c =
-    case c of
-      CompileWithCabalPackage {compProductTarget=CPSGlobal,..} -> CompPaths {..}
+compPaths appdir proj_local_cachedir c =
+  case c of
+    CompileWithCabalPackage
+      { compProductTarget=CPSGlobal
+      , compCabalVersion
+      } -> CompPaths {..}
         where
-          compBuildDir = appdir </> exeName compCabalVersion ++ "--" ++ sourceHash <.> "build"
+          compBuildDir =
+            appdir </> exeName compCabalVersion ++ "--" ++ sourceHash <.> "build"
           compOutDir  = compBuildDir
           compExePath = compBuildDir </> "cabal-helper"
-
-      CompileWithCabalPackage {compProductTarget=CPSProject,..} -> cachedirPaths
-      CompileWithCabalSource {..} -> cachedirPaths
+    CompileWithCabalPackage {compProductTarget=CPSProject} ->
+        projLocalCachedirPaths
+    CompileWithCabalSource {} ->
+        projLocalCachedirPaths
   where
-    cachedirPaths = CompPaths {..}
+    projLocalCachedirPaths = CompPaths {..}
         where
-          compBuildDir = cachedir </> "cabal-helper"
+          compBuildDir = proj_local_cachedir </> "cabal-helper"
           compOutDir  = compBuildDir
           compExePath = compOutDir </> "cabal-helper"
 
+exeName :: ResolvedCabalVersion -> String
+exeName (CabalHEAD commitid) = intercalate "--"
+  [ "cabal-helper-" ++ showVersion version
+  , "Cabal-HEAD" ++ unCommitId commitid
+  ]
+exeName CabalVersion {cvVersion} = intercalate "--"
+  [ "cabal-helper-" ++ showVersion version
+  , "Cabal-" ++ showVersion cvVersion
+  ]
+
 compGhcInvocation :: Compile -> CompPaths -> GhcInvocation
 compGhcInvocation comp CompPaths {..} =
     case comp of
       CompileWithCabalSource {..} ->
         GhcInvocation
           { giIncludeDirs = [compBuildDir, unCabalSourceDir compCabalSourceDir]
-          , giPackageDBs  = []
+          , giPackageSource = GPSAmbient
           , giHideAllPackages = False
           , giPackages    = []
           , giCPPOptions = cppOptions compCabalSourceVersion
@@ -263,7 +348,7 @@ compGhcInvocation comp CompPaths {..} =
       CompileWithCabalPackage {..} ->
         GhcInvocation
           { giIncludeDirs = [compBuildDir]
-          , giPackageDBs = maybeToList compPackageDb
+          , giPackageSource = compPackageSource
           , giHideAllPackages = True
           , giPackages =
               [ "base"
@@ -273,7 +358,10 @@ compGhcInvocation comp CompPaths {..} =
               , "process"
               , "bytestring"
               , "ghc-prim"
-              ] ++ compPackageDeps
+              , case compCabalVersion of
+                  CabalHEAD {} -> "Cabal"
+                  CabalVersion ver -> "Cabal-" ++ showVersion ver
+              ]
           , giCPPOptions = cppOptions (unCabalVersion compCabalVersion)
           , ..
           }
@@ -319,9 +407,11 @@ Otherwise we might be able to use the shipped Setup.hs
 
 -}
 
-errorInstallCabal :: Version -> IO a
-errorInstallCabal cabalVer = panicIO $ printf "\
-\Installing Cabal version %s failed.\n\
+errorInstallCabal :: CabalVersion' a -> IO b
+errorInstallCabal (CabalHEAD _) =
+  error "cabal-helper: Installing Cabal HEAD failed."
+errorInstallCabal (CabalVersion cabalVer) = panicIO $ printf "\
+\cabal-helper: Installing Cabal version %s failed.\n\
 \\n\
 \You have the following choices to fix this:\n\
 \\n\
diff --git a/src/CabalHelper/Compiletime/Program/CabalInstall.hs b/src/CabalHelper/Compiletime/Program/CabalInstall.hs
index afc3f1a..49bc7f2 100644
--- a/src/CabalHelper/Compiletime/Program/CabalInstall.hs
+++ b/src/CabalHelper/Compiletime/Program/CabalInstall.hs
@@ -25,7 +25,6 @@ License     : GPL-3
 module CabalHelper.Compiletime.Program.CabalInstall where
 
 import qualified Cabal.Plan as CP
-import Control.Arrow
 import Control.Monad
 import Data.Coerce
 import Data.Either
@@ -33,6 +32,7 @@ import Data.Maybe
 import Data.Version
 import System.IO
 import System.IO.Temp
+import System.Directory
 import System.Environment
 import System.FilePath
 import Text.Printf
@@ -45,9 +45,9 @@ import qualified Data.Text as Text
 import qualified CabalHelper.Compiletime.Cabal as Cabal
 import CabalHelper.Compiletime.Types
 import CabalHelper.Compiletime.Program.GHC
-  ( ghcVersion, createPkgDb )
+  ( GhcVersion(..), createPkgDb )
 import CabalHelper.Compiletime.Cabal
-  ( CabalSourceDir(..), CabalVersion(..), unpackCabalHEAD, unpackPatchedCabal )
+  ( CabalSourceDir(..), UnpackedCabalVersion, CabalVersion'(..), unpackCabalV1 )
 import CabalHelper.Compiletime.Process
 import CabalHelper.Shared.Common
   ( parseVer, trim, appCacheDir, panicIO )
@@ -61,10 +61,11 @@ cabalInstallVersion = do
   CabalInstallVersion . parseVer . trim
     <$> readProcess' (cabalProgram ?progs) ["--numeric-version"] ""
 
-installCabalLib :: Env => Either HEAD Version -> IO (PackageDbDir, CabalVersion)
-installCabalLib ever = do
+installCabalLibV1 :: Env => GhcVersion -> UnpackedCabalVersion -> IO PackageDbDir
+installCabalLibV1 ghcVer cabalVer = do
   appdir <- appCacheDir
-  let message ver = do
+  let message (CabalHEAD {}) = return ()
+      message (CabalVersion ver) = do
       let sver = showVersion ver
       hPutStr stderr $ printf "\
 \cabal-helper: Installing a private copy of Cabal because we couldn't\n\
@@ -79,23 +80,29 @@ installCabalLib ever = do
 \    $ cabal install Cabal --constraint \"Cabal == %s\"\n\
 \\n\
 \Installing Cabal %s ...\n" appdir sver sver sver
-  withSystemTempDirectory "cabal-helper-Cabal-source" $ \tmpdir -> do
-    (srcdir, cabalVer) <- case ever of
-      Left HEAD -> do
-        second CabalHEAD <$> unpackCabalHEAD tmpdir
-      Right ver -> do
-        message ver
-        (,) <$> unpackPatchedCabal ver tmpdir <*> pure (CabalVersion ver)
+  withSystemTempDirectory "cabal-helper.install-cabal-tmp" $ \tmpdir -> do
+    message cabalVer
+    srcdir <- unpackCabalV1 cabalVer tmpdir
 
     db <- createPkgDb cabalVer
 
-    callCabalInstall db srcdir ever
+    callCabalInstall db srcdir ghcVer cabalVer
 
-    return (db, cabalVer)
+    return db
 
 callCabalInstall
-    :: Env => PackageDbDir -> CabalSourceDir -> Either HEAD Version-> IO ()
-callCabalInstall (PackageDbDir db) (CabalSourceDir srcdir) ever = do
+    :: Env
+    => PackageDbDir
+    -> CabalSourceDir
+    -> GhcVersion
+    -> UnpackedCabalVersion
+    -> IO ()
+callCabalInstall
+  (PackageDbDir db)
+  (CabalSourceDir srcdir)
+  ghcVer
+  unpackedCabalVer
+  = do
   civ@CabalInstallVersion {..} <- cabalInstallVersion
   cabal_opts <- return $ concat
       [
@@ -117,30 +124,34 @@ callCabalInstall (PackageDbDir db) (CabalSourceDir srcdir) ever = do
 
   callProcessStderr (Just "/") (cabalProgram ?progs) cabal_opts
 
-  runSetupHs db srcdir ever civ
+  runSetupHs ghcVer db srcdir unpackedCabalVer civ
 
   hPutStrLn stderr "done"
 
 runSetupHs
     :: Env
-    => FilePath
+    => GhcVersion
+    -> FilePath
     -> FilePath
-    -> Either HEAD Version
+    -> UnpackedCabalVersion
     -> CabalInstallVersion
     -> IO ()
-runSetupHs db srcdir ever CabalInstallVersion {..}
+runSetupHs ghcVer db srcdir iCabalVer CabalInstallVersion {..}
     | cabalInstallVer >= parseVer "1.24" = do
       go $ \args -> callProcessStderr (Just srcdir) (cabalProgram ?progs) $
         [ "act-as-setup", "--" ] ++ args
     | otherwise = do
-      SetupProgram {..} <- compileSetupHs db srcdir
+      SetupProgram {..} <- compileSetupHs ghcVer db srcdir
       go $ callProcessStderr (Just srcdir) setupProgram
   where
     parmake_opt :: Maybe Int -> [String]
     parmake_opt nproc'
-        | Left _ <- ever = ["-j"++nproc]
-        | Right ver <- ever,  ver >= Version [1,20] [] = ["-j"++nproc]
-        | otherwise = []
+        | CabalHEAD _ <- iCabalVer =
+            ["-j"++nproc]
+        | CabalVersion ver <- iCabalVer,  ver >= Version [1,20] [] =
+            ["-j"++nproc]
+        | otherwise =
+            []
       where
         nproc = fromMaybe "" $ show <$> nproc'
     go :: ([String] -> IO ()) -> IO ()
@@ -153,12 +164,11 @@ runSetupHs db srcdir ever CabalInstallVersion {..}
       run [ "register" ]
 
 newtype SetupProgram = SetupProgram { setupProgram :: FilePath }
-compileSetupHs :: Env => FilePath -> FilePath -> IO SetupProgram
-compileSetupHs db srcdir = do
-  ver <- ghcVersion
+compileSetupHs :: Env => GhcVersion -> FilePath -> FilePath -> IO SetupProgram
+compileSetupHs (GhcVersion ghcVer) db srcdir = do
   let no_version_macros
-        | ver >= Version [8] [] = [ "-fno-version-macros" ]
-        | otherwise             = []
+        | ghcVer >= Version [8] [] = [ "-fno-version-macros" ]
+        | otherwise                = []
 
       file = srcdir </> "Setup"
 
@@ -183,6 +193,43 @@ cabalWithGHCProgOpts = concat
       else []
   ]
 
+installCabalLibV2 :: Env => GhcVersion -> UnpackedCabalVersion -> PackageEnvFile -> IO ()
+installCabalLibV2 _ (CabalHEAD _) _ = error "TODO: `installCabalLibV2 _ CabalHEAD _` is unimplemented"
+installCabalLibV2 _ghcVer (CabalVersion cabalVer) (PackageEnvFile env_file) = do
+  exists <- doesFileExist env_file
+  if exists
+    then return ()
+    else do
+    CabalInstallVersion {..} <- cabalInstallVersion
+    cabal_opts <- return $ concat
+        [ if cabalInstallVer >= Version [1,20] []
+             then ["--no-require-sandbox"]
+             else []
+        , [ if cabalInstallVer >= Version [2,4] []
+              then "v2-install"
+              else "new-install"
+          ]
+        , cabalV2WithGHCProgOpts
+        , [ "--package-env=" ++ env_file
+          , "--lib"
+          , "Cabal-"++showVersion cabalVer
+          ]
+        , if ?verbose
+            then ["-v"]
+            else []
+        ]
+    tmp <- getTemporaryDirectory
+    callProcessStderr (Just tmp) (cabalProgram ?progs) cabal_opts
+    hPutStrLn stderr "done"
+
+cabalV2WithGHCProgOpts :: Progs => [String]
+cabalV2WithGHCProgOpts = concat
+  [ [ "--with-compiler=" ++ ghcProgram ?cprogs ]
+  , if ghcPkgProgram ?cprogs /= ghcPkgProgram defaultCompPrograms
+      then error "cabalV2WithGHCProgOpts: ghc-pkg path was changed from default but cabal v2-install does not support passing --with-ghc-pkg!"
+      else []
+  ]
+
 planUnits :: CP.PlanJson -> IO [Unit 'V2]
 planUnits plan = do
     units <- fmap catMaybes $ mapM takeunit $ Map.elems $ CP.pjUnits plan
diff --git a/src/CabalHelper/Compiletime/Program/GHC.hs b/src/CabalHelper/Compiletime/Program/GHC.hs
index 8c77f62..4565a37 100644
--- a/src/CabalHelper/Compiletime/Program/GHC.hs
+++ b/src/CabalHelper/Compiletime/Program/GHC.hs
@@ -38,24 +38,35 @@ import CabalHelper.Shared.Common
   (parseVer, trim, appCacheDir, parsePkgId)
 import CabalHelper.Compiletime.Types
 import CabalHelper.Compiletime.Cabal
-  (CabalVersion(..), showCabalVersion)
+  ( ResolvedCabalVersion, showResolvedCabalVersion, UnpackedCabalVersion
+  , unpackedToResolvedCabalVersion, CabalVersion'(..) )
 import CabalHelper.Compiletime.Process
 import CabalHelper.Compiletime.Log
 
+data GhcPackageSource
+    = GPSAmbient
+    | GPSPackageDBs ![PackageDbDir]
+    | GPSPackageEnv !PackageEnvFile
+
 data GhcInvocation = GhcInvocation
     { giOutDir          :: FilePath
     , giOutput          :: FilePath
     , giCPPOptions      :: [String]
-    , giPackageDBs      :: [PackageDbDir]
     , giIncludeDirs     :: [FilePath]
     , giHideAllPackages :: Bool
     , giPackages        :: [String]
     , giWarningFlags    :: [String]
     , giInputs          :: [String]
+    , giPackageSource   :: !GhcPackageSource
     }
 
-ghcVersion :: (Verbose, CProgs) => IO Version
-ghcVersion =
+newtype GhcVersion = GhcVersion { unGhcVersion :: Version }
+
+showGhcVersion :: GhcVersion -> String
+showGhcVersion (GhcVersion v) = showVersion v
+
+ghcVersion :: (Verbose, CProgs) => IO GhcVersion
+ghcVersion = GhcVersion .
   parseVer . trim <$> readProcess' (ghcProgram ?cprogs) ["--numeric-version"] ""
 
 ghcPkgVersion :: (Verbose, CProgs) => IO Version
@@ -63,23 +74,33 @@ ghcPkgVersion =
   parseVer . trim . dropWhile (not . isDigit)
     <$> readProcess' (ghcPkgProgram ?cprogs) ["--version"] ""
 
-createPkgDb :: (Verbose, CProgs) => CabalVersion -> IO PackageDbDir
+createPkgDb :: (Verbose, CProgs) => UnpackedCabalVersion -> IO PackageDbDir
 createPkgDb cabalVer = do
-  db@(PackageDbDir db_path) <- getPrivateCabalPkgDb cabalVer
+  db@(PackageDbDir db_path)
+    <- getPrivateCabalPkgDb $ unpackedToResolvedCabalVersion cabalVer
   exists <- doesDirectoryExist db_path
   when (not exists) $
        callProcessStderr Nothing (ghcPkgProgram ?cprogs) ["init", db_path]
   return db
 
-getPrivateCabalPkgDb :: (Verbose, CProgs) => CabalVersion -> IO PackageDbDir
+getPrivateCabalPkgDb :: (Verbose, CProgs) => ResolvedCabalVersion -> IO PackageDbDir
 getPrivateCabalPkgDb cabalVer = do
   appdir <- appCacheDir
   ghcVer <- ghcVersion
   let db_path =
-        appdir </> "ghc-" ++ showVersion ghcVer ++ ".package-db"
-               </> "Cabal-" ++ showCabalVersion cabalVer
+        appdir </> "ghc-" ++ showGhcVersion ghcVer ++ ".package-dbs"
+               </> "Cabal-" ++ showResolvedCabalVersion cabalVer
   return $ PackageDbDir db_path
 
+getPrivateCabalPkgEnv
+    :: Verbose => GhcVersion -> Version -> IO PackageEnvFile
+getPrivateCabalPkgEnv ghcVer cabalVer = do
+  appdir <- appCacheDir
+  let env_path =
+        appdir </> "ghc-" ++ showGhcVersion ghcVer ++ ".package-envs"
+               </> "Cabal-" ++ showVersion cabalVer ++ ".package-env"
+  return $ PackageEnvFile env_path
+
 listCabalVersions
     :: (Verbose, Progs) => Maybe PackageDbDir -> MaybeT IO [Version]
 listCabalVersions mdb = do
@@ -95,14 +116,21 @@ listCabalVersions mdb = do
     _ -> mzero
 
 cabalVersionExistsInPkgDb
-    :: (Verbose, Progs) => Version -> PackageDbDir -> IO Bool
+    :: (Verbose, Progs) => CabalVersion' a -> PackageDbDir -> IO Bool
 cabalVersionExistsInPkgDb cabalVer db@(PackageDbDir db_path) = do
-  exists <- doesDirectoryExist db_path
-  case exists of
-    False -> return False
-    True -> fromMaybe False <$> runMaybeT (do
-      vers <- listCabalVersions (Just db)
-      return $ cabalVer `elem` vers)
+  fromMaybe False <$> runMaybeT (do
+    vers <- listCabalVersions (Just db)
+    return $
+      case (cabalVer, vers) of
+        (CabalVersion ver, _) -> ver `elem` vers
+        (CabalHEAD _, [_headver]) -> True
+        (CabalHEAD _, _) ->
+          error $ msg ++ db_path)
+  where
+    msg = "\
+\Multiple Cabal versions in a HEAD package-db!\n\
+\This shouldn't happen. However you can manually delete the following\n\
+\directory to resolve this:\n    "
 
 invokeGhc :: Env => GhcInvocation -> IO (Either ExitCode FilePath)
 invokeGhc GhcInvocation {..} = do
@@ -111,7 +139,10 @@ invokeGhc GhcInvocation {..} = do
         , "-o", giOutput
         ]
       , map ("-optP"++) giCPPOptions
-      , map ("-package-conf="++) $ unPackageDbDir <$> giPackageDBs
+      , case giPackageSource of
+          GPSAmbient -> []
+          GPSPackageDBs dbs -> map ("-package-conf="++) $ unPackageDbDir <$> dbs
+          GPSPackageEnv env -> [ "-package-env=" ++ unPackageEnvFile env ]
       , map ("-i"++) $ nub $ "" : giIncludeDirs
       , if giHideAllPackages then ["-hide-all-packages"] else []
       , concatMap (\p -> ["-package", p]) giPackages
diff --git a/src/CabalHelper/Compiletime/Sandbox.hs b/src/CabalHelper/Compiletime/Sandbox.hs
index 5af226a..7a757c4 100644
--- a/src/CabalHelper/Compiletime/Sandbox.hs
+++ b/src/CabalHelper/Compiletime/Sandbox.hs
@@ -33,11 +33,13 @@ import Prelude
 import qualified Data.Traversable as T
 
 import CabalHelper.Shared.Common
+import CabalHelper.Compiletime.Program.GHC
+    ( GhcVersion (..), showGhcVersion )
 
 -- | Get the path to the sandbox package-db in a project
 getSandboxPkgDb :: String
              -- ^ Cabal build platform, i.e. @buildPlatform@
-             -> Version
+             -> GhcVersion
              -- ^ GHC version (@cProjectVersion@ is your friend)
              -> FilePath
              -- ^ Path to the cabal package root directory (containing the
@@ -54,9 +56,9 @@ getSandboxPkgDb platform ghcVer projdir = do
          True -> dir
          False -> takeDirectory dir </> ghcSandboxPkgDbDir platform ghcVer
 
-ghcSandboxPkgDbDir :: String -> Version -> String
+ghcSandboxPkgDbDir :: String -> GhcVersion -> String
 ghcSandboxPkgDbDir platform ghcVer =
-   platform ++ "-ghc-" ++ showVersion ghcVer ++ "-packages.conf.d"
+   platform ++ "-ghc-" ++ showGhcVersion ghcVer ++ "-packages.conf.d"
 
 -- | Extract the sandbox package db directory from the cabal.sandbox.config
 -- file. Exception is thrown if the sandbox config file is broken.
diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs
index 60b0f4d..491c205 100644
--- a/src/CabalHelper/Compiletime/Types.hs
+++ b/src/CabalHelper/Compiletime/Types.hs
@@ -301,3 +301,4 @@ defaultCompileOptions =
     CompileOptions False Nothing Nothing defaultPrograms
 
 newtype PackageDbDir = PackageDbDir { unPackageDbDir :: FilePath }
+newtype PackageEnvFile = PackageEnvFile { unPackageEnvFile :: FilePath }