1 module Distribution
.Solver
.Modular
.IndexConversion
8 import Data
.Monoid
as Mon
10 import Prelude
hiding (pi)
12 import Distribution
.Compiler
13 import Distribution
.InstalledPackageInfo
as IPI
14 import Distribution
.Package
-- from Cabal
15 import Distribution
.PackageDescription
as PD
-- from Cabal
16 import Distribution
.PackageDescription
.Configuration
as PDC
17 import qualified Distribution
.Simple
.PackageIndex
as SI
18 import Distribution
.System
19 import Distribution
.Types
.ForeignLib
21 import Distribution
.Solver
.Types
.ComponentDeps
(Component
(..))
22 import Distribution
.Solver
.Types
.OptionalStanza
23 import qualified Distribution
.Solver
.Types
.PackageIndex
as CI
24 import Distribution
.Solver
.Types
.Settings
25 import Distribution
.Solver
.Types
.SourcePackage
27 import Distribution
.Solver
.Modular
.Dependency
as D
28 import Distribution
.Solver
.Modular
.Flag
as F
29 import Distribution
.Solver
.Modular
.Index
30 import Distribution
.Solver
.Modular
.Package
31 import Distribution
.Solver
.Modular
.Tree
32 import Distribution
.Solver
.Modular
.Version
34 -- | Convert both the installed package index and the source package
35 -- index into one uniform solver index.
37 -- We use 'allPackagesBySourcePackageId' for the installed package index
38 -- because that returns us several instances of the same package and version
39 -- in order of preference. This allows us in principle to \"shadow\"
40 -- packages if there are several installed packages of the same version.
41 -- There are currently some shortcomings in both GHC and Cabal in
42 -- resolving these situations. However, the right thing to do is to
43 -- fix the problem there, so for now, shadowing is only activated if
44 -- explicitly requested.
45 convPIs
:: OS
-> Arch
-> CompilerInfo
-> ShadowPkgs
-> StrongFlags
-> SolveExecutables
->
46 SI
.InstalledPackageIndex
-> CI
.PackageIndex
(SourcePackage loc
) -> Index
47 convPIs os arch comp sip strfl sexes iidx sidx
=
48 mkIndex
(convIPI
' sip iidx
++ convSPI
' os arch comp strfl sexes sidx
)
50 -- | Convert a Cabal installed package index to the simpler,
51 -- more uniform index format of the solver.
52 convIPI
' :: ShadowPkgs
-> SI
.InstalledPackageIndex
-> [(PN
, I
, PInfo
)]
53 convIPI
' (ShadowPkgs sip
) idx
=
54 -- apply shadowing whenever there are multiple installed packages with
56 [ maybeShadow
(convIP idx pkg
)
57 |
(_pkgid
, pkgs
) <- SI
.allPackagesBySourcePackageId idx
58 , (maybeShadow
, pkg
) <- zip (id : repeat shadow
) pkgs
]
61 -- shadowing is recorded in the package info
62 shadow
(pn
, i
, PInfo fdeps fds _
) | sip
= (pn
, i
, PInfo fdeps fds
(Just Shadowed
))
65 -- | Convert a single installed package into the solver-specific format.
66 convIP
:: SI
.InstalledPackageIndex
-> InstalledPackageInfo
-> (PN
, I
, PInfo
)
68 case mapM (convIPId pn idx
) (IPI
.depends ipi
) of
69 Nothing
-> (pn
, i
, PInfo
[] M
.empty (Just Broken
))
70 Just fds
-> (pn
, i
, PInfo
(setComp fds
) M
.empty Nothing
)
72 -- We assume that all dependencies of installed packages are _library_ deps
73 ipid
= IPI
.installedUnitId ipi
74 i
= I
(pkgVersion
(sourcePackageId ipi
)) (Inst ipid
)
75 pn
= pkgName
(sourcePackageId ipi
)
76 setComp
= setCompFlaggedDeps ComponentLib
77 -- TODO: Installed packages should also store their encapsulations!
79 -- | Convert dependencies specified by an installed package id into
80 -- flagged dependencies of the solver.
82 -- May return Nothing if the package can't be found in the index. That
83 -- indicates that the original package having this dependency is broken
84 -- and should be ignored.
85 convIPId
:: PN
-> SI
.InstalledPackageIndex
-> UnitId
-> Maybe (FlaggedDep
() PN
)
86 convIPId pn
' idx ipid
=
87 case SI
.lookupUnitId idx ipid
of
89 Just ipi
-> let i
= I
(pkgVersion
(sourcePackageId ipi
)) (Inst ipid
)
90 pn
= pkgName
(sourcePackageId ipi
)
91 in Just
(D
.Simple
(Dep
False pn
(Fixed i
(P pn
'))) ())
92 -- NB: something we pick up from the
93 -- InstalledPackageIndex is NEVER an executable
95 -- | Convert a cabal-install source package index to the simpler,
96 -- more uniform index format of the solver.
97 convSPI
' :: OS
-> Arch
-> CompilerInfo
-> StrongFlags
-> SolveExecutables
->
98 CI
.PackageIndex
(SourcePackage loc
) -> [(PN
, I
, PInfo
)]
99 convSPI
' os arch cinfo strfl sexes
= L
.map (convSP os arch cinfo strfl sexes
) . CI
.allPackages
101 -- | Convert a single source package into the solver-specific format.
102 convSP
:: OS
-> Arch
-> CompilerInfo
-> StrongFlags
-> SolveExecutables
-> SourcePackage loc
-> (PN
, I
, PInfo
)
103 convSP os arch cinfo strfl sexes
(SourcePackage
(PackageIdentifier pn pv
) gpd _ _pl
) =
105 in (pn
, i
, convGPD os arch cinfo strfl sexes
(PI pn i
) gpd
)
107 -- We do not use 'flattenPackageDescription' or 'finalizePD'
108 -- from 'Distribution.PackageDescription.Configuration' here, because we
109 -- want to keep the condition tree, but simplify much of the test.
111 -- | Convert a generic package description to a solver-specific 'PInfo'.
112 convGPD
:: OS
-> Arch
-> CompilerInfo
-> StrongFlags
-> SolveExecutables
->
113 PI PN
-> GenericPackageDescription
-> PInfo
114 convGPD os arch cinfo strfl sexes
pi
115 (GenericPackageDescription pkg flags mlib sub_libs flibs exes tests benchs
) =
117 fds
= flagInfo strfl flags
119 -- | We have to be careful to filter out dependencies on
120 -- internal libraries, since they don't refer to real packages
121 -- and thus cannot actually be solved over. We'll do this
122 -- by creating a set of package names which are "internal"
123 -- and dropping them as we convert.
125 ipns
= S
.fromList
$ [ unqualComponentNameToPackageName nm
126 |
(nm
, _
) <- sub_libs
]
128 conv
:: Mon
.Monoid a
=> Component
-> (a
-> BuildInfo
) ->
129 CondTree ConfVar
[Dependency
] a
-> FlaggedDeps Component PN
130 conv comp getInfo
= convCondTree os arch cinfo
pi fds comp getInfo ipns sexes
.
131 PDC
.addBuildableCondition getInfo
134 = concatMap (\ds
-> conv ComponentLib libBuildInfo ds
) (maybeToList mlib
)
135 ++ concatMap (\(nm
, ds
) -> conv
(ComponentSubLib nm
) libBuildInfo ds
) sub_libs
136 ++ concatMap (\(nm
, ds
) -> conv
(ComponentFLib nm
) foreignLibBuildInfo ds
) flibs
137 ++ concatMap (\(nm
, ds
) -> conv
(ComponentExe nm
) buildInfo ds
) exes
138 ++ prefix
(Stanza
(SN
pi TestStanzas
))
139 (L
.map (\(nm
, ds
) -> conv
(ComponentTest nm
) testBuildInfo ds
) tests
)
140 ++ prefix
(Stanza
(SN
pi BenchStanzas
))
141 (L
.map (\(nm
, ds
) -> conv
(ComponentBench nm
) benchmarkBuildInfo ds
) benchs
)
142 ++ maybe [] (convSetupBuildInfo
pi) (setupBuildInfo pkg
)
145 PInfo flagged_deps fds Nothing
147 -- | Create a flagged dependency tree from a list @fds@ of flagged
148 -- dependencies, using @f@ to form the tree node (@f@ will be
149 -- something like @Stanza sn@).
150 prefix
:: (FlaggedDeps comp qpn
-> FlaggedDep comp
' qpn
)
151 -> [FlaggedDeps comp qpn
] -> FlaggedDeps comp
' qpn
153 prefix f fds
= [f
(concat fds
)]
155 -- | Convert flag information. Automatic flags are now considered weak
156 -- unless strong flags have been selected explicitly.
157 flagInfo
:: StrongFlags
-> [PD
.Flag
] -> FlagInfo
158 flagInfo
(StrongFlags strfl
) =
159 M
.fromList
. L
.map (\ (MkFlag fn _ b m
) -> (fn
, FInfo b m
(weak m
)))
161 weak m
= WeakOrTrivial
$ not (strfl || m
)
163 -- | Internal package names, which should not be interpreted as true
167 -- | Convenience function to delete a 'FlaggedDep' if it's
168 -- for a 'PN' that isn't actually real.
169 filterIPNs
:: IPNs
-> Dependency
-> FlaggedDep Component PN
-> FlaggedDeps Component PN
170 filterIPNs ipns
(Dependency pn _
) fd
171 | S
.notMember pn ipns
= [fd
]
174 -- | Convert condition trees to flagged dependencies. Mutually
175 -- recursive with 'convBranch'. See 'convBranch' for an explanation
176 -- of all arguments preceeding the input 'CondTree'.
177 convCondTree
:: OS
-> Arch
-> CompilerInfo
-> PI PN
-> FlagInfo
->
182 CondTree ConfVar
[Dependency
] a
-> FlaggedDeps Component PN
183 convCondTree os arch cinfo
pi@(PI pn _
) fds comp getInfo ipns sexes
@(SolveExecutables sexes
') (CondNode info ds branches
) =
185 (\d
-> filterIPNs ipns d
(D
.Simple
(convLibDep pn d
) comp
))
186 ds
-- unconditional package dependencies
187 ++ L
.map (\e
-> D
.Simple
(Ext e
) comp
) (PD
.allExtensions bi
) -- unconditional extension dependencies
188 ++ L
.map (\l
-> D
.Simple
(Lang l
) comp
) (PD
.allLanguages bi
) -- unconditional language dependencies
189 ++ L
.map (\(PkgconfigDependency pkn vr
) -> D
.Simple
(Pkg pkn vr
) comp
) (PD
.pkgconfigDepends bi
) -- unconditional pkg-config dependencies
190 ++ concatMap (convBranch os arch cinfo
pi fds comp getInfo ipns sexes
) branches
191 -- build-tools dependencies
192 -- NB: Only include these dependencies if SolveExecutables
193 -- is True. It might be false in the legacy solver
194 -- codepath, in which case there won't be any record of
195 -- an executable we need.
196 ++ [ D
.Simple
(convExeDep pn
(Dependency pn
' vr
)) comp
198 , LegacyExeDependency exe vr
<- PD
.buildTools bi
199 , Just pn
' <- return $ packageProvidingBuildTool exe
204 -- | This function maps known @build-tools@ entries to Haskell package
205 -- names which provide them. This mapping corresponds exactly to
206 -- those build-tools that Cabal understands by default
207 -- ('builtinPrograms'), and are cabal install'able. This mapping is
208 -- purely for legacy; for other executables, @tool-depends@ should be
211 packageProvidingBuildTool
:: String -> Maybe PackageName
212 packageProvidingBuildTool s
=
213 if s `
elem`
["hscolour", "haddock", "happy", "alex", "hsc2hs",
214 "c2hs", "cpphs", "greencard"]
215 then Just
(mkPackageName s
)
218 -- | Branch interpreter. Mutually recursive with 'convCondTree'.
220 -- Here, we try to simplify one of Cabal's condition tree branches into the
221 -- solver's flagged dependency format, which is weaker. Condition trees can
222 -- contain complex logical expression composed from flag choices and special
223 -- flags (such as architecture, or compiler flavour). We try to evaluate the
224 -- special flags and subsequently simplify to a tree that only depends on
225 -- simple flag choices.
227 -- This function takes a number of arguments:
229 -- 1. Some pre dependency-solving known information ('OS', 'Arch',
230 -- 'CompilerInfo') for @os()@, @arch()@ and @impl()@ variables,
232 -- 2. The package instance @'PI' 'PN'@ which this condition tree
233 -- came from, so that we can correctly associate @flag()@
234 -- variables with the correct package name qualifier,
236 -- 3. The flag defaults 'FlagInfo' so that we can populate
237 -- 'Flagged' dependencies with 'FInfo',
239 -- 4. The name of the component 'Component' so we can record where
240 -- the fine-grained information about where the component came
241 -- from (see 'convCondTree'), and
243 -- 5. A selector to extract the 'BuildInfo' from the leaves of
244 -- the 'CondTree' (which actually contains the needed
245 -- dependency information.)
247 -- 6. The set of package names which should be considered internal
248 -- dependencies, and thus not handled as dependencies.
249 convBranch
:: OS
-> Arch
-> CompilerInfo
->
256 CondTree ConfVar
[Dependency
] a
,
257 Maybe (CondTree ConfVar
[Dependency
] a
)) -> FlaggedDeps Component PN
258 convBranch os arch cinfo
pi@(PI pn _
) fds comp getInfo ipns sexes
(c
', t
', mf
') =
259 go c
' ( convCondTree os arch cinfo
pi fds comp getInfo ipns sexes t
')
260 (maybe [] (convCondTree os arch cinfo
pi fds comp getInfo ipns sexes
) mf
')
262 go
:: Condition ConfVar
->
263 FlaggedDeps Component PN
-> FlaggedDeps Component PN
-> FlaggedDeps Component PN
264 go
(Lit
True) t _
= t
265 go
(Lit
False) _ f
= f
266 go
(CNot c
) t f
= go c f t
267 go
(CAnd c d
) t f
= go c
(go d t f
) f
268 go
(COr c d
) t f
= go c t
(go d t f
)
269 go
(Var
(Flag fn
)) t f
= extractCommon t f
++ [Flagged
(FN
pi fn
) (fds
! fn
) t f
]
270 go
(Var
(OS os
')) t f
273 go
(Var
(Arch arch
')) t f
276 go
(Var
(Impl cf cvr
)) t f
277 | matchImpl
(compilerInfoId cinfo
) ||
278 -- fixme: Nothing should be treated as unknown, rather than empty
279 -- list. This code should eventually be changed to either
280 -- support partial resolution of compiler flags or to
281 -- complain about incompletely configured compilers.
282 any matchImpl
(fromMaybe [] $ compilerInfoCompat cinfo
) = t
285 matchImpl
(CompilerId cf
' cv
) = cf
== cf
' && checkVR cvr cv
287 -- If both branches contain the same package as a simple dep, we lift it to
288 -- the next higher-level, but without constraints. This heuristic together
289 -- with deferring flag choices will then usually first resolve this package,
290 -- and try an already installed version before imposing a default flag choice
291 -- that might not be what we want.
293 -- Note that we make assumptions here on the form of the dependencies that
294 -- can occur at this point. In particular, no occurrences of Fixed, and no
295 -- occurrences of multiple version ranges, as all dependencies below this
296 -- point have been generated using 'convLibDep'.
298 -- WARNING: This is quadratic!
299 extractCommon
:: FlaggedDeps Component PN
-> FlaggedDeps Component PN
-> FlaggedDeps Component PN
300 extractCommon ps ps
' = [ D
.Simple
(Dep is_exe1 pn1
(Constrained
[(vr1
.||
. vr2
, P pn
)])) comp
301 | D
.Simple
(Dep is_exe1 pn1
(Constrained
[(vr1
, _
)])) _
<- ps
302 , D
.Simple
(Dep is_exe2 pn2
(Constrained
[(vr2
, _
)])) _
<- ps
'
307 -- | Convert a Cabal dependency on a library to a solver-specific dependency.
308 convLibDep
:: PN
-> Dependency
-> Dep PN
309 convLibDep pn
' (Dependency pn vr
) = Dep
False {- not exe -} pn
(Constrained
[(vr
, P pn
')])
311 -- | Convert a Cabal dependency on a executable (build-tools) to a solver-specific dependency.
312 convExeDep
:: PN
-> Dependency
-> Dep PN
313 convExeDep pn
' (Dependency pn vr
) = Dep
True pn
(Constrained
[(vr
, P pn
')])
315 -- | Convert setup dependencies
316 convSetupBuildInfo
:: PI PN
-> SetupBuildInfo
-> FlaggedDeps Component PN
317 convSetupBuildInfo
(PI pn _i
) nfo
=
318 L
.map (\d
-> D
.Simple
(convLibDep pn d
) ComponentSetup
) (PD
.setupDepends nfo
)