Skip to content

Commit 5181892

Browse files
committed
Add ConstraintSource to local packages
Before: [__0] rejecting: memory-0.18.0 (constraint from user target requires ==0.17.0) After: [__0] rejecting: memory-0.18.0 (constraint from cabal.project requires ==0.17.0)
1 parent f4c0583 commit 5181892

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

46 files changed

+1781
-1043
lines changed

cabal-install-solver/cabal-install-solver.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -76,11 +76,13 @@ library
7676
Distribution.Solver.Modular.WeightedPSQ
7777
Distribution.Solver.Types.ComponentDeps
7878
Distribution.Solver.Types.ConstraintSource
79+
Distribution.Solver.Types.WithConstraintSource
7980
Distribution.Solver.Types.DependencyResolver
8081
Distribution.Solver.Types.Flag
8182
Distribution.Solver.Types.InstalledPreference
8283
Distribution.Solver.Types.InstSolverPackage
8384
Distribution.Solver.Types.LabeledPackageConstraint
85+
Distribution.Solver.Types.NamedPackage
8486
Distribution.Solver.Types.OptionalStanza
8587
Distribution.Solver.Types.PackageConstraint
8688
Distribution.Solver.Types.PackageFixedDeps

cabal-install-solver/src/Distribution/Solver/Types/ConstraintSource.hs

Lines changed: 33 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,8 @@ module Distribution.Solver.Types.ConstraintSource
66

77
import Distribution.Solver.Compat.Prelude
88
import Distribution.Solver.Types.ProjectConfigPath (ProjectConfigPath, docProjectConfigPath)
9-
import Text.PrettyPrint (render)
9+
import Distribution.Pretty (Pretty(pretty), prettyShow)
10+
import Text.PrettyPrint (text)
1011

1112
-- | Source of a 'PackageConstraint'.
1213
data ConstraintSource =
@@ -55,31 +56,40 @@ data ConstraintSource =
5556
-- | An internal constraint due to compatibility issues with the Setup.hs
5657
-- command line interface requires a maximum upper bound on Cabal
5758
| ConstraintSetupCabalMaxVersion
58-
deriving (Eq, Show, Generic)
59+
60+
-- | An implicit constraint added by Cabal.
61+
| ConstraintSourceImplicit
62+
deriving (Show, Eq, Ord, Generic, Typeable)
5963

6064
instance Binary ConstraintSource
6165
instance Structured ConstraintSource
6266

6367
-- | Description of a 'ConstraintSource'.
6468
showConstraintSource :: ConstraintSource -> String
65-
showConstraintSource (ConstraintSourceMainConfig path) =
66-
"main config " ++ path
67-
showConstraintSource (ConstraintSourceProjectConfig path) =
68-
"project config " ++ render (docProjectConfigPath path)
69-
showConstraintSource (ConstraintSourceUserConfig path)= "user config " ++ path
70-
showConstraintSource ConstraintSourceCommandlineFlag = "command line flag"
71-
showConstraintSource ConstraintSourceUserTarget = "user target"
72-
showConstraintSource ConstraintSourceNonReinstallablePackage =
73-
"non-reinstallable package"
74-
showConstraintSource ConstraintSourceFreeze = "cabal freeze"
75-
showConstraintSource ConstraintSourceConfigFlagOrTarget =
76-
"config file, command line flag, or user target"
77-
showConstraintSource ConstraintSourceMultiRepl =
78-
"--enable-multi-repl"
79-
showConstraintSource ConstraintSourceProfiledDynamic =
80-
"--enable-profiling-shared"
81-
showConstraintSource ConstraintSourceUnknown = "unknown source"
82-
showConstraintSource ConstraintSetupCabalMinVersion =
83-
"minimum version of Cabal used by Setup.hs"
84-
showConstraintSource ConstraintSetupCabalMaxVersion =
85-
"maximum version of Cabal used by Setup.hs"
69+
showConstraintSource = prettyShow
70+
71+
instance Pretty ConstraintSource where
72+
pretty constraintSource = case constraintSource of
73+
(ConstraintSourceMainConfig path) ->
74+
text "main config" <+> text path
75+
(ConstraintSourceProjectConfig path) ->
76+
text "project config" <+> docProjectConfigPath path
77+
(ConstraintSourceUserConfig path)-> text "user config " <+> text path
78+
ConstraintSourceCommandlineFlag -> text "command line flag"
79+
ConstraintSourceUserTarget -> text "user target"
80+
ConstraintSourceNonReinstallablePackage ->
81+
text "non-reinstallable package"
82+
ConstraintSourceFreeze -> text "cabal freeze"
83+
ConstraintSourceConfigFlagOrTarget ->
84+
text "config file, command line flag, or user target"
85+
ConstraintSourceMultiRepl ->
86+
text "--enable-multi-repl"
87+
ConstraintSourceProfiledDynamic ->
88+
text "--enable-profiling-shared"
89+
ConstraintSourceUnknown -> text "unknown source"
90+
ConstraintSetupCabalMinVersion ->
91+
text "minimum version of Cabal used by Setup.hs"
92+
ConstraintSetupCabalMaxVersion ->
93+
text "maximum version of Cabal used by Setup.hs"
94+
ConstraintSourceImplicit ->
95+
text "implicit target"
Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
{-# LANGUAGE NamedFieldPuns #-}
2+
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE DeriveFunctor #-}
4+
5+
module Distribution.Solver.Types.NamedPackage
6+
( NamedPackage (..)
7+
, NamedPackageConstraint
8+
) where
9+
10+
import Distribution.Solver.Compat.Prelude
11+
import Prelude ()
12+
13+
import Distribution.Types.PackageName (PackageName)
14+
import Distribution.Solver.Types.PackageConstraint (PackageProperty)
15+
import Distribution.Solver.Types.WithConstraintSource (WithConstraintSource)
16+
import Distribution.Pretty (Pretty (pretty), commaSpaceSep)
17+
import Text.PrettyPrint
18+
19+
-- | A package, identified by a name and properties.
20+
data NamedPackage = NamedPackage PackageName [PackageProperty]
21+
deriving (Show, Eq, Ord, Generic, Typeable)
22+
23+
instance Binary NamedPackage
24+
instance Structured NamedPackage
25+
26+
instance Pretty NamedPackage where
27+
pretty (NamedPackage name properties) =
28+
pretty name <+> parens (commaSpaceSep properties)
29+
30+
type NamedPackageConstraint = WithConstraintSource NamedPackage

cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs

Lines changed: 18 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -11,9 +11,7 @@ module Distribution.Solver.Types.PackageConstraint (
1111
scopeToPackageName,
1212
constraintScopeMatches,
1313
PackageProperty(..),
14-
dispPackageProperty,
1514
PackageConstraint(..),
16-
dispPackageConstraint,
1715
showPackageConstraint,
1816
packageConstraintToDependency
1917
) where
@@ -23,7 +21,7 @@ import Prelude ()
2321

2422
import Distribution.Package (PackageName)
2523
import Distribution.PackageDescription (FlagAssignment, dispFlagAssignment)
26-
import Distribution.Pretty (flatStyle, pretty)
24+
import Distribution.Pretty (flatStyle, Pretty(pretty))
2725
import Distribution.Types.PackageVersionConstraint (PackageVersionConstraint (..))
2826
import Distribution.Version (VersionRange, simplifyVersionRange)
2927

@@ -82,12 +80,11 @@ constraintScopeMatches (ScopeAnySetupQualifier pn) (Q pp pn') =
8280
in setup pp && pn == pn'
8381
constraintScopeMatches (ScopeAnyQualifier pn) (Q _ pn') = pn == pn'
8482

85-
-- | Pretty-prints a constraint scope.
86-
dispConstraintScope :: ConstraintScope -> Disp.Doc
87-
dispConstraintScope (ScopeTarget pn) = pretty pn <<>> Disp.text "." <<>> pretty pn
88-
dispConstraintScope (ScopeQualified q pn) = dispQualifier q <<>> pretty pn
89-
dispConstraintScope (ScopeAnySetupQualifier pn) = Disp.text "setup." <<>> pretty pn
90-
dispConstraintScope (ScopeAnyQualifier pn) = Disp.text "any." <<>> pretty pn
83+
instance Pretty ConstraintScope where
84+
pretty (ScopeTarget pn) = pretty pn <<>> Disp.text "." <<>> pretty pn
85+
pretty (ScopeQualified q pn) = dispQualifier q <<>> pretty pn
86+
pretty (ScopeAnySetupQualifier pn) = Disp.text "setup." <<>> pretty pn
87+
pretty (ScopeAnyQualifier pn) = Disp.text "any." <<>> pretty pn
9188

9289
-- | A package property is a logical predicate on packages.
9390
data PackageProperty
@@ -96,37 +93,35 @@ data PackageProperty
9693
| PackagePropertySource
9794
| PackagePropertyFlags FlagAssignment
9895
| PackagePropertyStanzas [OptionalStanza]
99-
deriving (Eq, Show, Generic)
96+
deriving (Eq, Ord, Show, Generic)
10097

10198
instance Binary PackageProperty
10299
instance Structured PackageProperty
103100

104-
-- | Pretty-prints a package property.
105-
dispPackageProperty :: PackageProperty -> Disp.Doc
106-
dispPackageProperty (PackagePropertyVersion verrange) = pretty verrange
107-
dispPackageProperty PackagePropertyInstalled = Disp.text "installed"
108-
dispPackageProperty PackagePropertySource = Disp.text "source"
109-
dispPackageProperty (PackagePropertyFlags flags) = dispFlagAssignment flags
110-
dispPackageProperty (PackagePropertyStanzas stanzas) =
111-
Disp.hsep $ map (Disp.text . showStanza) stanzas
101+
instance Pretty PackageProperty where
102+
pretty (PackagePropertyVersion verrange) = pretty verrange
103+
pretty PackagePropertyInstalled = Disp.text "installed"
104+
pretty PackagePropertySource = Disp.text "source"
105+
pretty (PackagePropertyFlags flags) = dispFlagAssignment flags
106+
pretty (PackagePropertyStanzas stanzas) =
107+
Disp.hsep $ map (Disp.text . showStanza) stanzas
112108

113109
-- | A package constraint consists of a scope plus a property
114110
-- that must hold for all packages within that scope.
115111
data PackageConstraint = PackageConstraint ConstraintScope PackageProperty
116112
deriving (Eq, Show)
117113

118-
-- | Pretty-prints a package constraint.
119-
dispPackageConstraint :: PackageConstraint -> Disp.Doc
120-
dispPackageConstraint (PackageConstraint scope prop) =
121-
dispConstraintScope scope <+> dispPackageProperty prop
114+
instance Pretty PackageConstraint where
115+
pretty (PackageConstraint scope prop) =
116+
pretty scope <+> pretty prop
122117

123118
-- | Alternative textual representation of a package constraint
124119
-- for debugging purposes (slightly more verbose than that
125120
-- produced by 'dispPackageConstraint').
126121
--
127122
showPackageConstraint :: PackageConstraint -> String
128123
showPackageConstraint pc@(PackageConstraint scope prop) =
129-
Disp.renderStyle flatStyle . postprocess $ dispPackageConstraint pc2
124+
Disp.renderStyle flatStyle . postprocess $ pretty pc2
130125
where
131126
pc2 = case prop of
132127
PackagePropertyVersion vr ->
Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
{-# LANGUAGE DeriveFoldable #-}
2+
{-# LANGUAGE DeriveFunctor #-}
3+
{-# LANGUAGE DeriveGeneric #-}
4+
{-# LANGUAGE DeriveTraversable #-}
5+
{-# LANGUAGE NamedFieldPuns #-}
6+
7+
module Distribution.Solver.Types.WithConstraintSource
8+
( WithConstraintSource (..)
9+
, showWithConstraintSource
10+
, withUnknownConstraint
11+
) where
12+
13+
import Distribution.Solver.Compat.Prelude
14+
15+
import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..), showConstraintSource)
16+
import Distribution.Pretty (Pretty (pretty))
17+
import Text.PrettyPrint
18+
19+
-- | A package bundled with a `ConstraintSource`.
20+
data WithConstraintSource pkg =
21+
WithConstraintSource
22+
{ constraintPackage :: pkg
23+
-- ^ The package.
24+
, constraintConstraint :: ConstraintSource
25+
-- ^ The constraint source for the package.
26+
}
27+
deriving (Show, Functor, Eq, Ord, Traversable, Foldable, Generic, Typeable)
28+
29+
instance Binary pkg => Binary (WithConstraintSource pkg)
30+
instance Structured pkg => Structured (WithConstraintSource pkg)
31+
32+
withUnknownConstraint :: pkg -> WithConstraintSource pkg
33+
withUnknownConstraint constraintPackage =
34+
WithConstraintSource
35+
{ constraintPackage
36+
, constraintConstraint = ConstraintSourceUnknown
37+
}
38+
39+
showWithConstraintSource :: (pkg -> String) -> WithConstraintSource pkg -> String
40+
showWithConstraintSource
41+
showPackage
42+
(WithConstraintSource { constraintPackage, constraintConstraint }) =
43+
showPackage constraintPackage ++ " (" ++ showConstraintSource constraintConstraint ++ ")"
44+
45+
instance Pretty pkg => Pretty (WithConstraintSource pkg) where
46+
pretty (WithConstraintSource { constraintPackage, constraintConstraint = ConstraintSourceUnknown })
47+
= pretty constraintPackage
48+
pretty (WithConstraintSource { constraintPackage, constraintConstraint })
49+
= pretty constraintPackage
50+
<+> parens (text "from" <+> pretty constraintConstraint)

cabal-install/cabal-install.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -243,6 +243,7 @@ library
243243
zlib >= 0.5.3 && < 0.8,
244244
hackage-security >= 0.6.2.0 && < 0.7,
245245
text >= 1.2.3 && < 1.3 || >= 2.0 && < 2.2,
246+
transformers >= 0.2 && <0.7,
246247
parsec >= 3.1.13.0 && < 3.2,
247248
open-browser >= 0.2.1.0 && < 0.3,
248249
regex-base >= 0.94.0.0 && <0.95,

cabal-install/src/Distribution/Client/BuildReports/Storage.hs

Lines changed: 13 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,9 @@ import Distribution.Client.Types
3939

4040
import qualified Distribution.Solver.Types.ComponentDeps as CD
4141
import Distribution.Solver.Types.SourcePackage
42+
import Distribution.Solver.Types.WithConstraintSource
43+
( WithConstraintSource (..)
44+
)
4245

4346
import Distribution.Compiler
4447
( CompilerId (..)
@@ -200,8 +203,16 @@ fromPlanPackage
200203
, extractRepo srcPkg
201204
)
202205
where
203-
extractRepo (SourcePackage{srcpkgSource = RepoTarballPackage repo _ _}) =
204-
Just repo
206+
extractRepo
207+
( SourcePackage
208+
{ srcpkgSource =
209+
WithConstraintSource
210+
{ constraintPackage =
211+
RepoTarballPackage repo _ _
212+
}
213+
}
214+
) =
215+
Just repo
205216
extractRepo _ = Nothing
206217
fromPlanPackage _ _ _ _ = Nothing
207218

cabal-install/src/Distribution/Client/CmdBench.hs

Lines changed: 12 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,12 @@ import Distribution.Simple.Utils
5656
, warn
5757
, wrapText
5858
)
59+
import Distribution.Solver.Types.ConstraintSource
60+
( ConstraintSource (..)
61+
)
62+
import Distribution.Solver.Types.WithConstraintSource
63+
( WithConstraintSource (..)
64+
)
5965
import Distribution.Verbosity
6066
( normal
6167
)
@@ -115,8 +121,11 @@ benchAction flags@NixStyleFlags{..} targetStrings globalFlags = do
115121
baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand
116122

117123
targetSelectors <-
118-
either (reportTargetSelectorProblems verbosity) return
119-
=<< readTargetSelectors (localPackages baseCtx) (Just BenchKind) targetStrings
124+
either (reportTargetSelectorProblems verbosity . map constraintPackage) return
125+
=<< readTargetSelectors
126+
(localPackages baseCtx)
127+
(Just BenchKind)
128+
(map (\target -> WithConstraintSource{constraintPackage = target, constraintConstraint = ConstraintSourceCommandlineFlag}) targetStrings)
120129

121130
buildCtx <-
122131
runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do
@@ -131,7 +140,7 @@ benchAction flags@NixStyleFlags{..} targetStrings globalFlags = do
131140
-- Interpret the targets on the command line as bench targets
132141
-- (as opposed to say build or haddock targets).
133142
targets <-
134-
either (reportTargetProblems verbosity) return $
143+
either (reportTargetProblems verbosity . map constraintPackage) return $
135144
resolveTargets
136145
selectPackageTargets
137146
selectComponentTarget

cabal-install/src/Distribution/Client/CmdBuild.hs

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,12 @@ import Distribution.Client.TargetProblem
2525
( TargetProblem (..)
2626
, TargetProblem'
2727
)
28+
import Distribution.Solver.Types.ConstraintSource
29+
( ConstraintSource (..)
30+
)
31+
import Distribution.Solver.Types.WithConstraintSource
32+
( WithConstraintSource (..)
33+
)
2834

2935
import qualified Data.Map as Map
3036
import Distribution.Client.Errors
@@ -135,7 +141,7 @@ defaultBuildFlags =
135141
-- "Distribution.Client.ProjectOrchestration"
136142
buildAction :: NixStyleFlags BuildFlags -> [String] -> GlobalFlags -> IO ()
137143
buildAction flags@NixStyleFlags{extraFlags = buildFlags, ..} targetStrings globalFlags =
138-
withContextAndSelectors RejectNoTargets Nothing flags targetStrings globalFlags BuildCommand $ \targetCtx ctx targetSelectors -> do
144+
withContextAndSelectors RejectNoTargets Nothing flags (map (\target -> WithConstraintSource{constraintPackage = target, constraintConstraint = ConstraintSourceCommandlineFlag}) targetStrings) globalFlags BuildCommand $ \targetCtx ctx targetSelectors -> do
139145
-- TODO: This flags defaults business is ugly
140146
let onlyConfigure =
141147
fromFlag
@@ -156,7 +162,7 @@ buildAction flags@NixStyleFlags{extraFlags = buildFlags, ..} targetStrings globa
156162
-- Interpret the targets on the command line as build targets
157163
-- (as opposed to say repl or haddock targets).
158164
targets <-
159-
either (reportBuildTargetProblems verbosity) return $
165+
either (reportBuildTargetProblems verbosity . map constraintPackage) return $
160166
resolveTargets
161167
selectPackageTargets
162168
selectComponentTarget

0 commit comments

Comments
 (0)