{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.Solver.Modular
( modularResolver, SolverConfig(..), PruneAfterFirstSuccess(..) ) where
import Prelude ()
import Distribution.Solver.Compat.Prelude
import qualified Data.Map as M
import Data.Set (isSubsetOf)
import Distribution.Compat.Graph
( IsNode(..) )
import Distribution.Compiler
( CompilerInfo )
import Distribution.Solver.Modular.Assignment
( Assignment, toCPs )
import Distribution.Solver.Modular.ConfiguredConversion
( convCP )
import qualified Distribution.Solver.Modular.ConflictSet as CS
import Distribution.Solver.Modular.Dependency
import Distribution.Solver.Modular.Flag
import Distribution.Solver.Modular.Index
import Distribution.Solver.Modular.IndexConversion
( convPIs )
import Distribution.Solver.Modular.Log
( SolverFailure(..), displayLogMessages )
import Distribution.Solver.Modular.Package
( PN )
import Distribution.Solver.Modular.RetryLog
import Distribution.Solver.Modular.Solver
( SolverConfig(..), PruneAfterFirstSuccess(..), solve )
import Distribution.Solver.Types.DependencyResolver
import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.PackageConstraint
import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Types.PackagePreferences
import Distribution.Solver.Types.PkgConfigDb
( PkgConfigDb )
import Distribution.Solver.Types.Progress
import Distribution.Solver.Types.Variable
import Distribution.System
( Platform(..) )
import Distribution.Simple.Setup
( BooleanFlag(..) )
import Distribution.Simple.Utils
( ordNubBy )
import Distribution.Verbosity
modularResolver :: SolverConfig -> DependencyResolver loc
modularResolver :: forall loc. SolverConfig -> DependencyResolver loc
modularResolver SolverConfig
sc (Platform Arch
arch OS
os) CompilerInfo
cinfo InstalledPackageIndex
iidx PackageIndex (SourcePackage loc)
sidx PkgConfigDb
pkgConfigDB PackageName -> PackagePreferences
pprefs [LabeledPackageConstraint]
pcs Set PackageName
pns =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Assignment -> RevDepMap -> [ResolverPackage loc]
postprocess) forall a b. (a -> b) -> a -> b
$
SolverConfig
-> CompilerInfo
-> Index
-> PkgConfigDb
-> (PackageName -> PackagePreferences)
-> Map PackageName [LabeledPackageConstraint]
-> Set PackageName
-> Progress String String (Assignment, RevDepMap)
solve' SolverConfig
sc CompilerInfo
cinfo Index
idx PkgConfigDb
pkgConfigDB PackageName -> PackagePreferences
pprefs Map PackageName [LabeledPackageConstraint]
gcs Set PackageName
pns
where
idx :: Index
idx = forall loc.
OS
-> Arch
-> CompilerInfo
-> Map PackageName [LabeledPackageConstraint]
-> ShadowPkgs
-> StrongFlags
-> SolveExecutables
-> InstalledPackageIndex
-> PackageIndex (SourcePackage loc)
-> Index
convPIs OS
os Arch
arch CompilerInfo
cinfo Map PackageName [LabeledPackageConstraint]
gcs (SolverConfig -> ShadowPkgs
shadowPkgs SolverConfig
sc) (SolverConfig -> StrongFlags
strongFlags SolverConfig
sc) (SolverConfig -> SolveExecutables
solveExecutables SolverConfig
sc) InstalledPackageIndex
iidx PackageIndex (SourcePackage loc)
sidx
gcs :: Map PackageName [LabeledPackageConstraint]
gcs = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. [a] -> [a] -> [a]
(++) (forall a b. (a -> b) -> [a] -> [b]
map LabeledPackageConstraint
-> (PackageName, [LabeledPackageConstraint])
pair [LabeledPackageConstraint]
pcs)
where
pair :: LabeledPackageConstraint
-> (PackageName, [LabeledPackageConstraint])
pair LabeledPackageConstraint
lpc = (PackageConstraint -> PackageName
pcName forall a b. (a -> b) -> a -> b
$ LabeledPackageConstraint -> PackageConstraint
unlabelPackageConstraint LabeledPackageConstraint
lpc, [LabeledPackageConstraint
lpc])
postprocess :: Assignment -> RevDepMap -> [ResolverPackage loc]
postprocess Assignment
a RevDepMap
rdm = forall b a. Ord b => (a -> b) -> [a] -> [a]
ordNubBy forall a. IsNode a => a -> Key a
nodeKey forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall loc.
InstalledPackageIndex
-> PackageIndex (SourcePackage loc)
-> CP QPN
-> ResolverPackage loc
convCP InstalledPackageIndex
iidx PackageIndex (SourcePackage loc)
sidx) (Assignment -> RevDepMap -> [CP QPN]
toCPs Assignment
a RevDepMap
rdm)
pcName :: PackageConstraint -> PN
pcName :: PackageConstraint -> PackageName
pcName (PackageConstraint ConstraintScope
scope PackageProperty
_) = ConstraintScope -> PackageName
scopeToPackageName ConstraintScope
scope
solve' :: SolverConfig
-> CompilerInfo
-> Index
-> PkgConfigDb
-> (PN -> PackagePreferences)
-> Map PN [LabeledPackageConstraint]
-> Set PN
-> Progress String String (Assignment, RevDepMap)
solve' :: SolverConfig
-> CompilerInfo
-> Index
-> PkgConfigDb
-> (PackageName -> PackagePreferences)
-> Map PackageName [LabeledPackageConstraint]
-> Set PackageName
-> Progress String String (Assignment, RevDepMap)
solve' SolverConfig
sc CompilerInfo
cinfo Index
idx PkgConfigDb
pkgConfigDB PackageName -> PackagePreferences
pprefs Map PackageName [LabeledPackageConstraint]
gcs Set PackageName
pns =
forall step fail done.
RetryLog step fail done -> Progress step fail done
toProgress forall a b. (a -> b) -> a -> b
$ forall step fail1 done fail2.
RetryLog step fail1 done
-> (fail1 -> RetryLog step fail2 done) -> RetryLog step fail2 done
retry (Bool
-> SolverConfig
-> RetryLog String SolverFailure (Assignment, RevDepMap)
runSolver Bool
printFullLog SolverConfig
sc) SolverFailure -> RetryLog String String (Assignment, RevDepMap)
createErrorMsg
where
runSolver :: Bool -> SolverConfig
-> RetryLog String SolverFailure (Assignment, RevDepMap)
runSolver :: Bool
-> SolverConfig
-> RetryLog String SolverFailure (Assignment, RevDepMap)
runSolver Bool
keepLog SolverConfig
sc' =
forall a.
Bool
-> RetryLog Message SolverFailure a
-> RetryLog String SolverFailure a
displayLogMessages Bool
keepLog forall a b. (a -> b) -> a -> b
$
SolverConfig
-> CompilerInfo
-> Index
-> PkgConfigDb
-> (PackageName -> PackagePreferences)
-> Map PackageName [LabeledPackageConstraint]
-> Set PackageName
-> RetryLog Message SolverFailure (Assignment, RevDepMap)
solve SolverConfig
sc' CompilerInfo
cinfo Index
idx PkgConfigDb
pkgConfigDB PackageName -> PackagePreferences
pprefs Map PackageName [LabeledPackageConstraint]
gcs Set PackageName
pns
createErrorMsg :: SolverFailure
-> RetryLog String String (Assignment, RevDepMap)
createErrorMsg :: SolverFailure -> RetryLog String String (Assignment, RevDepMap)
createErrorMsg failure :: SolverFailure
failure@(ExhaustiveSearch ConflictSet
cs ConflictMap
cm) =
if forall a. BooleanFlag a => a -> Bool
asBool forall a b. (a -> b) -> a -> b
$ SolverConfig -> MinimizeConflictSet
minimizeConflictSet SolverConfig
sc
then forall step fail done.
step -> RetryLog step fail done -> RetryLog step fail done
continueWith (String
"Found no solution after exhaustively searching the "
forall a. [a] -> [a] -> [a]
++ String
"dependency tree. Rerunning the dependency solver "
forall a. [a] -> [a] -> [a]
++ String
"to minimize the conflict set ({"
forall a. [a] -> [a] -> [a]
++ ConflictSet -> String
showConflictSet ConflictSet
cs forall a. [a] -> [a] -> [a]
++ String
"}).") forall a b. (a -> b) -> a -> b
$
forall step fail1 done fail2.
RetryLog step fail1 done
-> (fail1 -> RetryLog step fail2 done) -> RetryLog step fail2 done
retry (forall a.
(SolverConfig -> RetryLog String SolverFailure a)
-> SolverConfig
-> ConflictSet
-> ConflictMap
-> RetryLog String SolverFailure a
tryToMinimizeConflictSet (Bool
-> SolverConfig
-> RetryLog String SolverFailure (Assignment, RevDepMap)
runSolver Bool
printFullLog) SolverConfig
sc ConflictSet
cs ConflictMap
cm) forall a b. (a -> b) -> a -> b
$
\case
ExhaustiveSearch ConflictSet
cs' ConflictMap
cm' ->
forall step fail done.
Progress step fail done -> RetryLog step fail done
fromProgress forall a b. (a -> b) -> a -> b
$ forall step fail done. fail -> Progress step fail done
Fail forall a b. (a -> b) -> a -> b
$
ConflictSet -> String
rerunSolverForErrorMsg ConflictSet
cs'
forall a. [a] -> [a] -> [a]
++ SolverConfig -> SolverFailure -> String
finalErrorMsg SolverConfig
sc (ConflictSet -> ConflictMap -> SolverFailure
ExhaustiveSearch ConflictSet
cs' ConflictMap
cm')
SolverFailure
BackjumpLimitReached ->
forall step fail done.
Progress step fail done -> RetryLog step fail done
fromProgress forall a b. (a -> b) -> a -> b
$ forall step fail done. fail -> Progress step fail done
Fail forall a b. (a -> b) -> a -> b
$
String
"Reached backjump limit while trying to minimize the "
forall a. [a] -> [a] -> [a]
++ String
"conflict set to create a better error message. "
forall a. [a] -> [a] -> [a]
++ String
"Original error message:\n"
forall a. [a] -> [a] -> [a]
++ ConflictSet -> String
rerunSolverForErrorMsg ConflictSet
cs
forall a. [a] -> [a] -> [a]
++ SolverConfig -> SolverFailure -> String
finalErrorMsg SolverConfig
sc SolverFailure
failure
else forall step fail done.
Progress step fail done -> RetryLog step fail done
fromProgress forall a b. (a -> b) -> a -> b
$ forall step fail done. fail -> Progress step fail done
Fail forall a b. (a -> b) -> a -> b
$
ConflictSet -> String
rerunSolverForErrorMsg ConflictSet
cs forall a. [a] -> [a] -> [a]
++ SolverConfig -> SolverFailure -> String
finalErrorMsg SolverConfig
sc SolverFailure
failure
createErrorMsg failure :: SolverFailure
failure@SolverFailure
BackjumpLimitReached =
forall step fail done.
step -> RetryLog step fail done -> RetryLog step fail done
continueWith
(String
"Backjump limit reached. Rerunning dependency solver to generate "
forall a. [a] -> [a] -> [a]
++ String
"a final conflict set for the search tree containing the "
forall a. [a] -> [a] -> [a]
++ String
"first backjump.") forall a b. (a -> b) -> a -> b
$
forall step fail1 done fail2.
RetryLog step fail1 done
-> (fail1 -> RetryLog step fail2 done) -> RetryLog step fail2 done
retry (Bool
-> SolverConfig
-> RetryLog String SolverFailure (Assignment, RevDepMap)
runSolver Bool
printFullLog SolverConfig
sc { pruneAfterFirstSuccess :: PruneAfterFirstSuccess
pruneAfterFirstSuccess = Bool -> PruneAfterFirstSuccess
PruneAfterFirstSuccess Bool
True }) forall a b. (a -> b) -> a -> b
$
\case
ExhaustiveSearch ConflictSet
cs ConflictMap
_ ->
forall step fail done.
Progress step fail done -> RetryLog step fail done
fromProgress forall a b. (a -> b) -> a -> b
$ forall step fail done. fail -> Progress step fail done
Fail forall a b. (a -> b) -> a -> b
$
ConflictSet -> String
rerunSolverForErrorMsg ConflictSet
cs forall a. [a] -> [a] -> [a]
++ SolverConfig -> SolverFailure -> String
finalErrorMsg SolverConfig
sc SolverFailure
failure
SolverFailure
BackjumpLimitReached ->
forall step fail done.
Progress step fail done -> RetryLog step fail done
fromProgress forall a b. (a -> b) -> a -> b
$ forall step fail done. fail -> Progress step fail done
Fail forall a b. (a -> b) -> a -> b
$ SolverConfig -> SolverFailure -> String
finalErrorMsg SolverConfig
sc SolverFailure
failure
forall a. [a] -> [a] -> [a]
++ String
"Failed to generate a summarized dependency solver "
forall a. [a] -> [a] -> [a]
++ String
"log due to low backjump limit."
rerunSolverForErrorMsg :: ConflictSet -> String
rerunSolverForErrorMsg :: ConflictSet -> String
rerunSolverForErrorMsg ConflictSet
cs =
let sc' :: SolverConfig
sc' = SolverConfig
sc {
goalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering)
goalOrder = forall a. a -> Maybe a
Just Variable QPN -> Variable QPN -> Ordering
goalOrder'
, maxBackjumps :: Maybe Int
maxBackjumps = forall a. a -> Maybe a
Just Int
0
}
goalOrder' :: Variable QPN -> Variable QPN -> Ordering
goalOrder' = ConflictSet -> Variable QPN -> Variable QPN -> Ordering
preferGoalsFromConflictSet ConflictSet
cs forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty (SolverConfig -> Maybe (Variable QPN -> Variable QPN -> Ordering)
goalOrder SolverConfig
sc)
in [String] -> String
unlines (String
"Could not resolve dependencies:" forall a. a -> [a] -> [a]
: forall step fail done. Progress step fail done -> [step]
messages (forall step fail done.
RetryLog step fail done -> Progress step fail done
toProgress (Bool
-> SolverConfig
-> RetryLog String SolverFailure (Assignment, RevDepMap)
runSolver Bool
True SolverConfig
sc')))
printFullLog :: Bool
printFullLog = SolverConfig -> Verbosity
solverVerbosity SolverConfig
sc forall a. Ord a => a -> a -> Bool
>= Verbosity
verbose
messages :: Progress step fail done -> [step]
messages :: forall step fail done. Progress step fail done -> [step]
messages = forall step a fail done.
(step -> a -> a)
-> (fail -> a) -> (done -> a) -> Progress step fail done -> a
foldProgress (:) (forall a b. a -> b -> a
const []) (forall a b. a -> b -> a
const [])
tryToMinimizeConflictSet :: forall a . (SolverConfig -> RetryLog String SolverFailure a)
-> SolverConfig
-> ConflictSet
-> ConflictMap
-> RetryLog String SolverFailure a
tryToMinimizeConflictSet :: forall a.
(SolverConfig -> RetryLog String SolverFailure a)
-> SolverConfig
-> ConflictSet
-> ConflictMap
-> RetryLog String SolverFailure a
tryToMinimizeConflictSet SolverConfig -> RetryLog String SolverFailure a
runSolver SolverConfig
sc ConflictSet
cs ConflictMap
cm =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\RetryLog String SolverFailure a
r Var QPN
v -> forall step done.
RetryLog step SolverFailure done
-> (ConflictSet -> ConflictMap -> RetryLog step SolverFailure done)
-> RetryLog step SolverFailure done
retryNoSolution RetryLog String SolverFailure a
r forall a b. (a -> b) -> a -> b
$ Var QPN
-> ConflictSet -> ConflictMap -> RetryLog String SolverFailure a
tryToRemoveOneVar Var QPN
v)
(forall step fail done.
Progress step fail done -> RetryLog step fail done
fromProgress forall a b. (a -> b) -> a -> b
$ forall step fail done. fail -> Progress step fail done
Fail forall a b. (a -> b) -> a -> b
$ ConflictSet -> ConflictMap -> SolverFailure
ExhaustiveSearch ConflictSet
cs ConflictMap
cm)
(ConflictSet -> [Var QPN]
CS.toList ConflictSet
cs)
where
tryToRemoveOneVar :: Var QPN
-> ConflictSet
-> ConflictMap
-> RetryLog String SolverFailure a
tryToRemoveOneVar :: Var QPN
-> ConflictSet -> ConflictMap -> RetryLog String SolverFailure a
tryToRemoveOneVar Var QPN
v ConflictSet
smallestKnownCS ConflictMap
smallestKnownCM
| Bool -> Bool
not (Var QPN
v Var QPN -> ConflictSet -> Bool
`CS.member` ConflictSet
smallestKnownCS) =
forall step fail done.
Progress step fail done -> RetryLog step fail done
fromProgress forall a b. (a -> b) -> a -> b
$ forall step fail done. fail -> Progress step fail done
Fail forall a b. (a -> b) -> a -> b
$ ConflictSet -> ConflictMap -> SolverFailure
ExhaustiveSearch ConflictSet
smallestKnownCS ConflictMap
smallestKnownCM
| Bool
otherwise =
forall step fail done.
step -> RetryLog step fail done -> RetryLog step fail done
continueWith (String
"Trying to remove variable " forall a. [a] -> [a] -> [a]
++ String
varStr forall a. [a] -> [a] -> [a]
++ String
" from the "
forall a. [a] -> [a] -> [a]
++ String
"conflict set.") forall a b. (a -> b) -> a -> b
$
forall step fail1 done fail2.
RetryLog step fail1 done
-> (fail1 -> RetryLog step fail2 done) -> RetryLog step fail2 done
retry (SolverConfig -> RetryLog String SolverFailure a
runSolver SolverConfig
sc') forall a b. (a -> b) -> a -> b
$ \case
err :: SolverFailure
err@(ExhaustiveSearch ConflictSet
cs' ConflictMap
_)
| ConflictSet -> Set (Var QPN)
CS.toSet ConflictSet
cs' forall a. Ord a => Set a -> Set a -> Bool
`isSubsetOf` ConflictSet -> Set (Var QPN)
CS.toSet ConflictSet
smallestKnownCS ->
let msg :: String
msg = if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Var QPN -> ConflictSet -> Bool
CS.member Var QPN
v ConflictSet
cs'
then String
"Successfully removed " forall a. [a] -> [a] -> [a]
++ String
varStr forall a. [a] -> [a] -> [a]
++ String
" from "
forall a. [a] -> [a] -> [a]
++ String
"the conflict set."
else String
"Failed to remove " forall a. [a] -> [a] -> [a]
++ String
varStr forall a. [a] -> [a] -> [a]
++ String
" from the "
forall a. [a] -> [a] -> [a]
++ String
"conflict set."
in
forall step fail done. step -> fail -> RetryLog step fail done
failWith (String
msg forall a. [a] -> [a] -> [a]
++ String
" Continuing with " forall a. [a] -> [a] -> [a]
++ ConflictSet -> String
showCS ConflictSet
cs' forall a. [a] -> [a] -> [a]
++ String
".") SolverFailure
err
| Bool
otherwise ->
forall step fail done. step -> fail -> RetryLog step fail done
failWith (String
"Failed to find a smaller conflict set. The new "
forall a. [a] -> [a] -> [a]
++ String
"conflict set is not a subset of the previous "
forall a. [a] -> [a] -> [a]
++ String
"conflict set: " forall a. [a] -> [a] -> [a]
++ ConflictSet -> String
showCS ConflictSet
cs') forall a b. (a -> b) -> a -> b
$
ConflictSet -> ConflictMap -> SolverFailure
ExhaustiveSearch ConflictSet
smallestKnownCS ConflictMap
smallestKnownCM
SolverFailure
BackjumpLimitReached ->
forall step fail done. step -> fail -> RetryLog step fail done
failWith (String
"Reached backjump limit while minimizing conflict set.")
SolverFailure
BackjumpLimitReached
where
varStr :: String
varStr = String
"\"" forall a. [a] -> [a] -> [a]
++ Var QPN -> String
showVar Var QPN
v forall a. [a] -> [a] -> [a]
++ String
"\""
showCS :: ConflictSet -> String
showCS ConflictSet
cs' = String
"{" forall a. [a] -> [a] -> [a]
++ ConflictSet -> String
showConflictSet ConflictSet
cs' forall a. [a] -> [a] -> [a]
++ String
"}"
sc' :: SolverConfig
sc' = SolverConfig
sc { goalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering)
goalOrder = forall a. a -> Maybe a
Just Variable QPN -> Variable QPN -> Ordering
goalOrder' }
goalOrder' :: Variable QPN -> Variable QPN -> Ordering
goalOrder' =
ConflictSet -> Variable QPN -> Variable QPN -> Ordering
preferGoalsFromConflictSet (Var QPN
v Var QPN -> ConflictSet -> ConflictSet
`CS.delete` ConflictSet
smallestKnownCS)
forall a. Semigroup a => a -> a -> a
<> Var QPN -> Variable QPN -> Variable QPN -> Ordering
preferGoal Var QPN
v
forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty (SolverConfig -> Maybe (Variable QPN -> Variable QPN -> Ordering)
goalOrder SolverConfig
sc)
retryNoSolution :: RetryLog step SolverFailure done
-> (ConflictSet -> ConflictMap -> RetryLog step SolverFailure done)
-> RetryLog step SolverFailure done
retryNoSolution :: forall step done.
RetryLog step SolverFailure done
-> (ConflictSet -> ConflictMap -> RetryLog step SolverFailure done)
-> RetryLog step SolverFailure done
retryNoSolution RetryLog step SolverFailure done
lg ConflictSet -> ConflictMap -> RetryLog step SolverFailure done
f = forall step fail1 done fail2.
RetryLog step fail1 done
-> (fail1 -> RetryLog step fail2 done) -> RetryLog step fail2 done
retry RetryLog step SolverFailure done
lg forall a b. (a -> b) -> a -> b
$ \case
ExhaustiveSearch ConflictSet
cs' ConflictMap
cm' -> ConflictSet -> ConflictMap -> RetryLog step SolverFailure done
f ConflictSet
cs' ConflictMap
cm'
SolverFailure
BackjumpLimitReached -> forall step fail done.
Progress step fail done -> RetryLog step fail done
fromProgress (forall step fail done. fail -> Progress step fail done
Fail SolverFailure
BackjumpLimitReached)
preferGoalsFromConflictSet :: ConflictSet
-> Variable QPN -> Variable QPN -> Ordering
preferGoalsFromConflictSet :: ConflictSet -> Variable QPN -> Variable QPN -> Ordering
preferGoalsFromConflictSet ConflictSet
cs = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a -> b) -> a -> b
$ \Variable QPN
v -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Var QPN -> ConflictSet -> Bool
CS.member (Variable QPN -> Var QPN
toVar Variable QPN
v) ConflictSet
cs
preferGoal :: Var QPN -> Variable QPN -> Variable QPN -> Ordering
preferGoal :: Var QPN -> Variable QPN -> Variable QPN -> Ordering
preferGoal Var QPN
preferred = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a -> b) -> a -> b
$ \Variable QPN
v -> Variable QPN -> Var QPN
toVar Variable QPN
v forall a. Eq a => a -> a -> Bool
/= Var QPN
preferred
toVar :: Variable QPN -> Var QPN
toVar :: Variable QPN -> Var QPN
toVar (PackageVar QPN
qpn) = forall qpn. qpn -> Var qpn
P QPN
qpn
toVar (FlagVar QPN
qpn FlagName
fn) = forall qpn. FN qpn -> Var qpn
F (forall qpn. qpn -> FlagName -> FN qpn
FN QPN
qpn FlagName
fn)
toVar (StanzaVar QPN
qpn OptionalStanza
sn) = forall qpn. SN qpn -> Var qpn
S (forall qpn. qpn -> OptionalStanza -> SN qpn
SN QPN
qpn OptionalStanza
sn)
finalErrorMsg :: SolverConfig -> SolverFailure -> String
finalErrorMsg :: SolverConfig -> SolverFailure -> String
finalErrorMsg SolverConfig
sc SolverFailure
failure =
case SolverFailure
failure of
ExhaustiveSearch ConflictSet
cs ConflictMap
cm ->
String
"After searching the rest of the dependency tree exhaustively, "
forall a. [a] -> [a] -> [a]
++ String
"these were the goals I've had most trouble fulfilling: "
forall a. [a] -> [a] -> [a]
++ ConflictMap -> ConflictSet -> String
showCS ConflictMap
cm ConflictSet
cs
forall a. [a] -> [a] -> [a]
++ String
flagSuggestion
where
showCS :: ConflictMap -> ConflictSet -> String
showCS = if SolverConfig -> Verbosity
solverVerbosity SolverConfig
sc forall a. Ord a => a -> a -> Bool
> Verbosity
normal
then ConflictMap -> ConflictSet -> String
CS.showCSWithFrequency
else ConflictMap -> ConflictSet -> String
CS.showCSSortedByFrequency
flagSuggestion :: String
flagSuggestion =
if ConflictSet -> Int
CS.size ConflictSet
cs forall a. Ord a => a -> a -> Bool
> Int
3 Bool -> Bool -> Bool
&& Bool -> Bool
not (forall a. BooleanFlag a => a -> Bool
asBool (SolverConfig -> MinimizeConflictSet
minimizeConflictSet SolverConfig
sc))
then String
"\nTry running with --minimize-conflict-set to improve the "
forall a. [a] -> [a] -> [a]
++ String
"error message."
else String
""
SolverFailure
BackjumpLimitReached ->
String
"Backjump limit reached (" forall a. [a] -> [a] -> [a]
++ forall {a}. Show a => Maybe a -> String
currlimit (SolverConfig -> Maybe Int
maxBackjumps SolverConfig
sc) forall a. [a] -> [a] -> [a]
++
String
"change with --max-backjumps or try to run with --reorder-goals).\n"
where currlimit :: Maybe a -> String
currlimit (Just a
n) = String
"currently " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
n forall a. [a] -> [a] -> [a]
++ String
", "
currlimit Maybe a
Nothing = String
""