aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/CabalHelper/Compiletime/Cabal.hs83
-rw-r--r--src/CabalHelper/Compiletime/Compile.hs258
-rw-r--r--src/CabalHelper/Compiletime/Program/CabalInstall.hs107
-rw-r--r--src/CabalHelper/Compiletime/Program/GHC.hs65
-rw-r--r--src/CabalHelper/Compiletime/Sandbox.hs8
-rw-r--r--src/CabalHelper/Compiletime/Types.hs1
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 }
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-10 22:58:28 +0000