Skip to content

Commit 002c395

Browse files
andreabediniandreabedini
committed
propagate stage trough elaborateProjectPlanning
1 parent 298de3c commit 002c395

File tree

14 files changed

+529
-346
lines changed

14 files changed

+529
-346
lines changed

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

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ import Distribution.Client.ProjectPlanning.Types
4141
( Toolchain (..)
4242
, elabDistDirParams
4343
, getStage
44+
, ElaboratedInstalledPackageInfo
4445
)
4546
import Distribution.Client.ScriptUtils
4647
( AcceptNoTargets (..)
@@ -102,6 +103,7 @@ import Distribution.Verbosity as Verbosity
102103
import Distribution.Client.Errors
103104
import System.Directory (doesDirectoryExist, doesFileExist)
104105
import System.FilePath (normalise, takeDirectory, (</>))
106+
import Distribution.Client.ProjectPlanning.Stage (WithStage(..))
105107

106108
haddockProjectAction :: HaddockProjectFlags -> [String] -> GlobalFlags -> IO ()
107109
haddockProjectAction flags _extraArgs globalFlags = do
@@ -156,7 +158,7 @@ haddockProjectAction flags _extraArgs globalFlags = do
156158
sharedConfig :: ElaboratedSharedConfig
157159
sharedConfig = elaboratedShared buildCtx
158160

159-
pkgs :: [Either InstalledPackageInfo ElaboratedConfiguredPackage]
161+
pkgs :: [Either ElaboratedInstalledPackageInfo ElaboratedConfiguredPackage]
160162
pkgs = matchingPackages elaboratedPlan
161163

162164
-- TODO
@@ -206,7 +208,7 @@ haddockProjectAction flags _extraArgs globalFlags = do
206208

207209
packageInfos <- fmap (nub . concat) $ for pkgs $ \pkg ->
208210
case pkg of
209-
Left package | localStyle -> do
211+
Left (WithStage _ package) | localStyle -> do
210212
let packageName = unPackageName (pkgName $ sourcePackageId package)
211213
destDir = outputDir </> packageName
212214
fmap catMaybes $ for (haddockInterfaces package) $ \interfacePath -> do
@@ -438,7 +440,7 @@ haddockProjectAction flags _extraArgs globalFlags = do
438440

439441
matchingPackages
440442
:: ElaboratedInstallPlan
441-
-> [Either InstalledPackageInfo ElaboratedConfiguredPackage]
443+
-> [Either ElaboratedInstalledPackageInfo ElaboratedConfiguredPackage]
442444
matchingPackages =
443445
fmap (foldPlanPackage Left Right)
444446
. InstallPlan.toList

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

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -92,7 +92,7 @@ import Distribution.Client.ProjectPlanning
9292
( storePackageInstallDirs'
9393
)
9494
import Distribution.Client.ProjectPlanning.Types
95-
( ElaboratedInstallPlan
95+
( ElaboratedInstallPlan, ElaboratedPlanPackage
9696
)
9797
import Distribution.Client.RebuildMonad
9898
( runRebuild
@@ -114,6 +114,7 @@ import Distribution.Client.Types
114114
import Distribution.Client.Types.OverwritePolicy
115115
( OverwritePolicy (..)
116116
)
117+
import qualified Distribution.Compat.Graph as Graph
117118
import Distribution.Package
118119
( Package (..)
119120
, PackageName
@@ -248,6 +249,7 @@ import System.FilePath
248249
, (<.>)
249250
, (</>)
250251
)
252+
import qualified Distribution.Client.ProjectPlanning.Types as Stage
251253

252254
-- | Check or check then install an exe. The check is to see if the overwrite
253255
-- policy allows installation.
@@ -562,7 +564,7 @@ installAction flags@NixStyleFlags{extraFlags, configFlags, installFlags, project
562564
traverseInstall action cfg@InstallCfg{verbosity = v, buildCtx, installClientFlags} = do
563565
let overwritePolicy = fromFlagOrDefault NeverOverwrite $ cinstOverwritePolicy installClientFlags
564566
actionOnExe <- action v overwritePolicy <$> prepareExeInstall cfg
565-
traverse_ actionOnExe . Map.toList $ targetsMap buildCtx
567+
traverse_ actionOnExe . Map.toList $ filterTargetsWithStage Stage.Host $ targetsMap buildCtx
566568

567569
withProject
568570
:: Verbosity
@@ -781,7 +783,7 @@ getSpecsAndTargetSelectors verbosity reducedVerbosity sourcePkgDb targetSelector
781783

782784
localPkgs = sdistize <$> localPackages baseCtx
783785

784-
gatherTargets :: UnitId -> TargetSelector
786+
gatherTargets :: Graph.Key ElaboratedPlanPackage -> TargetSelector
785787
gatherTargets targetId = TargetPackageNamed pkgName targetFilter
786788
where
787789
targetUnit = Map.findWithDefault (error "cannot find target unit") targetId planMap
@@ -826,7 +828,7 @@ partitionToKnownTargetsAndHackagePackages
826828
-> SourcePackageDb
827829
-> ElaboratedInstallPlan
828830
-> [TargetSelector]
829-
-> IO (TargetsMap, [PackageName])
831+
-> IO (TargetsMapS, [PackageName])
830832
partitionToKnownTargetsAndHackagePackages verbosity pkgDb elaboratedPlan targetSelectors = do
831833
let mTargets =
832834
resolveTargets
@@ -1002,7 +1004,7 @@ installLibraries
10021004
ordNub $
10031005
globalEntries
10041006
++ envEntries
1005-
++ entriesForLibraryComponents (targetsMap buildCtx)
1007+
++ entriesForLibraryComponents (filterTargetsWithStage Stage.Host $ targetsMap buildCtx)
10061008
contents' = renderGhcEnvironmentFile (baseEntries ++ pkgEntries)
10071009
createDirectoryIfMissing True (takeDirectory envFile)
10081010
writeFileAtomic envFile (BS.pack contents')

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -224,7 +224,7 @@ listbinAction flags@NixStyleFlags{..} args globalFlags = do
224224
-- Target Problem: the very similar to CmdRun
225225
-------------------------------------------------------------------------------
226226

227-
singleComponentOrElse :: IO (UnitId, UnqualComponentName) -> TargetsMap -> IO (UnitId, UnqualComponentName)
227+
singleComponentOrElse :: IO (WithStage UnitId, UnqualComponentName) -> TargetsMapS -> IO (WithStage UnitId, UnqualComponentName)
228228
singleComponentOrElse action targetsMap =
229229
case Set.toList . distinctTargetComponents $ targetsMap of
230230
[(unitId, CExeName component)] -> return (unitId, component)
@@ -316,7 +316,7 @@ data ListBinProblem
316316
| -- | A single 'TargetSelector' matches multiple targets
317317
TargetProblemMatchesMultiple TargetSelector [AvailableTarget ()]
318318
| -- | Multiple 'TargetSelector's match multiple targets
319-
TargetProblemMultipleTargets TargetsMap
319+
TargetProblemMultipleTargets TargetsMapS
320320
| -- | The 'TargetSelector' refers to a component that is not an executable
321321
TargetProblemComponentNotRightKind PackageId ComponentName
322322
| -- | Asking to run an individual file or module is not supported
@@ -333,7 +333,7 @@ matchesMultipleProblem selector targets =
333333
CustomTargetProblem $
334334
TargetProblemMatchesMultiple selector targets
335335

336-
multipleTargetsProblem :: TargetsMap -> TargetProblem ListBinProblem
336+
multipleTargetsProblem :: TargetsMapS -> TargetProblem ListBinProblem
337337
multipleTargetsProblem = CustomTargetProblem . TargetProblemMultipleTargets
338338

339339
componentNotRightKindProblem :: PackageId -> ComponentName -> TargetProblem ListBinProblem

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

Lines changed: 22 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -89,7 +89,6 @@ import Distribution.Compiler
8989
import Distribution.Package
9090
( Package (..)
9191
, UnitId
92-
, installedUnitId
9392
, mkPackageName
9493
, packageName
9594
)
@@ -198,7 +197,9 @@ import System.FilePath
198197
, splitSearchPath
199198
, (</>)
200199
)
201-
import Distribution.Solver.Types.Stage
200+
import Distribution.Solver.Types.Stage (Stage(..), Staged(..))
201+
import qualified Distribution.Compat.Graph as Graph
202+
import Distribution.Client.ProjectPlanning.Stage (WithStage(..))
202203

203204
replCommand :: CommandUI (NixStyleFlags ReplFlags)
204205
replCommand =
@@ -345,15 +346,16 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings g
345346
-- especially in the no-project case.
346347
withInstallPlan (lessVerbose verbosity) baseCtx' $ \elaboratedPlan sharedConfig -> do
347348
-- targets should be non-empty map, but there's no NonEmptyMap yet.
348-
-- TODO: This only makes sense for the build stage
349-
let Toolchain { toolchainCompiler = compiler } = getStage (pkgConfigToolchains sharedConfig) Build
350-
targets <- validatedTargets (projectConfigShared (projectConfig ctx)) compiler elaboratedPlan targetSelectors
351-
349+
let stage = Build
350+
Toolchain { toolchainCompiler = compiler } = getStage (pkgConfigToolchains sharedConfig) stage
351+
-- FIXME there is total confusion here about who is filtering for the stage
352+
targets <-
353+
validatedTargets (projectConfigShared (projectConfig ctx)) compiler elaboratedPlan targetSelectors
352354
let
353-
(unitId, _) = fromMaybe (error "panic: targets should be non-empty") $ safeHead $ Map.toList targets
354-
originalDeps = installedUnitId <$> InstallPlan.directDeps elaboratedPlan unitId
355-
oci = OriginalComponentInfo unitId originalDeps
356-
pkgId = fromMaybe (error $ "cannot find " ++ prettyShow unitId) $ packageId <$> InstallPlan.lookup elaboratedPlan unitId
355+
(key, _uid) = fromMaybe (error "panic: targets should be non-empty") $ safeHead $ Map.toList targets
356+
originalDeps = Graph.nodeKey <$> InstallPlan.directDeps elaboratedPlan key
357+
oci = OriginalComponentInfo key originalDeps
358+
pkgId = fromMaybe (error $ "cannot find " ++ prettyShow key) $ packageId <$> InstallPlan.lookup elaboratedPlan key
357359
baseCtx'' = addDepsToProjectTarget (envPackages replEnvFlags) pkgId baseCtx'
358360

359361
return (Just oci, baseCtx'')
@@ -512,6 +514,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings g
512514
verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
513515
tempFileOptions = commonSetupTempFileOptions $ configCommonFlags configFlags
514516

517+
-- FIXME: the compiler depends on the stage!!
515518
validatedTargets ctx compiler elaboratedPlan targetSelectors = do
516519
let multi_repl_enabled = multiReplDecision ctx compiler r
517520
-- Interpret the targets on the command line as repl targets
@@ -552,8 +555,8 @@ minMultipleHomeUnitsVersion :: Version
552555
minMultipleHomeUnitsVersion = mkVersion [9, 4]
553556

554557
data OriginalComponentInfo = OriginalComponentInfo
555-
{ ociUnitId :: UnitId
556-
, ociOriginalDeps :: [UnitId]
558+
{ ociUnitId :: WithStage UnitId
559+
, ociOriginalDeps :: [WithStage UnitId]
557560
}
558561
deriving (Show)
559562

@@ -588,17 +591,18 @@ addDepsToProjectTarget deps pkgId ctx =
588591
generateReplFlags :: Bool -> ElaboratedInstallPlan -> OriginalComponentInfo -> [String]
589592
generateReplFlags includeTransitive elaboratedPlan OriginalComponentInfo{..} = flags
590593
where
591-
exeDeps :: [UnitId]
594+
exeDeps :: [WithStage UnitId]
592595
exeDeps =
593596
foldMap
594597
(InstallPlan.foldPlanPackage (const []) elabOrderExeDependencies)
595598
(InstallPlan.dependencyClosure elaboratedPlan [ociUnitId])
596599

597-
deps, deps', trans, trans' :: [UnitId]
600+
deps, deps', trans, trans' :: [WithStage UnitId]
598601
flags :: [String]
599-
deps = installedUnitId <$> InstallPlan.directDeps elaboratedPlan ociUnitId
602+
deps = Graph.nodeKey <$> InstallPlan.directDeps elaboratedPlan ociUnitId
600603
deps' = deps \\ ociOriginalDeps
601-
trans = installedUnitId <$> InstallPlan.dependencyClosure elaboratedPlan deps'
604+
605+
trans = Graph.nodeKey <$> InstallPlan.dependencyClosure elaboratedPlan deps'
602606
trans' = trans \\ ociOriginalDeps
603607
flags =
604608
fmap (("-package-id " ++) . prettyShow) . (\\ exeDeps) $
@@ -751,7 +755,7 @@ selectComponentTarget = selectComponentTargetBasic
751755
data ReplProblem
752756
= TargetProblemMatchesMultiple MultiReplDecision TargetSelector [AvailableTarget ()]
753757
| -- | Multiple 'TargetSelector's match multiple targets
754-
TargetProblemMultipleTargets MultiReplDecision TargetsMap
758+
TargetProblemMultipleTargets MultiReplDecision TargetsMapS
755759
deriving (Eq, Show)
756760

757761
-- | The various error conditions that can occur when matching a
@@ -768,7 +772,7 @@ matchesMultipleProblem decision targetSelector targetsExesBuildable =
768772

769773
multipleTargetsProblem
770774
:: MultiReplDecision
771-
-> TargetsMap
775+
-> TargetsMapS
772776
-> ReplTargetProblem
773777
multipleTargetsProblem decision = CustomTargetProblem . TargetProblemMultipleTargets decision
774778

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

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -59,7 +59,7 @@ import Distribution.Client.ProjectPlanning
5959
import Distribution.Client.ProjectPlanning.Types
6060
( ElaboratedPackageOrComponent (..)
6161
, dataDirsEnvironmentForPlan
62-
, elabExeDependencyPaths
62+
, elabExeDependencyPaths, WithStage (..)
6363
)
6464

6565
import Distribution.Client.ScriptUtils
@@ -388,7 +388,7 @@ handleShebang :: FilePath -> [String] -> IO ()
388388
handleShebang script args =
389389
runAction (commandDefaultFlags runCommand) (script : args) defaultGlobalFlags
390390

391-
singleExeOrElse :: IO (UnitId, UnqualComponentName) -> TargetsMap -> IO (UnitId, UnqualComponentName)
391+
singleExeOrElse :: IO (WithStage UnitId, UnqualComponentName) -> TargetsMapS -> IO (WithStage UnitId, UnqualComponentName)
392392
singleExeOrElse action targetsMap =
393393
case Set.toList . distinctTargetComponents $ targetsMap of
394394
[(unitId, CExeName component)] -> return (unitId, component)
@@ -400,16 +400,16 @@ singleExeOrElse action targetsMap =
400400
-- 'ElaboratedConfiguredPackage's that match the specified
401401
-- 'UnitId'.
402402
matchingPackagesByUnitId
403-
:: UnitId
403+
:: WithStage UnitId
404404
-> ElaboratedInstallPlan
405405
-> [ElaboratedConfiguredPackage]
406-
matchingPackagesByUnitId uid =
406+
matchingPackagesByUnitId (WithStage s uid) =
407407
catMaybes
408408
. fmap
409409
( foldPlanPackage
410410
(const Nothing)
411411
( \x ->
412-
if elabUnitId x == uid
412+
if elabUnitId x == uid && elabStage x == s
413413
then Just x
414414
else Nothing
415415
)
@@ -498,7 +498,7 @@ data RunProblem
498498
| -- | A single 'TargetSelector' matches multiple targets
499499
TargetProblemMatchesMultiple TargetSelector [AvailableTarget ()]
500500
| -- | Multiple 'TargetSelector's match multiple targets
501-
TargetProblemMultipleTargets TargetsMap
501+
TargetProblemMultipleTargets TargetsMapS
502502
| -- | The 'TargetSelector' refers to a component that is not an executable
503503
TargetProblemComponentNotExe PackageId ComponentName
504504
| -- | Asking to run an individual file or module is not supported
@@ -515,7 +515,7 @@ matchesMultipleProblem selector targets =
515515
CustomTargetProblem $
516516
TargetProblemMatchesMultiple selector targets
517517

518-
multipleTargetsProblem :: TargetsMap -> TargetProblem RunProblem
518+
multipleTargetsProblem :: TargetsMapS -> TargetProblem RunProblem
519519
multipleTargetsProblem = CustomTargetProblem . TargetProblemMultipleTargets
520520

521521
componentNotExeProblem :: PackageId -> ComponentName -> TargetProblem RunProblem

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

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,7 @@ import Distribution.Verbosity
4646
)
4747
import Text.PrettyPrint
4848
import qualified Text.PrettyPrint as Pretty
49+
import Distribution.Client.ProjectPlanning.Stage (WithStage(..))
4950

5051
-------------------------------------------------------------------------------
5152
-- Command
@@ -171,7 +172,7 @@ targetAction flags@NixStyleFlags{..} ts globalFlags = do
171172
either (reportTargetSelectorProblems verbosity) return
172173
=<< readTargetSelectors localPackages Nothing targetStrings
173174

174-
targets :: TargetsMap <-
175+
targets <-
175176
either (reportBuildTargetProblems verbosity) return $
176177
resolveTargets
177178
selectPackageTargets
@@ -193,7 +194,7 @@ targetAction flags@NixStyleFlags{..} ts globalFlags = do
193194
reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a
194195
reportBuildTargetProblems verbosity = reportTargetProblems verbosity "target"
195196

196-
printTargetForms :: Verbosity -> [String] -> TargetsMap -> ElaboratedInstallPlan -> IO ()
197+
printTargetForms :: Verbosity -> [String] -> TargetsMapS -> ElaboratedInstallPlan -> IO ()
197198
printTargetForms verbosity targetStrings targets elaboratedPlan =
198199
noticeDoc verbosity $
199200
vcat
@@ -219,7 +220,7 @@ printTargetForms verbosity targetStrings targets elaboratedPlan =
219220
sort $
220221
catMaybes
221222
[ targetForm ct <$> pkg
222-
| (u :: UnitId, xs) <- Map.toAscList targets
223+
| (WithStage _ u, xs) <- Map.toAscList targets
223224
, let pkg = safeHead $ filter ((== u) . elabUnitId) localPkgs
224225
, (ct :: ComponentTarget, _) <- xs
225226
]

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ import Network.URI
3636
import Text.PrettyPrint hiding (render, (<>))
3737
import qualified Text.PrettyPrint as PP
3838
import Text.Regex.Posix.ByteString (WrapError)
39+
import Distribution.Client.ProjectPlanning.Stage (WithStage)
3940

4041
data CabalInstallException
4142
= UnpackGet
@@ -94,7 +95,7 @@ data CabalInstallException
9495
| PlanPackages String
9596
| NoSupportForRunCommand
9697
| RunPhaseReached
97-
| UnknownExecutable String UnitId
98+
| UnknownExecutable String (WithStage UnitId)
9899
| MultipleMatchingExecutables String [String]
99100
| CmdRunReportTargetProblems String
100101
| CleanAction [String]

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

Lines changed: 13 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -181,7 +181,8 @@ data PackageHashInputs = PackageHashInputs
181181
, pkgHashComponent :: Maybe CD.Component
182182
, pkgHashSourceHash :: PackageSourceHash
183183
, pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion)
184-
, pkgHashDirectDeps :: Set InstalledPackageId
184+
, pkgHashLibDeps :: Set InstalledPackageId
185+
, pkgHashExeDeps :: Set InstalledPackageId
185186
, pkgHashOtherConfig :: PackageHashConfigInputs
186187
}
187188

@@ -256,7 +257,8 @@ renderPackageHashInputs
256257
{ pkgHashPkgId
257258
, pkgHashComponent
258259
, pkgHashSourceHash
259-
, pkgHashDirectDeps
260+
, pkgHashLibDeps
261+
, pkgHashExeDeps
260262
, pkgHashPkgConfigDeps
261263
, pkgHashOtherConfig =
262264
PackageHashConfigInputs{..}
@@ -295,12 +297,19 @@ renderPackageHashInputs
295297
)
296298
pkgHashPkgConfigDeps
297299
, entry
298-
"deps"
300+
"lib-deps"
299301
( intercalate ", "
300302
. map prettyShow
301303
. Set.toList
302304
)
303-
pkgHashDirectDeps
305+
pkgHashLibDeps
306+
, entry
307+
"exe-deps"
308+
( intercalate ", "
309+
. map prettyShow
310+
. Set.toList
311+
)
312+
pkgHashExeDeps
304313
, -- and then all the config
305314
entry "compilerid" prettyShow pkgHashCompilerId
306315
, entry "compilerabi" prettyShow pkgHashCompilerABI

0 commit comments

Comments
 (0)