Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Include the GHC "Project Unit Id" in the cabal store path #9326

Closed
wants to merge 1 commit into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 10 additions & 2 deletions Cabal/src/Distribution/Simple/GHC.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}

Expand Down Expand Up @@ -83,6 +84,7 @@ import Prelude ()

import Control.Monad (forM_, msum)
import Data.Char (isLower)
import Data.List (stripPrefix)
import qualified Data.Map as Map
import Distribution.CabalSpecVersion
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
Expand Down Expand Up @@ -246,10 +248,16 @@ configure verbosity hcPath hcPkgPath conf0 = do

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

compilerId :: CompilerId
compilerId = CompilerId GHC ghcVersion

compilerAbiTag :: AbiTag
compilerAbiTag = maybe NoAbiTag AbiTag (Map.lookup "Project Unit Id" ghcInfoMap >>= stripPrefix (prettyShow compilerId <> "-"))

let comp =
Compiler
{ compilerId = CompilerId GHC ghcVersion
, compilerAbiTag = NoAbiTag
{ compilerId
, compilerAbiTag
, compilerCompat = []
, compilerLanguages = languages
, compilerExtensions = extensions
Expand Down
5 changes: 1 addition & 4 deletions cabal-install/src/Distribution/Client/CmdHaddockProject.hs
Original file line number Diff line number Diff line change
Expand Up @@ -54,9 +54,6 @@ import Distribution.Client.TargetProblem (TargetProblem (..))
import Distribution.Simple.Command
( CommandUI (..)
)
import Distribution.Simple.Compiler
( Compiler (..)
)
import Distribution.Simple.Flag
( Flag (..)
, fromFlag
Expand Down Expand Up @@ -319,7 +316,7 @@ haddockProjectAction flags _extraArgs globalFlags = do
packageDir =
storePackageDirectory
(cabalStoreDirLayout cabalLayout)
(compilerId (pkgConfigCompiler sharedConfig'))
(pkgConfigCompiler sharedConfig')
(elabUnitId package)
docDir = packageDir </> "share" </> "doc" </> "html"
destDir = outputDir </> packageName
Expand Down
13 changes: 6 additions & 7 deletions cabal-install/src/Distribution/Client/CmdInstall.hs
Original file line number Diff line number Diff line change
Expand Up @@ -481,8 +481,7 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt

-- progDb is a program database with compiler tools configured properly
( compiler@Compiler
{ compilerId =
compilerId@(CompilerId compilerFlavor compilerVersion)
{ compilerId = CompilerId compilerFlavor compilerVersion
}
, platform
, progDb
Expand All @@ -495,7 +494,7 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt
envFile <- getEnvFile clientInstallFlags platform compilerVersion
existingEnvEntries <-
getExistingEnvEntries verbosity compilerFlavor supportsPkgEnvFiles envFile
packageDbs <- getPackageDbStack compilerId projectConfigStoreDir projectConfigLogsDir
packageDbs <- getPackageDbStack compiler projectConfigStoreDir projectConfigLogsDir
installedIndex <- getInstalledPackages verbosity compiler packageDbs progDb

let
Expand Down Expand Up @@ -811,7 +810,7 @@ installExes
mkUnitBinDir :: UnitId -> FilePath
mkUnitBinDir =
InstallDirs.bindir
. storePackageInstallDirs' storeDirLayout (compilerId compiler)
. storePackageInstallDirs' storeDirLayout compiler

mkExeName :: UnqualComponentName -> FilePath
mkExeName exe = unUnqualComponentName exe <.> exeExtension platform
Expand Down Expand Up @@ -1191,16 +1190,16 @@ getLocalEnv dir platform compilerVersion =
<> ghcPlatformAndVersionString platform compilerVersion

getPackageDbStack
:: CompilerId
:: Compiler
-> Flag FilePath
-> Flag FilePath
-> IO PackageDBStack
getPackageDbStack compilerId storeDirFlag logsDirFlag = do
getPackageDbStack compiler storeDirFlag logsDirFlag = do
mstoreDir <- traverse makeAbsolute $ flagToMaybe storeDirFlag
let
mlogsDir = flagToMaybe logsDirFlag
cabalLayout <- mkCabalDirLayout mstoreDir mlogsDir
pure $ storePackageDBStack (cabalStoreDirLayout cabalLayout) compilerId
pure $ storePackageDBStack (cabalStoreDirLayout cabalLayout) compiler

-- | This defines what a 'TargetSelector' means for the @bench@ command.
-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,
Expand Down
73 changes: 38 additions & 35 deletions cabal-install/src/Distribution/Client/DistDirLayout.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,8 @@ import Distribution.Package
, UnitId
)
import Distribution.Simple.Compiler
( OptimisationLevel (..)
( Compiler (..)
, OptimisationLevel (..)
, PackageDB (..)
, PackageDBStack
)
Expand Down Expand Up @@ -116,13 +117,13 @@ data DistDirLayout = DistDirLayout

-- | The layout of a cabal nix-style store.
data StoreDirLayout = StoreDirLayout
{ storeDirectory :: CompilerId -> FilePath
, storePackageDirectory :: CompilerId -> UnitId -> FilePath
, storePackageDBPath :: CompilerId -> FilePath
, storePackageDB :: CompilerId -> PackageDB
, storePackageDBStack :: CompilerId -> PackageDBStack
, storeIncomingDirectory :: CompilerId -> FilePath
, storeIncomingLock :: CompilerId -> UnitId -> FilePath
{ storeDirectory :: Compiler -> FilePath
, storePackageDirectory :: Compiler -> UnitId -> FilePath
, storePackageDBPath :: Compiler -> FilePath
, storePackageDB :: Compiler -> PackageDB
, storePackageDBStack :: Compiler -> PackageDBStack
, storeIncomingDirectory :: Compiler -> FilePath
, storeIncomingLock :: Compiler -> UnitId -> FilePath
}

-- TODO: move to another module, e.g. CabalDirLayout?
Expand Down Expand Up @@ -267,33 +268,35 @@ defaultStoreDirLayout :: FilePath -> StoreDirLayout
defaultStoreDirLayout storeRoot =
StoreDirLayout{..}
where
storeDirectory :: CompilerId -> FilePath
storeDirectory compid =
storeRoot </> prettyShow compid

storePackageDirectory :: CompilerId -> UnitId -> FilePath
storePackageDirectory compid ipkgid =
storeDirectory compid </> prettyShow ipkgid

storePackageDBPath :: CompilerId -> FilePath
storePackageDBPath compid =
storeDirectory compid </> "package.db"

storePackageDB :: CompilerId -> PackageDB
storePackageDB compid =
SpecificPackageDB (storePackageDBPath compid)

storePackageDBStack :: CompilerId -> PackageDBStack
storePackageDBStack compid =
[GlobalPackageDB, storePackageDB compid]

storeIncomingDirectory :: CompilerId -> FilePath
storeIncomingDirectory compid =
storeDirectory compid </> "incoming"

storeIncomingLock :: CompilerId -> UnitId -> FilePath
storeIncomingLock compid unitid =
storeIncomingDirectory compid </> prettyShow unitid <.> "lock"
storeDirectory :: Compiler -> FilePath
storeDirectory compiler =
storeRoot </> case compilerAbiTag compiler of
NoAbiTag -> prettyShow (compilerId compiler)
AbiTag tag -> prettyShow (compilerId compiler) <> "-" <> tag

storePackageDirectory :: Compiler -> UnitId -> FilePath
storePackageDirectory compiler ipkgid =
storeDirectory compiler </> prettyShow ipkgid

storePackageDBPath :: Compiler -> FilePath
storePackageDBPath compiler =
storeDirectory compiler </> "package.db"

storePackageDB :: Compiler -> PackageDB
storePackageDB compiler =
SpecificPackageDB (storePackageDBPath compiler)

storePackageDBStack :: Compiler -> PackageDBStack
storePackageDBStack compiler =
[GlobalPackageDB, storePackageDB compiler]

storeIncomingDirectory :: Compiler -> FilePath
storeIncomingDirectory compiler =
storeDirectory compiler </> "incoming"

storeIncomingLock :: Compiler -> UnitId -> FilePath
storeIncomingLock compiler unitid =
storeIncomingDirectory compiler </> prettyShow unitid <.> "lock"

defaultCabalDirLayout :: IO CabalDirLayout
defaultCabalDirLayout =
Expand Down
8 changes: 3 additions & 5 deletions cabal-install/src/Distribution/Client/ProjectBuilding.hs
Original file line number Diff line number Diff line change
Expand Up @@ -98,7 +98,6 @@ import Distribution.Simple.Command (CommandUI)
import Distribution.Simple.Compiler
( Compiler
, PackageDB (..)
, compilerId
, jsemSupported
)
import qualified Distribution.Simple.InstallDirs as InstallDirs
Expand Down Expand Up @@ -1280,15 +1279,15 @@ buildAndInstallUnpackedPackage
let ipkg = ipkg0{Installed.installedUnitId = uid}
assert
( elabRegisterPackageDBStack pkg
== storePackageDBStack compid
== storePackageDBStack compiler
)
(return ())
criticalSection registerLock $
Cabal.registerPackage
verbosity
compiler
progdb
(storePackageDBStack compid)
(storePackageDBStack compiler)
ipkg
Cabal.defaultRegisterOptions
{ Cabal.registerMultiInstance = True
Expand All @@ -1300,7 +1299,7 @@ buildAndInstallUnpackedPackage
newStoreEntry
verbosity
storeDirLayout
compid
compiler
uid
copyPkgFiles
registerPkg
Expand Down Expand Up @@ -1330,7 +1329,6 @@ buildAndInstallUnpackedPackage
where
pkgid = packageId rpkg
uid = installedUnitId rpkg
compid = compilerId compiler

dispname :: String
dispname = case elabPkgOrComp pkg of
Expand Down
22 changes: 11 additions & 11 deletions cabal-install/src/Distribution/Client/ProjectPlanning.hs
Original file line number Diff line number Diff line change
Expand Up @@ -898,7 +898,7 @@ rebuildInstallPlan
-> Rebuild ElaboratedInstallPlan
phaseImprovePlan elaboratedPlan elaboratedShared = do
liftIO $ debug verbosity "Improving the install plan..."
storePkgIdSet <- getStoreEntries cabalStoreDirLayout compid
storePkgIdSet <- getStoreEntries cabalStoreDirLayout compiler
let improvedPlan =
improveInstallPlanWithInstalledPackages
storePkgIdSet
Expand All @@ -910,7 +910,7 @@ rebuildInstallPlan
-- matches up as expected, e.g. no dangling deps, files deleted.
return improvedPlan
where
compid = compilerId (pkgConfigCompiler elaboratedShared)
compiler = pkgConfigCompiler elaboratedShared

-- | If a 'PackageSpecifier' refers to a single package, return Just that
-- package.
Expand Down Expand Up @@ -2350,7 +2350,7 @@ elaborateInstallPlan

corePackageDbs =
applyPackageDbFlags
(storePackageDBStack (compilerId compiler))
(storePackageDBStack compiler)
(projectConfigPackageDBs sharedPackageConfig)

-- For this local build policy, every package that lives in a local source
Expand Down Expand Up @@ -4027,28 +4027,28 @@ userInstallDirTemplates compiler = do

storePackageInstallDirs
:: StoreDirLayout
-> CompilerId
-> Compiler
-> InstalledPackageId
-> InstallDirs.InstallDirs FilePath
storePackageInstallDirs storeDirLayout compid ipkgid =
storePackageInstallDirs' storeDirLayout compid $ newSimpleUnitId ipkgid
storePackageInstallDirs storeDirLayout compiler ipkgid =
storePackageInstallDirs' storeDirLayout compiler $ newSimpleUnitId ipkgid

storePackageInstallDirs'
:: StoreDirLayout
-> CompilerId
-> Compiler
-> UnitId
-> InstallDirs.InstallDirs FilePath
storePackageInstallDirs'
StoreDirLayout
{ storePackageDirectory
, storeDirectory
}
compid
compiler
unitid =
InstallDirs.InstallDirs{..}
where
store = storeDirectory compid
prefix = storePackageDirectory compid unitid
store = storeDirectory compiler
prefix = storePackageDirectory compiler unitid
bindir = prefix </> "bin"
libdir = prefix </> "lib"
libsubdir = ""
Expand Down Expand Up @@ -4098,7 +4098,7 @@ computeInstallDirs storeDirLayout defaultInstallDirs elaboratedShared elab
-- use special simplified install dirs
storePackageInstallDirs'
storeDirLayout
(compilerId (pkgConfigCompiler elaboratedShared))
(pkgConfigCompiler elaboratedShared)
(elabUnitId elab)

-- TODO: [code cleanup] perhaps reorder this code
Expand Down
Loading
Loading