Commit c0a48602 authored by Edward Z. Yang's avatar Edward Z. Yang

Solve for, build, and add to path build-tools dependencies.

This fixes #220: new-build now builds, installs and adds executables to
PATH automatically if they show up in 'build-tools'.  However, there is
still more that could be done: the new behavior only applies to a
specific list of 'build-tools' (alex, happy, etc) which Cabal recognizes
out of the box.  The plan is to introduce a new 'tool-depends' field to
allow dependencies on other executables as well.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent f63273da
......@@ -1393,7 +1393,9 @@ configureRequiredProgram :: Verbosity -> ProgramConfiguration -> Dependency
configureRequiredProgram verbosity conf
(Dependency (PackageName progName) verRange) =
case lookupKnownProgram progName conf of
Nothing -> die ("Unknown build tool " ++ progName)
Nothing ->
-- Try to configure it as a 'simpleProgram' automatically
configureProgram verbosity (simpleProgram progName) conf
Just prog
-- requireProgramVersion always requires the program have a version
-- but if the user says "build-depends: foo" ie no version constraint
......
......@@ -768,7 +768,7 @@ showPackageProblem (InvalidDep dep pkgid) =
configuredPackageProblems :: Platform -> CompilerInfo
-> SolverPackage UnresolvedPkgLoc -> [PackageProblem]
configuredPackageProblems platform cinfo
(SolverPackage pkg specifiedFlags stanzas specifiedDeps') =
(SolverPackage pkg specifiedFlags stanzas specifiedDeps' _specifiedExeDeps') =
[ DuplicateFlag flag | ((flag,_):_) <- duplicates specifiedFlags ]
++ [ MissingFlag flag | OnlyInLeft flag <- mergedFlags ]
++ [ ExtraFlag flag | OnlyInRight flag <- mergedFlags ]
......@@ -779,6 +779,7 @@ configuredPackageProblems platform cinfo
++ [ ExtraDep pkgid | OnlyInRight pkgid <- mergedDeps ]
++ [ InvalidDep dep pkgid | InBoth dep pkgid <- mergedDeps
, not (packageSatisfiesDependency pkgid dep) ]
-- TODO: sanity tests on executable deps
where
specifiedDeps :: ComponentDeps [PackageId]
specifiedDeps = fmap (map solverSrcId) specifiedDeps'
......
......@@ -79,6 +79,7 @@ import Distribution.Client.SolverInstallPlan (SolverInstallPlan)
import qualified Distribution.Solver.Types.ComponentDeps as CD
import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.SolverId
import Distribution.Solver.Types.InstSolverPackage
-- TODO: Need this when we compute final UnitIds
-- import qualified Distribution.Simple.Configure as Configure
......@@ -415,8 +416,8 @@ configureInstallPlan :: SolverInstallPlan -> InstallPlan
configureInstallPlan solverPlan =
flip fromSolverInstallPlan solverPlan $ \mapDep planpkg ->
[case planpkg of
SolverInstallPlan.PreExisting pkg _ ->
PreExisting pkg
SolverInstallPlan.PreExisting pkg ->
PreExisting (instSolverPkgIPI pkg)
SolverInstallPlan.Configured pkg ->
Configured (configureSolverPackage mapDep pkg)
......@@ -438,9 +439,10 @@ configureInstallPlan solverPlan =
confPkgFlags = solverPkgFlags spkg,
confPkgStanzas = solverPkgStanzas spkg,
confPkgDeps = deps
-- NB: no support for executable dependencies
}
where
deps = fmap (concatMap (map configuredId . mapDep)) (solverPkgDeps spkg)
deps = fmap (concatMap (map configuredId . mapDep)) (solverPkgLibDeps spkg)
-- ------------------------------------------------------------
......
......@@ -79,6 +79,7 @@ import Distribution.Solver.Types.PkgConfigDb
import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.SolverId
import Distribution.Solver.Types.SolverPackage
import Distribution.Solver.Types.InstSolverPackage
import Distribution.Solver.Types.SourcePackage
import Distribution.Package hiding
......@@ -1040,8 +1041,8 @@ elaborateInstallPlan platform compiler compilerprogdb
elaboratedInstallPlan =
flip InstallPlan.fromSolverInstallPlan solverPlan $ \mapDep planpkg ->
case planpkg of
SolverInstallPlan.PreExisting pkg _ ->
[InstallPlan.PreExisting pkg]
SolverInstallPlan.PreExisting pkg ->
[InstallPlan.PreExisting (instSolverPkgIPI pkg)]
SolverInstallPlan.Configured pkg ->
-- SolverPackage
......@@ -1073,7 +1074,7 @@ elaborateInstallPlan platform compiler compilerprogdb
:: (SolverId -> [ElaboratedPlanPackage])
-> SolverPackage UnresolvedPkgLoc
-> [ElaboratedConfiguredPackage]
elaborateSolverToComponents mapDep spkg@(SolverPackage _ _ _ deps0)
elaborateSolverToComponents mapDep spkg@(SolverPackage _ _ _ deps0 exe_deps0)
= snd (mapAccumL buildComponent (Map.empty, Map.empty) comps_graph)
where
elab0@ElaboratedConfiguredPackage{..} = elaborateSolverToCommon mapDep spkg
......@@ -1121,19 +1122,28 @@ elaborateInstallPlan platform compiler compilerprogdb
compComponentName = Just cname
compSolverName = CD.componentNameToComponent cname
compLibDependencies =
concatMap (elaborateSolverId mapDep)
concatMap (elaborateLibSolverId mapDep)
(CD.select (== compSolverName) deps0) ++
internal_lib_deps
compExeDependencies =
(map confInstId $
concatMap (elaborateExeSolverId mapDep)
(CD.select (== compSolverName) exe_deps0)) ++
internal_exe_deps
compExeDependencyPaths =
concatMap (elaborateExePath mapDep)
(CD.select (== compSolverName) exe_deps0) ++
internal_exe_paths
bi = Cabal.componentBuildInfo comp
confid = ConfiguredId elabPkgSourceId cid
compSetupDependencies = concatMap (elaborateSolverId mapDep) (CD.setupDeps deps0)
compSetupDependencies = concatMap (elaborateLibSolverId mapDep) (CD.setupDeps deps0)
internal_lib_deps
= [ confid'
| Dependency pkgname _ <- PD.targetBuildDepends bi
, Just confid' <- [Map.lookup pkgname internal_map] ]
(compExeDependencies, compExeDependencyPaths)
(internal_exe_deps, internal_exe_paths)
= unzip $
[ (confInstId confid', path)
| Dependency (PackageName toolname) _ <- PD.buildTools bi
......@@ -1190,22 +1200,56 @@ elaborateInstallPlan platform compiler compilerprogdb
(compilerId compiler)
cid
elaborateSolverId :: (SolverId -> [ElaboratedPlanPackage])
elaborateLibSolverId :: (SolverId -> [ElaboratedPlanPackage])
-> SolverId -> [ConfiguredId]
elaborateSolverId mapDep = map configuredId . filter is_lib . mapDep
elaborateLibSolverId mapDep = map configuredId . filter is_lib . mapDep
where is_lib (InstallPlan.PreExisting _) = True
is_lib (InstallPlan.Configured elab) =
case elabPkgOrComp elab of
ElabPackage _ -> True
ElabComponent comp -> compSolverName comp == CD.ComponentLib
elaborateExeSolverId :: (SolverId -> [ElaboratedPlanPackage])
-> SolverId -> [ConfiguredId]
elaborateExeSolverId mapDep = map configuredId . filter is_exe . mapDep
where is_exe (InstallPlan.PreExisting _) = False
is_exe (InstallPlan.Configured elab) =
case elabPkgOrComp elab of
ElabPackage _ -> True
ElabComponent comp ->
case compSolverName comp of
CD.ComponentExe _ -> True
_ -> False
elaborateExePath :: (SolverId -> [ElaboratedPlanPackage])
-> SolverId -> [FilePath]
elaborateExePath mapDep = concatMap get_exe_path . mapDep
where
-- Pre-existing executables are assumed to be in PATH
-- already. In fact, this should be impossible.
-- Modest duplication with 'inplace_bin_dir'
get_exe_path (InstallPlan.PreExisting _) = []
get_exe_path (InstallPlan.Configured elab) =
[if elabBuildStyle elab == BuildInplaceOnly
then distBuildDirectory
(elabDistDirParams elaboratedSharedConfig elab) </>
"build" </>
case elabPkgOrComp elab of
ElabPackage _ -> ""
ElabComponent comp ->
case fmap Cabal.componentNameString
(compComponentName comp) of
Just (Just n) -> n
_ -> ""
else InstallDirs.bindir (elabInstallDirs elab)]
elaborateSolverToPackage :: (SolverId -> [ElaboratedPlanPackage])
-> SolverPackage UnresolvedPkgLoc
-> ElaboratedConfiguredPackage
elaborateSolverToPackage
mapDep
pkg@(SolverPackage (SourcePackage pkgid _gdesc _srcloc _descOverride)
_flags _stanzas deps0) =
_flags _stanzas deps0 exe_deps0) =
-- Knot tying: the final elab includes the
-- pkgInstalledId, which is calculated by hashing many
-- of the other fields of the elaboratedPackage.
......@@ -1219,7 +1263,7 @@ elaborateInstallPlan platform compiler compilerprogdb
elabPkgOrComp = ElabPackage $ ElaboratedPackage {..}
}
deps = fmap (concatMap (elaborateSolverId mapDep)) deps0
deps = fmap (concatMap (elaborateLibSolverId mapDep)) deps0
requires_reg = PD.hasPublicLib elabPkgDescription
pkgInstalledId
......@@ -1238,6 +1282,8 @@ elaborateInstallPlan platform compiler compilerprogdb
++ " is missing a source hash: " ++ display pkgid
pkgLibDependencies = deps
pkgExeDependencies = fmap (concatMap (elaborateExeSolverId mapDep)) exe_deps0
pkgExeDependencyPaths = fmap (concatMap (elaborateExePath mapDep)) exe_deps0
-- Filled in later
pkgStanzasEnabled = Set.empty
......@@ -1269,7 +1315,7 @@ elaborateInstallPlan platform compiler compilerprogdb
-> ElaboratedConfiguredPackage
elaborateSolverToCommon mapDep
pkg@(SolverPackage (SourcePackage pkgid gdesc srcloc descOverride)
flags stanzas deps0) =
flags stanzas deps0 _exe_deps0) =
elaboratedPackage
where
elaboratedPackage = ElaboratedConfiguredPackage {..}
......@@ -1332,7 +1378,7 @@ elaborateInstallPlan platform compiler compilerprogdb
elabSetupScriptStyle = packageSetupScriptStyle elabPkgDescription
-- Computing the deps here is a little awful
deps = fmap (concatMap (elaborateSolverId mapDep)) deps0
deps = fmap (concatMap (elaborateLibSolverId mapDep)) deps0
elabSetupScriptCliVersion = packageSetupScriptSpecVersion
elabSetupScriptStyle elabPkgDescription deps
elabSetupPackageDBStack = buildAndRegisterDbs
......@@ -1838,7 +1884,8 @@ pruneInstallPlanPass2 pkgs =
setStanzasDepsAndTargets elab =
elab {
elabBuildTargets = elabBuildTargets elab
++ targetsRequiredForRevDeps,
++ libTargetsRequiredForRevDeps
++ exeTargetsRequiredForRevDeps,
elabPkgOrComp =
case elabPkgOrComp elab of
ElabPackage pkg ->
......@@ -1849,15 +1896,24 @@ pruneInstallPlanPass2 pkgs =
keepNeeded _ _ = True
in ElabPackage $ pkg {
pkgStanzasEnabled = stanzas,
pkgLibDependencies = CD.filterDeps keepNeeded (pkgLibDependencies pkg)
pkgLibDependencies = CD.filterDeps keepNeeded (pkgLibDependencies pkg),
pkgExeDependencies = CD.filterDeps keepNeeded (pkgExeDependencies pkg),
pkgExeDependencyPaths = CD.filterDeps keepNeeded (pkgExeDependencyPaths pkg)
}
r@(ElabComponent _) -> r
}
where
targetsRequiredForRevDeps =
libTargetsRequiredForRevDeps =
[ ComponentTarget Cabal.defaultLibName WholeComponent
| installedUnitId elab `Set.member` hasReverseLibDeps
]
exeTargetsRequiredForRevDeps =
-- TODO: allow requesting executable with different name
-- than package name
[ ComponentTarget (Cabal.CExeName (unPackageName (packageName (elabPkgSourceId elab))))
WholeComponent
| installedUnitId elab `Set.member` hasReverseExeDeps
]
availablePkgs :: Set UnitId
......@@ -1865,8 +1921,15 @@ pruneInstallPlanPass2 pkgs =
hasReverseLibDeps :: Set UnitId
hasReverseLibDeps =
Set.fromList [ depid | pkg <- pkgs
, depid <- InstallPlan.depends pkg ]
Set.fromList [ SimpleUnitId (confInstId depid)
| InstallPlan.Configured pkg <- pkgs
, depid <- elabLibDependencies pkg ]
hasReverseExeDeps :: Set UnitId
hasReverseExeDeps =
Set.fromList [ SimpleUnitId depid
| InstallPlan.Configured pkg <- pkgs
, depid <- elabExeDependencies pkg ]
mapConfiguredPackage :: (srcpkg -> srcpkg')
-> InstallPlan.GenericPlanPackage ipkg srcpkg
......@@ -2436,7 +2499,9 @@ packageHashInputs
ElabPackage (ElaboratedPackage{..}) ->
Set.fromList $
[ confInstId dep
| dep <- CD.select relevantDeps pkgLibDependencies ]
| dep <- CD.select relevantDeps pkgLibDependencies ] ++
[ confInstId dep
| dep <- CD.select relevantDeps pkgExeDependencies ]
ElabComponent comp ->
Set.fromList (map confInstId (compLibDependencies comp)
++ compExeDependencies comp),
......
......@@ -16,6 +16,7 @@ module Distribution.Client.ProjectPlanning.Types (
elabDistDirParams,
elabExeDependencyPaths,
elabLibDependencies,
elabExeDependencies,
elabSetupDependencies,
ElaboratedPackageOrComponent(..),
......@@ -73,6 +74,7 @@ import Data.Set (Set)
import qualified Data.ByteString.Lazy as LBS
import Distribution.Compat.Binary
import GHC.Generics (Generic)
import qualified Data.Monoid as Mon
......@@ -296,9 +298,15 @@ elabLibDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage pk
elabLibDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp }
= compLibDependencies comp
elabExeDependencies :: ElaboratedConfiguredPackage -> [ComponentId]
elabExeDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage pkg }
= map confInstId (CD.nonSetupDeps (pkgExeDependencies pkg))
elabExeDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp }
= compExeDependencies comp
elabExeDependencyPaths :: ElaboratedConfiguredPackage -> [FilePath]
elabExeDependencyPaths ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage _ }
= [] -- TODO: not implemented
elabExeDependencyPaths ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage pkg }
= CD.nonSetupDeps (pkgExeDependencyPaths pkg)
elabExeDependencyPaths ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp }
= compExeDependencyPaths comp
......@@ -353,6 +361,14 @@ data ElaboratedPackage
--
pkgLibDependencies :: ComponentDeps [ConfiguredId],
-- | Dependencies on executable packages.
--
pkgExeDependencies :: ComponentDeps [ConfiguredId],
-- | Paths where executable dependencies live.
--
pkgExeDependencyPaths :: ComponentDeps [FilePath],
-- | Which optional stanzas (ie testsuites, benchmarks) will actually
-- be enabled during the package configure step.
pkgStanzasEnabled :: Set OptionalStanza
......@@ -363,7 +379,8 @@ instance Binary ElaboratedPackage
pkgOrderDependencies :: ElaboratedPackage -> ComponentDeps [UnitId]
pkgOrderDependencies pkg =
fmap (map (SimpleUnitId . confInstId)) (pkgLibDependencies pkg)
fmap (map (SimpleUnitId . confInstId)) (pkgLibDependencies pkg) `Mon.mappend`
fmap (map (SimpleUnitId . confInstId)) (pkgExeDependencies pkg)
-- | This is used in the install plan to indicate how the package will be
-- built.
......
......@@ -125,7 +125,7 @@ showInstallPlan :: SolverInstallPlan -> String
showInstallPlan = showPlanIndex . planIndex
showPlanPackage :: SolverPlanPackage -> String
showPlanPackage (PreExisting ipkg _) = "PreExisting " ++ display (packageId ipkg)
showPlanPackage (PreExisting ipkg) = "PreExisting " ++ display (packageId ipkg)
++ " (" ++ display (installedUnitId ipkg)
++ ")"
showPlanPackage (Configured spkg) = "Configured " ++ display (packageId spkg)
......@@ -207,7 +207,7 @@ showPlanProblem (PackageStateInvalid pkg pkg') =
++ " which is in the " ++ showPlanState pkg'
++ " state"
where
showPlanState (PreExisting _ _) = "pre-existing"
showPlanState (PreExisting _) = "pre-existing"
showPlanState (Configured _) = "configured"
-- | For an invalid plan, produce a detailed list of problems as human readable
......@@ -279,7 +279,7 @@ nonSetupClosure index pkgids0 = closure Graph.empty pkgids0
Just _ -> closure completed pkgids
Nothing -> closure completed' pkgids'
where completed' = Graph.insert pkg completed
pkgids' = CD.nonSetupDeps (resolverPackageDeps pkg) ++ pkgids
pkgids' = CD.nonSetupDeps (resolverPackageLibDeps pkg) ++ pkgids
-- | Compute the root sets of a plan
--
......@@ -310,7 +310,7 @@ libraryRoots index =
-- | The setup dependencies of each package in the plan
setupRoots :: SolverPlanIndex -> [[SolverId]]
setupRoots = filter (not . null)
. map (CD.setupDeps . resolverPackageDeps)
. map (CD.setupDeps . resolverPackageLibDeps)
. Graph.toList
-- | Given a package index where we assume we want to use all the packages
......@@ -342,7 +342,7 @@ dependencyInconsistencies' index =
| -- For each package @pkg@
pkg <- Graph.toList index
-- Find out which @sid@ @pkg@ depends on
, sid <- CD.nonSetupDeps (resolverPackageDeps pkg)
, sid <- CD.nonSetupDeps (resolverPackageLibDeps pkg)
-- And look up those @sid@ (i.e., @sid@ is the ID of @dep@)
, Just dep <- [Graph.lookup sid index]
]
......@@ -358,8 +358,8 @@ dependencyInconsistencies' index =
reallyIsInconsistent [p1, p2] =
let pid1 = nodeKey p1
pid2 = nodeKey p2
in pid1 `notElem` CD.nonSetupDeps (resolverPackageDeps p2)
&& pid2 `notElem` CD.nonSetupDeps (resolverPackageDeps p1)
in pid1 `notElem` CD.nonSetupDeps (resolverPackageLibDeps p2)
&& pid2 `notElem` CD.nonSetupDeps (resolverPackageLibDeps p1)
reallyIsInconsistent _ = True
......
......@@ -82,10 +82,10 @@ extend extSupported langSupported pkgPresent var = foldM extendSingle
extendSingle a (Pkg pn vr) =
if pkgPresent pn vr then Right a
else Left (varToConflictSet var, [Pkg pn vr])
extendSingle a (Dep qpn ci) =
extendSingle a (Dep is_exe qpn ci) =
let ci' = M.findWithDefault (Constrained []) qpn a
in case (\ x -> M.insert qpn x a) <$> merge ci' ci of
Left (c, (d, d')) -> Left (c, L.map (Dep qpn) (simplify (P qpn) d d'))
Left (c, (d, d')) -> Left (c, L.map (Dep is_exe qpn) (simplify (P qpn) d d'))
Right x -> Right x
-- We're trying to remove trivial elements of the conflict. If we're just
......
......@@ -55,7 +55,7 @@ extendOpen qpn' gs s@(BS { rdeps = gs', open = o' }) = go gs' o' gs
-- This is important, because in general, if a goal is inserted twice,
-- the later addition will have better dependency information.
go g o (ng@(OpenGoal (Stanza _ _ ) _gr) : ngs) = go g (cons' ng () o) ngs
go g o (ng@(OpenGoal (Simple (Dep qpn _) c) _gr) : ngs)
go g o (ng@(OpenGoal (Simple (Dep _ qpn _) c) _gr) : ngs)
| qpn == qpn' = go g o ngs
-- we ignore self-dependencies at this point; TODO: more care may be needed
| qpn `M.member` g = go (M.adjust ((c, qpn'):) qpn g) o ngs
......@@ -127,7 +127,7 @@ build = ana go
error "Distribution.Solver.Modular.Builder: build.go called with Lang goal"
go (BS { index = _ , next = OneGoal (OpenGoal (Simple (Pkg _ _ ) _) _ ) }) =
error "Distribution.Solver.Modular.Builder: build.go called with Pkg goal"
go bs@(BS { index = idx, next = OneGoal (OpenGoal (Simple (Dep qpn@(Q _ pn) _) _) gr) }) =
go bs@(BS { index = idx, next = OneGoal (OpenGoal (Simple (Dep _ qpn@(Q _ pn) _) _) gr) }) =
-- If the package does not exist in the index, we construct an emty PChoiceF node for it
-- After all, we have no choices here. Alternatively, we could immediately construct
-- a Fail node here, but that would complicate the construction of conflict sets.
......@@ -186,7 +186,9 @@ buildTree idx (IndependentGoals ind) igs =
, qualifyOptions = defaultQualifyOptions idx
}
where
topLevelGoal qpn = OpenGoal (Simple (Dep qpn (Constrained [])) ()) UserGoal
-- Should a top-level goal allowed to be an executable style
-- dependency? Well, I don't think it would make much difference
topLevelGoal qpn = OpenGoal (Simple (Dep False {- not exe -} qpn (Constrained [])) ()) UserGoal
qpns | ind = makeIndependent igs
| otherwise = L.map (Q (PackagePath DefaultNamespace Unqualified)) igs
......@@ -4,6 +4,7 @@ module Distribution.Solver.Modular.ConfiguredConversion
import Data.Maybe
import Prelude hiding (pi)
import Data.Either (partitionEithers)
import Distribution.Package (UnitId, packageId)
......@@ -18,6 +19,7 @@ import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Types.ResolverPackage
import Distribution.Solver.Types.SolverId
import Distribution.Solver.Types.SolverPackage
import Distribution.Solver.Types.InstSolverPackage
import Distribution.Solver.Types.SourcePackage
-- | Converts from the solver specific result @CP QPN@ into
......@@ -28,27 +30,43 @@ convCP :: SI.InstalledPackageIndex ->
CP QPN -> ResolverPackage loc
convCP iidx sidx (CP qpi fa es ds) =
case convPI qpi of
Left pi -> PreExisting
(fromJust $ SI.lookupUnitId iidx pi) ds'
Right pi -> Configured $ SolverPackage
srcpkg
fa
es
ds'
Left pi -> PreExisting $
InstSolverPackage {
instSolverPkgIPI = fromJust $ SI.lookupUnitId iidx pi,
instSolverPkgLibDeps = fmap fst ds',
instSolverPkgExeDeps = fmap snd ds'
}
Right pi -> Configured $
SolverPackage {
solverPkgSource = srcpkg,
solverPkgFlags = fa,
solverPkgStanzas = es,
solverPkgLibDeps = fmap fst ds',
solverPkgExeDeps = fmap snd ds'
}
where
Just srcpkg = CI.lookupPackageId sidx pi
where
ds' :: ComponentDeps [SolverId]
ds' = fmap (map convConfId) ds
ds' :: ComponentDeps ([SolverId] {- lib -}, [SolverId] {- exe -})
ds' = fmap (partitionEithers . map convConfId) ds
convPI :: PI QPN -> Either UnitId PackageId
convPI (PI _ (I _ (Inst pi))) = Left pi
convPI pi = Right (packageId (convConfId pi))
convPI pi = Right (packageId (either id id (convConfId pi)))
convConfId :: PI QPN -> SolverId
convConfId (PI (Q _ pn) (I v loc)) =
convConfId :: PI QPN -> Either SolverId {- is lib -} SolverId {- is exe -}
convConfId (PI (Q (PackagePath _ q) pn) (I v loc)) =
case loc of
Inst pi -> PreExistingId sourceId pi
_otherwise -> PlannedId sourceId
Inst pi -> Left (PreExistingId sourceId pi)
_otherwise
| Exe _ pn' <- q
-- NB: the dependencies of the executable are also
-- qualified. So the way to tell if this is an executable
-- dependency is to make sure the qualifier is pointing
-- at the actual thing. Fortunately for us, I was
-- silly and didn't allow arbitrarily nested build-tools
-- dependencies, so a shallow check works.
, pn == pn' -> Right (PlannedId sourceId)
| otherwise -> Left (PlannedId sourceId)
where
sourceId = PackageIdentifier pn v
......@@ -165,6 +165,9 @@ flattenFlaggedDeps = concatMap aux
type TrueFlaggedDeps qpn = FlaggedDeps Component qpn
type FalseFlaggedDeps qpn = FlaggedDeps Component qpn
-- | Is this dependency on an executable
type IsExe = Bool
-- | A dependency (constraint) associates a package name with a
-- constrained instance.
--
......@@ -172,20 +175,22 @@ type FalseFlaggedDeps qpn = FlaggedDeps Component qpn
-- is used both to record the dependencies as well as who's doing the
-- depending; having a 'Functor' instance makes bugs where we don't distinguish
-- these two far too likely. (By rights 'Dep' ought to have two type variables.)
data Dep qpn = Dep qpn (CI qpn) -- dependency on a package
data Dep qpn = Dep IsExe qpn (CI qpn) -- dependency on a package (possibly for executable
| Ext Extension -- dependency on a language extension
| Lang Language -- dependency on a language version
| Pkg PN VR -- dependency on a pkg-config package
deriving (Eq, Show)
showDep :: Dep QPN -> String
showDep (Dep qpn (Fixed i v) ) =
showDep (Dep is_exe qpn (Fixed i v) ) =
(if P qpn /= v then showVar v ++ " => " else "") ++
showQPN qpn ++ "==" ++ showI i
showDep (Dep qpn (Constrained [(vr, v)])) =
showVar v ++ " => " ++ showQPN qpn ++ showVR vr
showDep (Dep qpn ci ) =
showQPN qpn ++ showCI ci
showQPN qpn ++
(if is_exe then " (exe) " else "") ++ "==" ++ showI i
showDep (Dep is_exe qpn (Constrained [(vr, v)])) =
showVar v ++ " => " ++ showQPN qpn ++
(if is_exe then " (exe) " else "") ++ showVR vr
showDep (Dep is_exe qpn ci ) =
showQPN qpn ++ (if is_exe then " (exe) " else "") ++ showCI ci
showDep (Ext ext) = "requires " ++ display ext
showDep (Lang lang) = "requires " ++ display lang
showDep (Pkg pn vr) = "requires pkg-config package "
......@@ -237,10 +242,11 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
goD (Ext ext) _ = Ext ext
goD (Lang lang) _ = Lang lang
goD (Pkg pkn vr) _ = Pkg pkn vr
goD (Dep dep ci) comp
| qBase dep = Dep (Q (PackagePath ns (Base pn)) dep) (fmap (Q pp) ci)
| qSetup comp = Dep (Q (PackagePath ns (Setup pn)) dep) (fmap (Q pp) ci)
| otherwise = Dep (Q (PackagePath ns inheritedQ) dep) (fmap (Q pp) ci)
goD (Dep is_exe dep ci) comp
| is_exe = Dep is_exe (Q (PackagePath ns (Exe pn dep)) dep) (fmap (Q pp) ci)
| qBase dep = Dep is_exe (Q (PackagePath ns (Base pn)) dep) (fmap (Q pp) ci)
| qSetup comp = Dep is_exe (Q (PackagePath ns (Setup pn)) dep) (fmap (Q pp) ci)
| otherwise = Dep is_exe (Q (PackagePath ns inheritedQ) dep) (fmap (Q pp) ci)
-- If P has a setup dependency on Q, and Q has a regular dependency on R, then
-- we say that the 'Setup' qualifier is inherited: P has an (indirect) setup
......@@ -252,6 +258,7 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
inheritedQ :: Qualifier
inheritedQ = case q of
Setup _ -> q
Exe _ _ -> q
Unqualified -> q
Base _ -> Unqualified
......@@ -282,7 +289,7 @@ unqualifyDeps = go
go1 (Simple dep comp) = Simple (goD dep) comp
goD :: Dep QPN -> Dep PN
goD (Dep qpn ci) = Dep (unq qpn) (fmap unq ci)
goD (Dep is_exe qpn ci) = Dep is_exe (unq qpn) (fmap unq ci)
goD (Ext ext) = Ext ext
goD (Lang lang) = Lang lang
goD (Pkg pn vr) = Pkg pn vr
......@@ -354,7 +361,7 @@ instance ResetVar CI where
resetVar v (Constrained vrs) = Constrained (L.map (\ (x, y) -> (x, resetVar v y)) vrs)
instance ResetVar Dep where
resetVar v (Dep qpn ci) = Dep qpn (resetVar v ci)
resetVar v (Dep is_exe qpn ci) = Dep is_exe qpn (resetVar v ci)
resetVar _ (Ext ext) = Ext ext
resetVar _ (Lang lang) = Lang lang
resetVar _ (Pkg pn vr) = Pkg pn vr
......@@ -401,7 +408,7 @@ data OpenGoal comp = OpenGoal (FlaggedDep comp QPN) QGoalReason
-- | Closes a goal, i.e., removes all the extraneous information that we
-- need only during the build phase.
close :: OpenGoal comp -> Goal QPN
close (OpenGoal (Simple (Dep qpn _) _) gr) = Goal (P qpn) gr
close (OpenGoal (Simple (Dep _ qpn _) _) gr) = Goal (P qpn) gr
close (OpenGoal (Simple (Ext _) _) _ ) =
error "Distribution.Solver.Modular.Dependency.close: called on Ext goal"
close (OpenGoal (Simple (Lang _) _) _ ) =
......
......@@ -44,7 +44,7 @@ defaultQualifyOptions idx = QO {
-- .. which are installed ..
, (I _ver (Inst _), PInfo deps _flagNfo _fr) <- M.toList is
-- .. and flatten all their dependencies ..
, (Dep dep _ci, _comp) <- flattenFlaggedDeps deps
, (Dep _is_exe dep _ci