Skip to content

Commit af3645e

Browse files
solsol
committed
Include the GHC "Project Unit Id" in the cabal store path
- This allows the use of several **API incompatible builds of the same version of GHC** without corrupting the cabal store. - This relies on the "Project Unit Id" which is available since GHC 9.8.1, older versions of GHC do not benefit from this change. [fixes #8114]
1 parent 2794dd8 commit af3645e

File tree

9 files changed

+169
-131
lines changed

9 files changed

+169
-131
lines changed

‎Cabal/src/Distribution/Simple/GHC.hs‎

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE CPP #-}
22
{-# LANGUAGE FlexibleContexts #-}
33
{-# LANGUAGE MultiWayIf #-}
4+
{-# LANGUAGE NamedFieldPuns #-}
45
{-# LANGUAGE RankNTypes #-}
56
{-# LANGUAGE TupleSections #-}
67

@@ -83,6 +84,7 @@ import Prelude ()
8384

8485
import Control.Monad (forM_, msum)
8586
import Data.Char (isLower)
87+
import Data.List (stripPrefix)
8688
import qualified Data.Map as Map
8789
import Distribution.CabalSpecVersion
8890
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
@@ -246,10 +248,16 @@ configure verbosity hcPath hcPkgPath conf0 = do
246248

247249
filterExt ext = filter ((/= EnableExtension ext) . fst)
248250

251+
compilerId :: CompilerId
252+
compilerId = CompilerId GHC ghcVersion
253+
254+
compilerAbiTag :: AbiTag
255+
compilerAbiTag = maybe NoAbiTag AbiTag (Map.lookup "Project Unit Id" ghcInfoMap >>= stripPrefix (prettyShow compilerId <> "-"))
256+
249257
let comp =
250258
Compiler
251-
{ compilerId = CompilerId GHC ghcVersion
252-
, compilerAbiTag = NoAbiTag
259+
{ compilerId
260+
, compilerAbiTag
253261
, compilerCompat = []
254262
, compilerLanguages = languages
255263
, compilerExtensions = extensions

‎cabal-install/src/Distribution/Client/CmdHaddockProject.hs‎

Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -54,9 +54,6 @@ import Distribution.Client.TargetProblem (TargetProblem (..))
5454
import Distribution.Simple.Command
5555
( CommandUI (..)
5656
)
57-
import Distribution.Simple.Compiler
58-
( Compiler (..)
59-
)
6057
import Distribution.Simple.Flag
6158
( Flag (..)
6259
, fromFlag
@@ -318,7 +315,7 @@ haddockProjectAction flags _extraArgs globalFlags = do
318315
packageDir =
319316
storePackageDirectory
320317
(cabalStoreDirLayout cabalLayout)
321-
(compilerId (pkgConfigCompiler sharedConfig'))
318+
(pkgConfigCompiler sharedConfig')
322319
(elabUnitId package)
323320
docDir = packageDir </> "share" </> "doc" </> "html"
324321
destDir = outputDir </> packageName

‎cabal-install/src/Distribution/Client/CmdInstall.hs‎

Lines changed: 6 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -484,8 +484,7 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt
484484

485485
-- progDb is a program database with compiler tools configured properly
486486
( compiler@Compiler
487-
{ compilerId =
488-
compilerId@(CompilerId compilerFlavor compilerVersion)
487+
{ compilerId = CompilerId compilerFlavor compilerVersion
489488
}
490489
, platform
491490
, progDb
@@ -498,7 +497,7 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt
498497
envFile <- getEnvFile clientInstallFlags platform compilerVersion
499498
existingEnvEntries <-
500499
getExistingEnvEntries verbosity compilerFlavor supportsPkgEnvFiles envFile
501-
packageDbs <- getPackageDbStack compilerId projectConfigStoreDir projectConfigLogsDir
500+
packageDbs <- getPackageDbStack compiler projectConfigStoreDir projectConfigLogsDir
502501
installedIndex <- getInstalledPackages verbosity compiler packageDbs progDb
503502

504503
let
@@ -824,7 +823,7 @@ installExes
824823
mkUnitBinDir :: UnitId -> FilePath
825824
mkUnitBinDir =
826825
InstallDirs.bindir
827-
. storePackageInstallDirs' storeDirLayout (compilerId compiler)
826+
. storePackageInstallDirs' storeDirLayout compiler
828827

829828
mkExeName :: UnqualComponentName -> FilePath
830829
mkExeName exe = unUnqualComponentName exe <.> exeExtension platform
@@ -1204,16 +1203,16 @@ getLocalEnv dir platform compilerVersion =
12041203
<> ghcPlatformAndVersionString platform compilerVersion
12051204

12061205
getPackageDbStack
1207-
:: CompilerId
1206+
:: Compiler
12081207
-> Flag FilePath
12091208
-> Flag FilePath
12101209
-> IO PackageDBStack
1211-
getPackageDbStack compilerId storeDirFlag logsDirFlag = do
1210+
getPackageDbStack compiler storeDirFlag logsDirFlag = do
12121211
mstoreDir <- traverse makeAbsolute $ flagToMaybe storeDirFlag
12131212
let
12141213
mlogsDir = flagToMaybe logsDirFlag
12151214
cabalLayout <- mkCabalDirLayout mstoreDir mlogsDir
1216-
pure $ storePackageDBStack (cabalStoreDirLayout cabalLayout) compilerId
1215+
pure $ storePackageDBStack (cabalStoreDirLayout cabalLayout) compiler
12171216

12181217
-- | This defines what a 'TargetSelector' means for the @bench@ command.
12191218
-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,

‎cabal-install/src/Distribution/Client/DistDirLayout.hs‎

Lines changed: 38 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,8 @@ import Distribution.Package
4141
, UnitId
4242
)
4343
import Distribution.Simple.Compiler
44-
( OptimisationLevel (..)
44+
( Compiler (..)
45+
, OptimisationLevel (..)
4546
, PackageDB (..)
4647
, PackageDBStack
4748
)
@@ -116,13 +117,13 @@ data DistDirLayout = DistDirLayout
116117

117118
-- | The layout of a cabal nix-style store.
118119
data StoreDirLayout = StoreDirLayout
119-
{ storeDirectory :: CompilerId -> FilePath
120-
, storePackageDirectory :: CompilerId -> UnitId -> FilePath
121-
, storePackageDBPath :: CompilerId -> FilePath
122-
, storePackageDB :: CompilerId -> PackageDB
123-
, storePackageDBStack :: CompilerId -> PackageDBStack
124-
, storeIncomingDirectory :: CompilerId -> FilePath
125-
, storeIncomingLock :: CompilerId -> UnitId -> FilePath
120+
{ storeDirectory :: Compiler -> FilePath
121+
, storePackageDirectory :: Compiler -> UnitId -> FilePath
122+
, storePackageDBPath :: Compiler -> FilePath
123+
, storePackageDB :: Compiler -> PackageDB
124+
, storePackageDBStack :: Compiler -> PackageDBStack
125+
, storeIncomingDirectory :: Compiler -> FilePath
126+
, storeIncomingLock :: Compiler -> UnitId -> FilePath
126127
}
127128

128129
-- TODO: move to another module, e.g. CabalDirLayout?
@@ -267,33 +268,35 @@ defaultStoreDirLayout :: FilePath -> StoreDirLayout
267268
defaultStoreDirLayout storeRoot =
268269
StoreDirLayout{..}
269270
where
270-
storeDirectory :: CompilerId -> FilePath
271-
storeDirectory compid =
272-
storeRoot </> prettyShow compid
273-
274-
storePackageDirectory :: CompilerId -> UnitId -> FilePath
275-
storePackageDirectory compid ipkgid =
276-
storeDirectory compid </> prettyShow ipkgid
277-
278-
storePackageDBPath :: CompilerId -> FilePath
279-
storePackageDBPath compid =
280-
storeDirectory compid </> "package.db"
281-
282-
storePackageDB :: CompilerId -> PackageDB
283-
storePackageDB compid =
284-
SpecificPackageDB (storePackageDBPath compid)
285-
286-
storePackageDBStack :: CompilerId -> PackageDBStack
287-
storePackageDBStack compid =
288-
[GlobalPackageDB, storePackageDB compid]
289-
290-
storeIncomingDirectory :: CompilerId -> FilePath
291-
storeIncomingDirectory compid =
292-
storeDirectory compid </> "incoming"
293-
294-
storeIncomingLock :: CompilerId -> UnitId -> FilePath
295-
storeIncomingLock compid unitid =
296-
storeIncomingDirectory compid </> prettyShow unitid <.> "lock"
271+
storeDirectory :: Compiler -> FilePath
272+
storeDirectory compiler =
273+
storeRoot </> case compilerAbiTag compiler of
274+
NoAbiTag -> prettyShow (compilerId compiler)
275+
AbiTag tag -> prettyShow (compilerId compiler) <> "-" <> tag
276+
277+
storePackageDirectory :: Compiler -> UnitId -> FilePath
278+
storePackageDirectory compiler ipkgid =
279+
storeDirectory compiler </> prettyShow ipkgid
280+
281+
storePackageDBPath :: Compiler -> FilePath
282+
storePackageDBPath compiler =
283+
storeDirectory compiler </> "package.db"
284+
285+
storePackageDB :: Compiler -> PackageDB
286+
storePackageDB compiler =
287+
SpecificPackageDB (storePackageDBPath compiler)
288+
289+
storePackageDBStack :: Compiler -> PackageDBStack
290+
storePackageDBStack compiler =
291+
[GlobalPackageDB, storePackageDB compiler]
292+
293+
storeIncomingDirectory :: Compiler -> FilePath
294+
storeIncomingDirectory compiler =
295+
storeDirectory compiler </> "incoming"
296+
297+
storeIncomingLock :: Compiler -> UnitId -> FilePath
298+
storeIncomingLock compiler unitid =
299+
storeIncomingDirectory compiler </> prettyShow unitid <.> "lock"
297300

298301
defaultCabalDirLayout :: IO CabalDirLayout
299302
defaultCabalDirLayout =

‎cabal-install/src/Distribution/Client/ProjectBuilding.hs‎

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -98,7 +98,6 @@ import Distribution.Simple.Command (CommandUI)
9898
import Distribution.Simple.Compiler
9999
( Compiler
100100
, PackageDB (..)
101-
, compilerId
102101
, jsemSupported
103102
)
104103
import qualified Distribution.Simple.InstallDirs as InstallDirs
@@ -1280,15 +1279,15 @@ buildAndInstallUnpackedPackage
12801279
let ipkg = ipkg0{Installed.installedUnitId = uid}
12811280
assert
12821281
( elabRegisterPackageDBStack pkg
1283-
== storePackageDBStack compid
1282+
== storePackageDBStack compiler
12841283
)
12851284
(return ())
12861285
criticalSection registerLock $
12871286
Cabal.registerPackage
12881287
verbosity
12891288
compiler
12901289
progdb
1291-
(storePackageDBStack compid)
1290+
(storePackageDBStack compiler)
12921291
ipkg
12931292
Cabal.defaultRegisterOptions
12941293
{ Cabal.registerMultiInstance = True
@@ -1300,7 +1299,7 @@ buildAndInstallUnpackedPackage
13001299
newStoreEntry
13011300
verbosity
13021301
storeDirLayout
1303-
compid
1302+
compiler
13041303
uid
13051304
copyPkgFiles
13061305
registerPkg
@@ -1330,7 +1329,6 @@ buildAndInstallUnpackedPackage
13301329
where
13311330
pkgid = packageId rpkg
13321331
uid = installedUnitId rpkg
1333-
compid = compilerId compiler
13341332

13351333
dispname :: String
13361334
dispname = case elabPkgOrComp pkg of

‎cabal-install/src/Distribution/Client/ProjectPlanning.hs‎

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -897,7 +897,7 @@ rebuildInstallPlan
897897
-> Rebuild ElaboratedInstallPlan
898898
phaseImprovePlan elaboratedPlan elaboratedShared = do
899899
liftIO $ debug verbosity "Improving the install plan..."
900-
storePkgIdSet <- getStoreEntries cabalStoreDirLayout compid
900+
storePkgIdSet <- getStoreEntries cabalStoreDirLayout compiler
901901
let improvedPlan =
902902
improveInstallPlanWithInstalledPackages
903903
storePkgIdSet
@@ -909,7 +909,7 @@ rebuildInstallPlan
909909
-- matches up as expected, e.g. no dangling deps, files deleted.
910910
return improvedPlan
911911
where
912-
compid = compilerId (pkgConfigCompiler elaboratedShared)
912+
compiler = pkgConfigCompiler elaboratedShared
913913

914914
-- | If a 'PackageSpecifier' refers to a single package, return Just that
915915
-- package.
@@ -2349,7 +2349,7 @@ elaborateInstallPlan
23492349

23502350
corePackageDbs =
23512351
applyPackageDbFlags
2352-
(storePackageDBStack (compilerId compiler))
2352+
(storePackageDBStack compiler)
23532353
(projectConfigPackageDBs sharedPackageConfig)
23542354

23552355
-- For this local build policy, every package that lives in a local source
@@ -4026,28 +4026,28 @@ userInstallDirTemplates compiler = do
40264026

40274027
storePackageInstallDirs
40284028
:: StoreDirLayout
4029-
-> CompilerId
4029+
-> Compiler
40304030
-> InstalledPackageId
40314031
-> InstallDirs.InstallDirs FilePath
4032-
storePackageInstallDirs storeDirLayout compid ipkgid =
4033-
storePackageInstallDirs' storeDirLayout compid $ newSimpleUnitId ipkgid
4032+
storePackageInstallDirs storeDirLayout compiler ipkgid =
4033+
storePackageInstallDirs' storeDirLayout compiler $ newSimpleUnitId ipkgid
40344034

40354035
storePackageInstallDirs'
40364036
:: StoreDirLayout
4037-
-> CompilerId
4037+
-> Compiler
40384038
-> UnitId
40394039
-> InstallDirs.InstallDirs FilePath
40404040
storePackageInstallDirs'
40414041
StoreDirLayout
40424042
{ storePackageDirectory
40434043
, storeDirectory
40444044
}
4045-
compid
4045+
compiler
40464046
unitid =
40474047
InstallDirs.InstallDirs{..}
40484048
where
4049-
store = storeDirectory compid
4050-
prefix = storePackageDirectory compid unitid
4049+
store = storeDirectory compiler
4050+
prefix = storePackageDirectory compiler unitid
40514051
bindir = prefix </> "bin"
40524052
libdir = prefix </> "lib"
40534053
libsubdir = ""
@@ -4097,7 +4097,7 @@ computeInstallDirs storeDirLayout defaultInstallDirs elaboratedShared elab
40974097
-- use special simplified install dirs
40984098
storePackageInstallDirs'
40994099
storeDirLayout
4100-
(compilerId (pkgConfigCompiler elaboratedShared))
4100+
(pkgConfigCompiler elaboratedShared)
41014101
(elabUnitId elab)
41024102

41034103
-- TODO: [code cleanup] perhaps reorder this code

0 commit comments

Comments
 (0)