@@ -34,7 +34,7 @@ import Distribution.Solver.Modular.IndexConversion
3434import Distribution.Solver.Modular.Log
3535 ( SolverFailure (.. ), displayLogMessages )
3636import Distribution.Solver.Modular.Package
37- ( PN )
37+ ( PN , showPI )
3838import Distribution.Solver.Modular.RetryLog
3939import Distribution.Solver.Modular.Solver
4040 ( SolverConfig (.. ), PruneAfterFirstSuccess (.. ), solve )
@@ -54,15 +54,37 @@ import Distribution.Simple.Setup
5454import Distribution.Simple.Utils
5555 ( ordNubBy )
5656import Distribution.Verbosity
57+ import Distribution.Solver.Modular.Configured (CP (.. ))
58+ import qualified Distribution.Solver.Types.ComponentDeps as ComponentDeps
59+ import Distribution.Pretty (Pretty (.. ))
60+ import Text.PrettyPrint (text , vcat , Doc , nest , ($+$) )
61+ import Distribution.Solver.Types.OptionalStanza (showStanzas , optStanzaSetNull )
62+ import Distribution.Types.Flag (nullFlagAssignment )
5763
5864
65+ showCP :: CP QPN -> Doc
66+ showCP (CP qpi fa es ds) =
67+ text " package:" <+> text (showPI qpi) $+$ nest 2 (
68+ vcat
69+ [ if nullFlagAssignment fa then mempty else text " flags:" <+> pretty fa
70+ , if optStanzaSetNull es then mempty else text " stanzas:" <+> text (showStanzas es)
71+ , vcat
72+ [ text " component" <+> pretty c $+$
73+ nest 2 (text " dependencies" $+$
74+ nest 2 (vcat [ text (showPI dep) | dep <- deps]))
75+ | (c, deps) <- ComponentDeps. toList ds
76+ ]
77+ ])
78+
5979-- | Ties the two worlds together: classic cabal-install vs. the modular
6080-- solver. Performs the necessary translations before and after.
6181modularResolver :: SolverConfig -> DependencyResolver loc
62- modularResolver sc (Platform arch os) cinfo iidx sidx pkgConfigDB pprefs pcs pns =
63- uncurry postprocess <$> -- convert install plan
64- solve' sc cinfo idx pkgConfigDB pprefs gcs pns
65- where
82+ modularResolver sc (Platform arch os) cinfo iidx sidx pkgConfigDB pprefs pcs pns = do
83+ (assignment, revdepmap) <- solve' sc cinfo idx pkgConfigDB pprefs gcs pns
84+ let cp = toCPs assignment revdepmap
85+ Step (show (vcat (map showCP cp))) $
86+ return $ postprocess assignment revdepmap
87+ where
6688 -- Indices have to be converted into solver-specific uniform index.
6789 idx = convPIs os arch cinfo gcs (shadowPkgs sc) (strongFlags sc) (solveExecutables sc) iidx sidx
6890 -- Constraints have to be converted into a finite map indexed by PN.
0 commit comments