Commit b32cfbcf authored by Rob Henderson's avatar Rob Henderson Committed by GitHub
Browse files

Merge pull request #4228 from robjhen/issue-3502-part3

Qualified constraints (issue #3502) part 2
parents b6f17f36 f79a07a7
......@@ -150,7 +150,7 @@ projectFreezeConstraints plan =
versionConstraints :: Map PackageName [(UserConstraint, ConstraintSource)]
versionConstraints =
Map.mapWithKey
(\p v -> [(UserConstraint UserUnqualified p (PackagePropertyVersion v),
(\p v -> [(UserConstraint UserToplevel p (PackagePropertyVersion v),
ConstraintSourceFreeze)])
versionRanges
......@@ -168,7 +168,7 @@ projectFreezeConstraints plan =
flagConstraints :: Map PackageName [(UserConstraint, ConstraintSource)]
flagConstraints =
Map.mapWithKey
(\p f -> [(UserConstraint UserUnqualified p (PackagePropertyFlags f),
(\p f -> [(UserConstraint UserToplevel p (PackagePropertyFlags f),
ConstraintSourceFreeze)])
flagAssignments
......
......@@ -336,7 +336,7 @@ planLocalPackage verbosity comp platform configFlags configExFlags
. addConstraints
-- package flags from the config file or command line
[ let pc = PackageConstraint
(unqualified $ packageName pkg)
(scopeToplevel $ packageName pkg)
(PackagePropertyFlags $ configConfigurationsFlags configFlags)
in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
]
......@@ -344,7 +344,7 @@ planLocalPackage verbosity comp platform configFlags configExFlags
. addConstraints
-- '--enable-tests' and '--enable-benchmarks' constraints from
-- the config file or command line
[ let pc = PackageConstraint (unqualified $ packageName pkg) .
[ let pc = PackageConstraint (scopeToplevel $ packageName pkg) .
PackagePropertyStanzas $
[ TestStanzas | testsEnabled ] ++
[ BenchStanzas | benchmarksEnabled ]
......
......@@ -25,7 +25,7 @@ module Distribution.Client.Dependency (
-- * Constructing resolver policies
PackageProperty(..),
PackageConstraint(..),
unqualified,
scopeToplevel,
PackagesPreferenceDefault(..),
PackagePreference(..),
......@@ -361,7 +361,7 @@ dontUpgradeNonUpgradeablePackages params =
where
extraConstraints =
[ LabeledPackageConstraint
(PackageConstraint (unqualified pkgname) PackagePropertyInstalled)
(PackageConstraint (scopeToplevel pkgname) PackagePropertyInstalled)
ConstraintSourceNonUpgradeablePackage
| Set.notMember (mkPackageName "base") (depResolverTargets params)
-- If you change this enumeration, make sure to update the list in
......@@ -492,7 +492,7 @@ addSetupCabalMinVersionConstraint :: Version
addSetupCabalMinVersionConstraint minVersion =
addConstraints
[ LabeledPackageConstraint
(PackageConstraint (unqualified cabalPkgname)
(PackageConstraint (scopeToplevel cabalPkgname)
(PackagePropertyVersion $ orLaterVersion minVersion))
ConstraintSetupCabalMinVersion
]
......@@ -600,7 +600,7 @@ applySandboxInstallPolicy
. addConstraints
[ let pc = PackageConstraint
(unqualified $ packageName pkg)
(scopeToplevel $ packageName pkg)
(PackagePropertyVersion $ thisVersion (packageVersion pkg))
in LabeledPackageConstraint pc ConstraintSourceModifiedAddSourceDep
| pkg <- modifiedDeps ]
......@@ -946,9 +946,9 @@ resolveWithoutDependencies (DepResolverParams targets constraints
Map.findWithDefault anyVersion pkgname packageVersionConstraintMap
packageVersionConstraintMap =
let pcs = map unlabelPackageConstraint constraints
in Map.fromList [ (name, range)
in Map.fromList [ (scopeToPackageName scope, range)
| PackageConstraint
(Q _ name) (PackagePropertyVersion range) <- pcs ]
scope (PackagePropertyVersion range) <- pcs ]
packagePreferences :: PackageName -> PackagePreferences
packagePreferences = interpretPackagesPreference targets defpref prefs
......
......@@ -183,7 +183,7 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
. addConstraints
[ let pkg = pkgSpecifierTarget pkgSpecifier
pc = PackageConstraint (unqualified pkg)
pc = PackageConstraint (scopeToplevel pkg)
(PackagePropertyStanzas stanzas)
in LabeledPackageConstraint pc ConstraintSourceFreeze
| pkgSpecifier <- pkgSpecifiers ]
......@@ -251,7 +251,7 @@ freezePackages verbosity globalFlags pkgs = do
(pkgIdToConstraint $ packageId pkg, ConstraintSourceUserConfig userPackageEnvironmentFile)
where
pkgIdToConstraint pkgId =
UserConstraint UserUnqualified (packageName pkgId)
UserConstraint UserToplevel (packageName pkgId)
(PackagePropertyVersion $ thisVersion (packageVersion pkgId))
createPkgEnv config = mempty { pkgEnvSavedConfig = config }
showPkgEnv = BS.Char8.pack . showPackageEnvironment
......
......@@ -410,7 +410,7 @@ planPackages comp platform mSandboxPkgInfo solver
--FIXME: this just applies all flags to all targets which
-- is silly. We should check if the flags are appropriate
[ let pc = PackageConstraint
(unqualified $ pkgSpecifierTarget pkgSpecifier)
(scopeToplevel $ pkgSpecifierTarget pkgSpecifier)
(PackagePropertyFlags flags)
in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
| let flags = configConfigurationsFlags configFlags
......@@ -419,7 +419,7 @@ planPackages comp platform mSandboxPkgInfo solver
. addConstraints
[ let pc = PackageConstraint
(unqualified $ pkgSpecifierTarget pkgSpecifier)
(scopeToplevel $ pkgSpecifierTarget pkgSpecifier)
(PackagePropertyStanzas stanzas)
in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
| pkgSpecifier <- pkgSpecifiers ]
......
......@@ -985,7 +985,7 @@ planPackages comp platform solver SolverSettings{..}
. addConstraints
-- enable stanza constraints where the user asked to enable
[ LabeledPackageConstraint
(PackageConstraint (unqualified pkgname)
(PackageConstraint (scopeToplevel pkgname)
(PackagePropertyStanzas stanzas))
ConstraintSourceConfigFlagOrTarget
| pkg <- localPackages
......@@ -1000,7 +1000,7 @@ planPackages comp platform solver SolverSettings{..}
--TODO: [nice to have] should have checked at some point that the
-- package in question actually has these flags.
[ LabeledPackageConstraint
(PackageConstraint (unqualified pkgname)
(PackageConstraint (scopeToplevel pkgname)
(PackagePropertyFlags flags))
ConstraintSourceConfigFlagOrTarget
| (pkgname, flags) <- Map.toList solverSettingFlagAssignments ]
......@@ -1011,7 +1011,7 @@ planPackages comp platform solver SolverSettings{..}
-- former we just apply all these flags to all local targets which
-- is silly. We should check if the flags are appropriate.
[ LabeledPackageConstraint
(PackageConstraint (unqualified pkgname)
(PackageConstraint (scopeToplevel pkgname)
(PackagePropertyFlags flags))
ConstraintSourceConfigFlagOrTarget
| let flags = solverSettingFlagAssignment
......
......@@ -201,13 +201,13 @@ pkgSpecifierConstraints :: Package pkg
pkgSpecifierConstraints (NamedPackage name props) = map toLpc props
where
toLpc prop = LabeledPackageConstraint
(PackageConstraint (unqualified name) prop)
(PackageConstraint (scopeToplevel name) prop)
ConstraintSourceUserTarget
pkgSpecifierConstraints (SpecificSourcePackage pkg) =
[LabeledPackageConstraint pc ConstraintSourceUserTarget]
where
pc = PackageConstraint
(unqualified $ packageName pkg)
(scopeToplevel $ packageName pkg)
(PackagePropertyVersion $ thisVersion (packageVersion pkg))
-- ------------------------------------------------------------
......@@ -690,7 +690,7 @@ extraPackageNameEnv names = PackageNameEnv pkgNameLookup
-- command line.
data UserQualifier =
-- | Top-level dependency.
UserUnqualified
UserToplevel
-- | Setup dependency.
| UserSetup PackageName
......@@ -702,9 +702,9 @@ data UserQualifier =
instance Binary UserQualifier
fromUserQualifier :: UserQualifier -> Qualifier
fromUserQualifier UserUnqualified = Unqualified
fromUserQualifier (UserSetup name) = Setup name
fromUserQualifier (UserExe name1 name2) = Exe name1 name2
fromUserQualifier UserToplevel = QualToplevel
fromUserQualifier (UserSetup name) = QualSetup name
fromUserQualifier (UserExe name1 name2) = QualExe name1 name2
-- | Version of 'PackageConstraint' that the user can specify on
-- the command line.
......@@ -718,7 +718,7 @@ userConstraintPackageName (UserConstraint _ name _) = name
userToPackageConstraint :: UserConstraint -> PackageConstraint
userToPackageConstraint (UserConstraint qual name prop) =
PackageConstraint (Q path name) prop
PackageConstraint (ScopeQualified $ Q path name) prop
where
path = PackagePath DefaultNamespace (fromUserQualifier qual)
......@@ -729,8 +729,9 @@ readUserConstraint str =
Just c -> Right c
where
msgCannotParse =
"expected a package name followed by a constraint, which is "
++ "either a version range, 'installed', 'source' or flags"
"expected a (possibly qualified) package name followed by a " ++
"constraint, which is either a version range, 'installed', " ++
"'source', 'test', 'bench', or flags"
instance Text UserConstraint where
disp (UserConstraint qual name prop) =
......@@ -740,7 +741,7 @@ instance Text UserConstraint where
parse = do
-- Qualified name
pn <- parse
(qual, name) <- return (UserUnqualified, pn)
(qual, name) <- return (UserToplevel, pn)
+++
do _ <- Parse.string ":setup."
pn2 <- parse
......
......@@ -31,7 +31,6 @@ import Distribution.Solver.Modular.Solver
( SolverConfig(..), solve )
import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.PackageConstraint
import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Types.DependencyResolver
import Distribution.System
( Platform(..) )
......@@ -60,4 +59,4 @@ modularResolver sc (Platform arch os) cinfo iidx sidx pkgConfigDB pprefs pcs pns
-- Helper function to extract the PN from a constraint.
pcName :: PackageConstraint -> PN
pcName (PackageConstraint (Q _ pn) _) = pn
pcName (PackageConstraint scope _) = scopeToPackageName scope
......@@ -272,4 +272,4 @@ buildTree idx (IndependentGoals ind) igs =
topLevelGoal qpn = OpenGoal (Simple (Dep False {- not exe -} qpn (Constrained [])) ()) UserGoal
qpns | ind = makeIndependent igs
| otherwise = L.map (Q (PackagePath DefaultNamespace Unqualified)) igs
| otherwise = L.map (Q (PackagePath DefaultNamespace QualToplevel)) igs
......@@ -59,7 +59,7 @@ convConfId (PI (Q (PackagePath _ q) pn) (I v loc)) =
case loc of
Inst pi -> Left (PreExistingId sourceId pi)
_otherwise
| Exe _ pn' <- q
| QualExe _ 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
......
......@@ -244,9 +244,9 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
goD (Lang lang) _ = Lang lang
goD (Pkg pkn vr) _ = Pkg pkn vr
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)
| is_exe = Dep is_exe (Q (PackagePath ns (QualExe pn dep)) dep) (fmap (Q pp) ci)
| qBase dep = Dep is_exe (Q (PackagePath ns (QualBase pn)) dep) (fmap (Q pp) ci)
| qSetup comp = Dep is_exe (Q (PackagePath ns (QualSetup 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
......@@ -258,10 +258,10 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
-- a detailed discussion.
inheritedQ :: Qualifier
inheritedQ = case q of
Setup _ -> q
Exe _ _ -> q
Unqualified -> q
Base _ -> Unqualified
QualSetup _ -> q
QualExe _ _ -> q
QualToplevel -> q
QualBase _ -> QualToplevel
-- Should we qualify this goal with the 'Base' package path?
qBase :: PN -> Bool
......
......@@ -88,22 +88,22 @@ instI _ = False
primaryPP :: PackagePath -> Bool
primaryPP (PackagePath _ns q) = go q
where
go Unqualified = True
go (Base _) = True
go (Setup _) = False
go (Exe _ _) = False
go QualToplevel = True
go (QualBase _) = True
go (QualSetup _) = False
go (QualExe _ _) = False
-- | Is the package a dependency of a setup script. This is used to
-- establish whether or not certain constraints should apply to this
-- dependency (grep 'setupPP' to see the use sites).
--
setupPP :: PackagePath -> Bool
setupPP (PackagePath _ns (Setup _)) = True
setupPP (PackagePath _ns (QualSetup _)) = True
setupPP (PackagePath _ns _) = False
-- | Create artificial parents for each of the package names, making
-- them all independent.
makeIndependent :: [PN] -> [QPN]
makeIndependent ps = [ Q pp pn | (pn, i) <- zip ps [0::Int ..]
, let pp = PackagePath (Independent i) Unqualified
, let pp = PackagePath (Independent i) QualToplevel
]
......@@ -348,8 +348,8 @@ deferSetupChoices = trav go
go x = x
noSetup :: Goal QPN -> Bool
noSetup (Goal (P (Q (PackagePath _ns (Setup _)) _)) _) = False
noSetup _ = True
noSetup (Goal (P (Q (PackagePath _ns (QualSetup _)) _)) _) = False
noSetup _ = True
-- | Transformation that tries to avoid making weak flag choices early.
-- Weak flags are trivial flags (not influencing dependencies) or such
......
......@@ -231,5 +231,5 @@ _removeGR = trav go
dummy :: QGoalReason
dummy = PDependency
$ PI (Q (PackagePath DefaultNamespace Unqualified) (mkPackageName "$"))
$ PI (Q (PackagePath DefaultNamespace QualToplevel) (mkPackageName "$"))
(I (mkVersion [1]) InRepo)
......@@ -6,6 +6,9 @@
-- range or inconsistent flag assignment).
--
module Distribution.Solver.Types.PackageConstraint (
ConstraintScope(..),
scopeToplevel,
scopeToPackageName,
PackageProperty(..),
dispPackageProperty,
PackageConstraint(..),
......@@ -13,11 +16,13 @@ module Distribution.Solver.Types.PackageConstraint (
showPackageConstraint,
) where
import Distribution.Package (PackageName)
import Distribution.Version (VersionRange, simplifyVersionRange)
import Distribution.PackageDescription (FlagAssignment, dispFlagAssignment)
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PackagePath (QPN, dispQPN)
import Distribution.Solver.Types.PackagePath
import Distribution.Client.Compat.Prelude ((<<>>))
import GHC.Generics (Generic)
import Distribution.Compat.Binary (Binary)
......@@ -25,6 +30,32 @@ import Distribution.Text (disp, flatStyle)
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint ((<+>))
-- | Determines to what packages and in what contexts a
-- constraint applies.
data ConstraintScope
-- | The package with the specified qualified name.
= ScopeQualified QPN
-- | The package with the specified name regardless of
-- qualifier.
| ScopeAnyQualifier PackageName
deriving (Eq, Show)
-- | Constructor for a common use case: the constraint applies to
-- the package with the specified name when that package is a
-- top-level dependency in the default namespace.
scopeToplevel :: PackageName -> ConstraintScope
scopeToplevel = ScopeQualified . Q (PackagePath DefaultNamespace QualToplevel)
-- | Returns the package name associated with a constraint scope.
scopeToPackageName :: ConstraintScope -> PackageName
scopeToPackageName (ScopeQualified (Q _ pn)) = pn
scopeToPackageName (ScopeAnyQualifier pn) = pn
-- | Pretty-prints a constraint scope.
dispConstraintScope :: ConstraintScope -> Disp.Doc
dispConstraintScope (ScopeQualified qpn) = dispQPN qpn
dispConstraintScope (ScopeAnyQualifier pn) = Disp.text "any." <<>> disp pn
-- | A package property is a logical predicate on packages.
data PackageProperty
= PackagePropertyVersion VersionRange
......@@ -45,29 +76,27 @@ dispPackageProperty (PackagePropertyFlags flags) = dispFlagAssignment flags
dispPackageProperty (PackagePropertyStanzas stanzas) =
Disp.hsep $ map (Disp.text . showStanza) stanzas
-- | A package constraint consists of a package plus a property
-- that must hold for that package.
data PackageConstraint = PackageConstraint QPN PackageProperty
deriving (Eq, Show, Generic)
instance Binary PackageConstraint
-- | A package constraint consists of a scope plus a property
-- that must hold for all packages within that scope.
data PackageConstraint = PackageConstraint ConstraintScope PackageProperty
deriving (Eq, Show)
-- | Pretty-prints a package constraint.
dispPackageConstraint :: PackageConstraint -> Disp.Doc
dispPackageConstraint (PackageConstraint qpn prop) =
dispQPN qpn <+> dispPackageProperty prop
dispPackageConstraint (PackageConstraint scope prop) =
dispConstraintScope scope <+> dispPackageProperty prop
-- | Alternative textual representation of a package constraint
-- for debugging purposes (slightly more verbose than that
-- produced by 'dispPackageConstraint').
--
showPackageConstraint :: PackageConstraint -> String
showPackageConstraint pc@(PackageConstraint qpn prop) =
showPackageConstraint pc@(PackageConstraint scope prop) =
Disp.renderStyle flatStyle . postprocess $ dispPackageConstraint pc2
where
pc2 = case prop of
PackagePropertyVersion vr ->
PackageConstraint qpn $ PackagePropertyVersion (simplifyVersionRange vr)
PackageConstraint scope $ PackagePropertyVersion (simplifyVersionRange vr)
_ -> pc
postprocess = case prop of
PackagePropertyFlags _ -> (Disp.text "flags" <+>)
......
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Solver.Types.PackagePath
( PackagePath(..)
, Namespace(..)
, Qualifier(..)
, dispQualifier
, Qualified(..)
, unqualified
, QPN
, dispQPN
, showQPN
......@@ -15,15 +13,11 @@ import Distribution.Package
import Distribution.Text
import qualified Text.PrettyPrint as Disp
import Distribution.Client.Compat.Prelude ((<<>>))
import GHC.Generics (Generic)
import Distribution.Compat.Binary (Binary)
-- | A package path consists of a namespace and a package path inside that
-- namespace.
data PackagePath = PackagePath Namespace Qualifier
deriving (Eq, Ord, Show, Generic)
instance Binary PackagePath
deriving (Eq, Ord, Show)
-- | Top-level namespace
--
......@@ -37,12 +31,10 @@ data Namespace =
--
-- For now we just number these (rather than giving them more structure).
| Independent Int
deriving (Eq, Ord, Show, Generic)
instance Binary Namespace
deriving (Eq, Ord, Show)
-- | Pretty-prints a namespace. The result is either empty or
-- ends in a period, so it can be prepended onto a package name.
-- ends in a period, so it can be prepended onto a qualifier.
dispNamespace :: Namespace -> Disp.Doc
dispNamespace DefaultNamespace = Disp.empty
dispNamespace (Independent i) = Disp.int i <<>> Disp.text "."
......@@ -50,12 +42,12 @@ dispNamespace (Independent i) = Disp.int i <<>> Disp.text "."
-- | Qualifier of a package within a namespace (see 'PackagePath')
data Qualifier =
-- | Top-level dependency in this namespace
Unqualified
QualToplevel
-- | Any dependency on base is considered independent
--
-- This makes it possible to have base shims.
| Base PackageName
| QualBase PackageName
-- | Setup dependency
--
......@@ -64,7 +56,7 @@ data Qualifier =
-- are independent from everything else. However, this very quickly leads to
-- infinite search trees in the solver. Therefore we limit ourselves to
-- a single qualifier (within a given namespace).
| Setup PackageName
| QualSetup PackageName
-- | If we depend on an executable from a package (via
-- @build-tools@), we should solve for the dependencies of that
......@@ -76,10 +68,8 @@ data Qualifier =
-- of the depended upon executables from a package; if we
-- tracked only @pn2@, that would require us to pick only one
-- version of an executable over the entire install plan.)
| Exe PackageName PackageName
deriving (Eq, Ord, Show, Generic)
instance Binary Qualifier
| QualExe PackageName PackageName
deriving (Eq, Ord, Show)
-- | Pretty-prints a qualifier. The result is either empty or
-- ends in a period, so it can be prepended onto a package name.
......@@ -90,21 +80,15 @@ instance Binary Qualifier
-- is the qualifier and @"base"@ is the actual dependency (which, for the
-- 'Base' qualifier, will always be @base@).
dispQualifier :: Qualifier -> Disp.Doc
dispQualifier Unqualified = Disp.empty
dispQualifier (Setup pn) = disp pn <<>> Disp.text ":setup."
dispQualifier (Exe pn pn2) = disp pn <<>> Disp.text ":" <<>>
disp pn2 <<>> Disp.text ":exe."
dispQualifier (Base pn) = disp pn <<>> Disp.text "."
dispQualifier QualToplevel = Disp.empty
dispQualifier (QualSetup pn) = disp pn <<>> Disp.text ":setup."
dispQualifier (QualExe pn pn2) = disp pn <<>> Disp.text ":" <<>>
disp pn2 <<>> Disp.text ":exe."
dispQualifier (QualBase pn) = disp pn <<>> Disp.text "."
-- | A qualified entity. Pairs a package path with the entity.
data Qualified a = Q PackagePath a
deriving (Eq, Ord, Show, Generic)
instance Binary a => Binary (Qualified a)
-- | Marks the entity as a top-level dependency in the default namespace.
unqualified :: a -> Qualified a
unqualified = Q (PackagePath DefaultNamespace Unqualified)
deriving (Eq, Ord, Show)
-- | Qualified package name.
type QPN = Qualified PackageName
......
......@@ -567,7 +567,7 @@ instance Arbitrary RemoteRepo where
instance Arbitrary UserConstraint where
arbitrary =
oneof [ UserConstraint UserUnqualified <$> arbitrary <*> prop
oneof [ UserConstraint UserToplevel <$> arbitrary <*> prop
| prop <- [ PackagePropertyVersion <$> arbitrary
, pure PackagePropertyInstalled
, pure PackagePropertySource
......
......@@ -29,7 +29,7 @@ readUserConstraintTest =
pkgName = "template-haskell"
constr = pkgName ++ " installed"
expected = UserConstraint UserUnqualified (mkPackageName pkgName)
expected = UserConstraint UserToplevel (mkPackageName pkgName)
PackagePropertyInstalled
actual = let (Right r) = readUserConstraint constr in r
......@@ -40,7 +40,7 @@ parseUserConstraintTest =
pkgName = "template-haskell"
constr = pkgName ++ " installed"
expected = [UserConstraint UserUnqualified (mkPackageName pkgName)
expected = [UserConstraint UserToplevel (mkPackageName pkgName)
PackagePropertyInstalled]
actual = [ x | (x, ys) <- readP_to_S parseUserConstraint constr
, all isSpace ys]
......@@ -55,7 +55,7 @@ readUserConstraintsTest =
pkgName = "template-haskell"
constr = pkgName ++ " installed"
expected = [[UserConstraint UserUnqualified (mkPackageName pkgName)
expected = [[UserConstraint UserToplevel (mkPackageName pkgName)
PackagePropertyInstalled]]
actual = [ x | (x, ys) <- readP_to_S parseUserConstraints constr
, all isSpace ys]
......
......@@ -545,7 +545,7 @@ exResolve db exts langs pkgConfigDb targets solver mbj indepGoals reorder
}
enableTests
| asBool enableAllTests = fmap (\p -> PackageConstraint
(unqualified (C.mkPackageName p))
(scopeToplevel (C.mkPackageName p))
(PackagePropertyStanzas [TestStanzas]))
(exDbPkgs db)
| otherwise = []
......@@ -582,10 +582,10 @@ exResolve db exts langs pkgConfigDb targets solver mbj indepGoals reorder
toQPN q pn = P.Q pp (C.mkPackageName pn)
where
pp = case q of
None -> P.PackagePath P.DefaultNamespace P.Unqualified
Indep x -> P.PackagePath (P.Independent x) P.Unqualified
Setup p -> P.PackagePath P.DefaultNamespace (P.Setup (C.mkPackageName p))
IndepSetup x p -> P.PackagePath (P.Independent x) (P.Setup (C.mkPackageName p))
None -> P.PackagePath P.DefaultNamespace P.QualToplevel
Indep x -> P.PackagePath (P.Independent x) P.QualToplevel
Setup p -> P.PackagePath P.DefaultNamespace (P.QualSetup (C.mkPackageName p))
IndepSetup x p -> P.PackagePath (P.Independent x) (P.QualSetup (C.mkPackageName p))
extractInstallPlan :: CI.SolverInstallPlan.SolverInstallPlan
-> [(ExamplePkgName, ExamplePkgVersion)]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment