    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    module Distribution.Solver.Modular
             ( modularResolver, SolverConfig(..), PruneAfterFirstSuccess(..) ) where

    -- Here, we try to map between the external cabal-install solver
    -- interface and the internal interface that the solver actually
    -- expects. There are a number of type conversions to perform: we
    -- have to convert the package indices to the uniform index used
    -- by the solver; we also have to convert the initial constraints;
    -- and finally, we have to convert back the resulting install
    -- plan.

    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

    -- | Ties the two worlds together: classic cabal-install vs. the modular
    -- solver. Performs the necessary translations before and after.
    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 =
      (Assignment -> RevDepMap -> [ResolverPackage loc])
    -> (Assignment, RevDepMap) -> [ResolverPackage loc]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Assignment -> RevDepMap -> [ResolverPackage loc]
    postprocess ((Assignment, RevDepMap) -> [ResolverPackage loc])
    -> Progress String String (Assignment, RevDepMap)
    -> Progress String String [ResolverPackage loc]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> -- convert install plan
      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
          -- Indices have to be converted into solver-specific uniform index.
          idx :: Index
    idx    = OS
    -> Arch
    -> CompilerInfo
    -> Map PackageName [LabeledPackageConstraint]
    -> ShadowPkgs
    -> StrongFlags
    -> SolveExecutables
    -> InstalledPackageIndex
    -> PackageIndex (SourcePackage loc)
    -> Index
    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
          -- Constraints have to be converted into a finite map indexed by PN.
          gcs :: Map PackageName [LabeledPackageConstraint]
    gcs    = ([LabeledPackageConstraint]
     -> [LabeledPackageConstraint] -> [LabeledPackageConstraint])
    -> [(PackageName, [LabeledPackageConstraint])]
    -> Map PackageName [LabeledPackageConstraint]
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    M.fromListWith [LabeledPackageConstraint]
    -> [LabeledPackageConstraint] -> [LabeledPackageConstraint]
    forall a. [a] -> [a] -> [a]
    (++) ((LabeledPackageConstraint
     -> (PackageName, [LabeledPackageConstraint]))
    -> [LabeledPackageConstraint]
    -> [(PackageName, [LabeledPackageConstraint])]
    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 (PackageConstraint -> PackageName)
    -> PackageConstraint -> PackageName
    forall a b. (a -> b) -> a -> b
    $ LabeledPackageConstraint -> PackageConstraint
    unlabelPackageConstraint LabeledPackageConstraint
    lpc, [LabeledPackageConstraint
    lpc])

          -- Results have to be converted into an install plan. 'convCP' removes
          -- package qualifiers, which means that linked packages become duplicates
          -- and can be removed.
          postprocess :: Assignment -> RevDepMap -> [ResolverPackage loc]
    postprocess Assignment
    a RevDepMap
    rdm = (ResolverPackage loc -> SolverId)
    -> [ResolverPackage loc] -> [ResolverPackage loc]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    ordNubBy ResolverPackage loc -> Key (ResolverPackage loc)
    ResolverPackage loc -> SolverId
    forall a. IsNode a => a -> Key a
    nodeKey ([ResolverPackage loc] -> [ResolverPackage loc])
    -> [ResolverPackage loc] -> [ResolverPackage loc]
    forall a b. (a -> b) -> a -> b
    $
                              (CP QPN -> ResolverPackage loc)
    -> [CP QPN] -> [ResolverPackage loc]
    forall a b. (a -> b) -> [a] -> [b]
    map (InstalledPackageIndex
    -> PackageIndex (SourcePackage loc)
    -> CP QPN
    -> ResolverPackage loc
    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)

          -- Helper function to extract the PN from a constraint.
          pcName :: PackageConstraint -> PN
          pcName :: PackageConstraint -> PackageName
    pcName (PackageConstraint ConstraintScope
    scope PackageProperty
    _) = ConstraintScope -> PackageName
    scopeToPackageName ConstraintScope
    scope

    -- | Run 'D.S.Modular.Solver.solve' and then produce a summarized log to display
    -- in the error case.
    --
    -- When there is no solution, we produce the error message by rerunning the
    -- solver but making it prefer the goals from the final conflict set from the
    -- first run (or a subset of the final conflict set with
    -- --minimize-conflict-set). We also set the backjump limit to 0, so that the
    -- log stops at the first backjump and is relatively short. Preferring goals
    -- from the final conflict set increases the probability that the log to the
    -- first backjump contains package, flag, and stanza choices that are relevant
    -- to the final failure. The solver shouldn't need to choose any packages that
    -- aren't in the final conflict set. (For every variable in the final conflict
    -- set, the final conflict set should also contain the variable that introduced
    -- that variable. The solver can then follow that chain of variables in reverse
    -- order from the user target to the conflict.) However, it is possible that the
    -- conflict set contains unnecessary variables.
    --
    -- Producing an error message when the solver reaches the backjump limit is more
    -- complicated. There is no final conflict set, so we create one for the minimal
    -- subtree containing the path that the solver took to the first backjump. This
    -- conflict set helps explain why the solver reached the backjump limit, because
    -- the first backjump contributes to reaching the backjump limit. Additionally,
    -- the solver is much more likely to be able to finish traversing this subtree
    -- before the backjump limit, since its size is linear (not exponential) in the
    -- number of goal choices. We create it by pruning all children after the first
    -- successful child under each node in the original tree, so that there is at
    -- most one valid choice at each level. Then we use the final conflict set from
    -- that run to generate an error message, as in the case where the solver found
    -- that there was no solution.
    --
    -- Using the full log from a rerun of the solver ensures that the log is
    -- complete, i.e., it shows the whole chain of dependencies from the user
    -- targets to the conflicting packages.
    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 =
        RetryLog String String (Assignment, RevDepMap)
    -> Progress String String (Assignment, RevDepMap)
    forall step fail done.
    RetryLog step fail done -> Progress step fail done
    toProgress (RetryLog String String (Assignment, RevDepMap)
     -> Progress String String (Assignment, RevDepMap))
    -> RetryLog String String (Assignment, RevDepMap)
    -> Progress String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $ RetryLog String SolverFailure (Assignment, RevDepMap)
    -> (SolverFailure
        -> RetryLog String String (Assignment, RevDepMap))
    -> RetryLog String String (Assignment, RevDepMap)
    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' =
            Bool
    -> RetryLog Message SolverFailure (Assignment, RevDepMap)
    -> RetryLog String SolverFailure (Assignment, RevDepMap)
    forall a.
    Bool
    -> RetryLog Message SolverFailure a
    -> RetryLog String SolverFailure a
    displayLogMessages Bool
    keepLog (RetryLog Message SolverFailure (Assignment, RevDepMap)
     -> RetryLog String SolverFailure (Assignment, RevDepMap))
    -> RetryLog Message SolverFailure (Assignment, RevDepMap)
    -> RetryLog String SolverFailure (Assignment, RevDepMap)
    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 MinimizeConflictSet -> Bool
    forall a. BooleanFlag a => a -> Bool
    asBool (MinimizeConflictSet -> Bool) -> MinimizeConflictSet -> Bool
    forall a b. (a -> b) -> a -> b
    $ SolverConfig -> MinimizeConflictSet
    minimizeConflictSet SolverConfig
    sc
          then String
    -> RetryLog String String (Assignment, RevDepMap)
    -> RetryLog String String (Assignment, RevDepMap)
    forall step fail done.
    step -> RetryLog step fail done -> RetryLog step fail done
    continueWith (String
    "Found no solution after exhaustively searching the "
                              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "dependency tree. Rerunning the dependency solver "
                              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "to minimize the conflict set ({"
                              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ConflictSet -> String
    showConflictSet ConflictSet
    cs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "}).") (RetryLog String String (Assignment, RevDepMap)
     -> RetryLog String String (Assignment, RevDepMap))
    -> RetryLog String String (Assignment, RevDepMap)
    -> RetryLog String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $
               RetryLog String SolverFailure (Assignment, RevDepMap)
    -> (SolverFailure
        -> RetryLog String String (Assignment, RevDepMap))
    -> RetryLog String String (Assignment, RevDepMap)
    forall step fail1 done fail2.
    RetryLog step fail1 done
    -> (fail1 -> RetryLog step fail2 done) -> RetryLog step fail2 done
    retry ((SolverConfig
     -> RetryLog String SolverFailure (Assignment, RevDepMap))
    -> SolverConfig
    -> ConflictSet
    -> ConflictMap
    -> RetryLog String SolverFailure (Assignment, RevDepMap)
    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) ((SolverFailure -> RetryLog String String (Assignment, RevDepMap))
     -> RetryLog String String (Assignment, RevDepMap))
    -> (SolverFailure
        -> RetryLog String String (Assignment, RevDepMap))
    -> RetryLog String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $
                   \case
                      ExhaustiveSearch ConflictSet
    cs' ConflictMap
    cm' ->
                          Progress String String (Assignment, RevDepMap)
    -> RetryLog String String (Assignment, RevDepMap)
    forall step fail done.
    Progress step fail done -> RetryLog step fail done
    fromProgress (Progress String String (Assignment, RevDepMap)
     -> RetryLog String String (Assignment, RevDepMap))
    -> Progress String String (Assignment, RevDepMap)
    -> RetryLog String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $ String -> Progress String String (Assignment, RevDepMap)
    forall step fail done. fail -> Progress step fail done
    Fail (String -> Progress String String (Assignment, RevDepMap))
    -> String -> Progress String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $
                              ConflictSet -> String
    rerunSolverForErrorMsg ConflictSet
    cs'
                           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SolverConfig -> SolverFailure -> String
    finalErrorMsg SolverConfig
    sc (ConflictSet -> ConflictMap -> SolverFailure
    ExhaustiveSearch ConflictSet
    cs' ConflictMap
    cm')
                      SolverFailure
    BackjumpLimitReached ->
                          Progress String String (Assignment, RevDepMap)
    -> RetryLog String String (Assignment, RevDepMap)
    forall step fail done.
    Progress step fail done -> RetryLog step fail done
    fromProgress (Progress String String (Assignment, RevDepMap)
     -> RetryLog String String (Assignment, RevDepMap))
    -> Progress String String (Assignment, RevDepMap)
    -> RetryLog String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $ String -> Progress String String (Assignment, RevDepMap)
    forall step fail done. fail -> Progress step fail done
    Fail (String -> Progress String String (Assignment, RevDepMap))
    -> String -> Progress String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $
                              String
    "Reached backjump limit while trying to minimize the "
                           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "conflict set to create a better error message. "
                           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Original error message:\n"
                           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ConflictSet -> String
    rerunSolverForErrorMsg ConflictSet
    cs
                           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SolverConfig -> SolverFailure -> String
    finalErrorMsg SolverConfig
    sc SolverFailure
    failure
          else Progress String String (Assignment, RevDepMap)
    -> RetryLog String String (Assignment, RevDepMap)
    forall step fail done.
    Progress step fail done -> RetryLog step fail done
    fromProgress (Progress String String (Assignment, RevDepMap)
     -> RetryLog String String (Assignment, RevDepMap))
    -> Progress String String (Assignment, RevDepMap)
    -> RetryLog String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $ String -> Progress String String (Assignment, RevDepMap)
    forall step fail done. fail -> Progress step fail done
    Fail (String -> Progress String String (Assignment, RevDepMap))
    -> String -> Progress String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $
               ConflictSet -> String
    rerunSolverForErrorMsg ConflictSet
    cs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SolverConfig -> SolverFailure -> String
    finalErrorMsg SolverConfig
    sc SolverFailure
    failure
        createErrorMsg failure :: SolverFailure
    failure@SolverFailure
    BackjumpLimitReached     =
            String
    -> RetryLog String String (Assignment, RevDepMap)
    -> RetryLog String String (Assignment, RevDepMap)
    forall step fail done.
    step -> RetryLog step fail done -> RetryLog step fail done
    continueWith
                 (String
    "Backjump limit reached. Rerunning dependency solver to generate "
                  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "a final conflict set for the search tree containing the "
                  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "first backjump.") (RetryLog String String (Assignment, RevDepMap)
     -> RetryLog String String (Assignment, RevDepMap))
    -> RetryLog String String (Assignment, RevDepMap)
    -> RetryLog String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $
            RetryLog String SolverFailure (Assignment, RevDepMap)
    -> (SolverFailure
        -> RetryLog String String (Assignment, RevDepMap))
    -> RetryLog String String (Assignment, RevDepMap)
    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 True }) ((SolverFailure -> RetryLog String String (Assignment, RevDepMap))
     -> RetryLog String String (Assignment, RevDepMap))
    -> (SolverFailure
        -> RetryLog String String (Assignment, RevDepMap))
    -> RetryLog String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $
                \case
                   ExhaustiveSearch ConflictSet
    cs ConflictMap
    _ ->
                       Progress String String (Assignment, RevDepMap)
    -> RetryLog String String (Assignment, RevDepMap)
    forall step fail done.
    Progress step fail done -> RetryLog step fail done
    fromProgress (Progress String String (Assignment, RevDepMap)
     -> RetryLog String String (Assignment, RevDepMap))
    -> Progress String String (Assignment, RevDepMap)
    -> RetryLog String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $ String -> Progress String String (Assignment, RevDepMap)
    forall step fail done. fail -> Progress step fail done
    Fail (String -> Progress String String (Assignment, RevDepMap))
    -> String -> Progress String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $
                       ConflictSet -> String
    rerunSolverForErrorMsg ConflictSet
    cs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SolverConfig -> SolverFailure -> String
    finalErrorMsg SolverConfig
    sc SolverFailure
    failure
                   SolverFailure
    BackjumpLimitReached  ->
                       -- This case is possible when the number of goals involved in
                       -- conflicts is greater than the backjump limit.
                       Progress String String (Assignment, RevDepMap)
    -> RetryLog String String (Assignment, RevDepMap)
    forall step fail done.
    Progress step fail done -> RetryLog step fail done
    fromProgress (Progress String String (Assignment, RevDepMap)
     -> RetryLog String String (Assignment, RevDepMap))
    -> Progress String String (Assignment, RevDepMap)
    -> RetryLog String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $ String -> Progress String String (Assignment, RevDepMap)
    forall step fail done. fail -> Progress step fail done
    Fail (String -> Progress String String (Assignment, RevDepMap))
    -> String -> Progress String String (Assignment, RevDepMap)
    forall a b. (a -> b) -> a -> b
    $ SolverConfig -> SolverFailure -> String
    finalErrorMsg SolverConfig
    sc SolverFailure
    failure
                        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Failed to generate a summarized dependency solver "
                        String -> String -> String
    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 = Just goalOrder'
                      , maxBackjumps = Just 0
                      }

              -- Preferring goals from the conflict set takes precedence over the
              -- original goal order.
              goalOrder' :: Variable QPN -> Variable QPN -> Ordering
    goalOrder' = ConflictSet -> Variable QPN -> Variable QPN -> Ordering
    preferGoalsFromConflictSet ConflictSet
    cs (Variable QPN -> Variable QPN -> Ordering)
    -> (Variable QPN -> Variable QPN -> Ordering)
    -> Variable QPN
    -> Variable QPN
    -> Ordering
    forall a. Semigroup a => a -> a -> a
    <> (Variable QPN -> Variable QPN -> Ordering)
    -> Maybe (Variable QPN -> Variable QPN -> Ordering)
    -> Variable QPN
    -> Variable QPN
    -> Ordering
    forall a. a -> Maybe a -> a
    fromMaybe Variable QPN -> Variable QPN -> Ordering
    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:" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : Progress String SolverFailure (Assignment, RevDepMap) -> [String]
    forall step fail done. Progress step fail done -> [step]
    messages (RetryLog String SolverFailure (Assignment, RevDepMap)
    -> Progress String SolverFailure (Assignment, RevDepMap)
    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 Verbosity -> Verbosity -> Bool
    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 = (step -> [step] -> [step])
    -> (fail -> [step])
    -> (done -> [step])
    -> Progress step fail done
    -> [step]
    forall step a fail done.
    (step -> a -> a)
    -> (fail -> a) -> (done -> a) -> Progress step fail done -> a
    foldProgress (:) ([step] -> fail -> [step]
    forall a b. a -> b -> a
    const []) ([step] -> done -> [step]
    forall a b. a -> b -> a
    const [])

    -- | Try to remove variables from the given conflict set to create a minimal
    -- conflict set.
    --
    -- Minimal means that no proper subset of the conflict set is also a conflict
    -- set, though there may be other possible conflict sets with fewer variables.
    -- This function minimizes the input by trying to remove one variable at a time.
    -- It only makes one pass over the variables, so it runs the solver at most N
    -- times when given a conflict set of size N. Only one pass is necessary,
    -- because every superset of a conflict set is also a conflict set, meaning that
    -- failing to remove variable X from a conflict set in one step means that X
    -- cannot be removed from any subset of that conflict set in a subsequent step.
    --
    -- Example steps:
    --
    -- Start with {A, B, C}.
    -- Try to remove A from {A, B, C} and fail.
    -- Try to remove B from {A, B, C} and succeed.
    -- Try to remove C from {A, C} and fail.
    -- Return {A, C}
    --
    -- This function can fail for two reasons:
    --
    -- 1. The solver can reach the backjump limit on any run. In this case the
    --    returned RetryLog ends with BackjumpLimitReached.
    --    TODO: Consider applying the backjump limit to all solver runs combined,
    --    instead of each individual run. For example, 10 runs with 10 backjumps
    --    each should count as 100 backjumps.
    -- 2. Since this function works by rerunning the solver, it is possible for the
    --    solver to add new unnecessary variables to the conflict set. This function
    --    discards the result from any run that adds new variables to the conflict
    --    set, but the end result may not be completely minimized.
    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 =
        (RetryLog String SolverFailure a
     -> Var QPN -> RetryLog String SolverFailure a)
    -> RetryLog String SolverFailure a
    -> [Var QPN]
    -> RetryLog String SolverFailure a
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\RetryLog String SolverFailure a
    r Var QPN
    v -> RetryLog String SolverFailure a
    -> (ConflictSet -> ConflictMap -> RetryLog String SolverFailure a)
    -> RetryLog String SolverFailure a
    forall step done.
    RetryLog step SolverFailure done
    -> (ConflictSet -> ConflictMap -> RetryLog step SolverFailure done)
    -> RetryLog step SolverFailure done
    retryNoSolution RetryLog String SolverFailure a
    r ((ConflictSet -> ConflictMap -> RetryLog String SolverFailure a)
     -> RetryLog String SolverFailure a)
    -> (ConflictSet -> ConflictMap -> RetryLog String SolverFailure a)
    -> RetryLog String SolverFailure a
    forall a b. (a -> b) -> a -> b
    $ Var QPN
    -> ConflictSet -> ConflictMap -> RetryLog String SolverFailure a
    tryToRemoveOneVar Var QPN
    v)
              (Progress String SolverFailure a -> RetryLog String SolverFailure a
    forall step fail done.
    Progress step fail done -> RetryLog step fail done
    fromProgress (Progress String SolverFailure a
     -> RetryLog String SolverFailure a)
    -> Progress String SolverFailure a
    -> RetryLog String SolverFailure a
    forall a b. (a -> b) -> a -> b
    $ SolverFailure -> Progress String SolverFailure a
    forall step fail done. fail -> Progress step fail done
    Fail (SolverFailure -> Progress String SolverFailure a)
    -> SolverFailure -> Progress String SolverFailure a
    forall a b. (a -> b) -> a -> b
    $ ConflictSet -> ConflictMap -> SolverFailure
    ExhaustiveSearch ConflictSet
    cs ConflictMap
    cm)
              (ConflictSet -> [Var QPN]
    CS.toList ConflictSet
    cs)
      where
        -- This function runs the solver and makes it prefer goals in the following
        -- order:
        --
        -- 1. variables in 'smallestKnownCS', excluding 'v'
        -- 2. 'v'
        -- 3. all other variables
        --
        -- If 'v' is not necessary, then the solver will find that there is no
        -- solution before starting to solve for 'v', and the new final conflict set
        -- will be very likely to not contain 'v'. If 'v' is necessary, the solver
        -- will most likely need to try solving for 'v' before finding that there is
        -- no solution, and the new final conflict set will still contain 'v'.
        -- However, this method isn't perfect, because it is possible for the solver
        -- to add new unnecessary variables to the conflict set on any run. This
        -- function prevents the conflict set from growing by checking that the new
        -- conflict set is a subset of the old one and falling back to using the old
        -- conflict set when that check fails.
        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
            -- Check whether v is still present, because it may have already been
            -- removed in a previous solver rerun.
          | Bool -> Bool
    not (Var QPN
    v Var QPN -> ConflictSet -> Bool
    `CS.member` ConflictSet
    smallestKnownCS) =
              Progress String SolverFailure a -> RetryLog String SolverFailure a
    forall step fail done.
    Progress step fail done -> RetryLog step fail done
    fromProgress (Progress String SolverFailure a
     -> RetryLog String SolverFailure a)
    -> Progress String SolverFailure a
    -> RetryLog String SolverFailure a
    forall a b. (a -> b) -> a -> b
    $ SolverFailure -> Progress String SolverFailure a
    forall step fail done. fail -> Progress step fail done
    Fail (SolverFailure -> Progress String SolverFailure a)
    -> SolverFailure -> Progress String SolverFailure a
    forall a b. (a -> b) -> a -> b
    $ ConflictSet -> ConflictMap -> SolverFailure
    ExhaustiveSearch ConflictSet
    smallestKnownCS ConflictMap
    smallestKnownCM
          | Bool
    otherwise =
            String
    -> RetryLog String SolverFailure a
    -> RetryLog String SolverFailure a
    forall step fail done.
    step -> RetryLog step fail done -> RetryLog step fail done
    continueWith (String
    "Trying to remove variable " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    varStr String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " from the "
                          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "conflict set.") (RetryLog String SolverFailure a
     -> RetryLog String SolverFailure a)
    -> RetryLog String SolverFailure a
    -> RetryLog String SolverFailure a
    forall a b. (a -> b) -> a -> b
    $
            RetryLog String SolverFailure a
    -> (SolverFailure -> RetryLog String SolverFailure a)
    -> RetryLog String SolverFailure a
    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') ((SolverFailure -> RetryLog String SolverFailure a)
     -> RetryLog String SolverFailure a)
    -> (SolverFailure -> RetryLog String SolverFailure a)
    -> RetryLog String SolverFailure a
    forall a b. (a -> b) -> a -> b
    $ \case
                err :: SolverFailure
    err@(ExhaustiveSearch ConflictSet
    cs' ConflictMap
    _)
                  | ConflictSet -> Set (Var QPN)
    CS.toSet ConflictSet
    cs' Set (Var QPN) -> Set (Var QPN) -> Bool
    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 (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Var QPN -> ConflictSet -> Bool
    CS.member Var QPN
    v ConflictSet
    cs'
                                then String
    "Successfully removed " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    varStr String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " from "
                                      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "the conflict set."
                                else String
    "Failed to remove " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    varStr String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " from the "
                                      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "conflict set."
                      in -- Use the new conflict set, even if v wasn't removed,
                         -- because other variables may have been removed.
                         String -> SolverFailure -> RetryLog String SolverFailure a
    forall step fail done. step -> fail -> RetryLog step fail done
    failWith (String
    msg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " Continuing with " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ConflictSet -> String
    showCS ConflictSet
    cs' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ".") SolverFailure
    err
                  | Bool
    otherwise ->
                      String -> SolverFailure -> RetryLog String SolverFailure a
    forall step fail done. step -> fail -> RetryLog step fail done
    failWith (String
    "Failed to find a smaller conflict set. The new "
                                 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "conflict set is not a subset of the previous "
                                 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "conflict set: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ConflictSet -> String
    showCS ConflictSet
    cs') (SolverFailure -> RetryLog String SolverFailure a)
    -> SolverFailure -> RetryLog String SolverFailure a
    forall a b. (a -> b) -> a -> b
    $
                      ConflictSet -> ConflictMap -> SolverFailure
    ExhaustiveSearch ConflictSet
    smallestKnownCS ConflictMap
    smallestKnownCM
                SolverFailure
    BackjumpLimitReached ->
                    String -> SolverFailure -> RetryLog String SolverFailure a
    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
    "\"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Var QPN -> String
    showVar Var QPN
    v String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\""
            showCS :: ConflictSet -> String
    showCS ConflictSet
    cs' = String
    "{" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ConflictSet -> String
    showConflictSet ConflictSet
    cs' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "}"

            sc' :: SolverConfig
    sc' = SolverConfig
    sc { goalOrder = Just 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)
             (Variable QPN -> Variable QPN -> Ordering)
    -> (Variable QPN -> Variable QPN -> Ordering)
    -> Variable QPN
    -> Variable QPN
    -> Ordering
    forall a. Semigroup a => a -> a -> a
    <> Var QPN -> Variable QPN -> Variable QPN -> Ordering
    preferGoal Var QPN
    v
             (Variable QPN -> Variable QPN -> Ordering)
    -> (Variable QPN -> Variable QPN -> Ordering)
    -> Variable QPN
    -> Variable QPN
    -> Ordering
    forall a. Semigroup a => a -> a -> a
    <> (Variable QPN -> Variable QPN -> Ordering)
    -> Maybe (Variable QPN -> Variable QPN -> Ordering)
    -> Variable QPN
    -> Variable QPN
    -> Ordering
    forall a. a -> Maybe a -> a
    fromMaybe Variable QPN -> Variable QPN -> Ordering
    forall a. Monoid a => a
    mempty (SolverConfig -> Maybe (Variable QPN -> Variable QPN -> Ordering)
    goalOrder SolverConfig
    sc)

        -- Like 'retry', except that it only applies the input function when the
        -- backjump limit has not been reached.
        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 = RetryLog step SolverFailure done
    -> (SolverFailure -> RetryLog step SolverFailure done)
    -> RetryLog step SolverFailure done
    forall step fail1 done fail2.
    RetryLog step fail1 done
    -> (fail1 -> RetryLog step fail2 done) -> RetryLog step fail2 done
    retry RetryLog step SolverFailure done
    lg ((SolverFailure -> RetryLog step SolverFailure done)
     -> RetryLog step SolverFailure done)
    -> (SolverFailure -> RetryLog step SolverFailure done)
    -> RetryLog step SolverFailure done
    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     -> Progress step SolverFailure done
    -> RetryLog step SolverFailure done
    forall step fail done.
    Progress step fail done -> RetryLog step fail done
    fromProgress (SolverFailure -> Progress step SolverFailure done
    forall step fail done. fail -> Progress step fail done
    Fail SolverFailure
    BackjumpLimitReached)

    -- | Goal ordering that chooses goals contained in the conflict set before
    -- other goals.
    preferGoalsFromConflictSet :: ConflictSet
                               -> Variable QPN -> Variable QPN -> Ordering
    preferGoalsFromConflictSet :: ConflictSet -> Variable QPN -> Variable QPN -> Ordering
    preferGoalsFromConflictSet ConflictSet
    cs = (Variable QPN -> Bool) -> Variable QPN -> Variable QPN -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing ((Variable QPN -> Bool)
     -> Variable QPN -> Variable QPN -> Ordering)
    -> (Variable QPN -> Bool)
    -> Variable QPN
    -> Variable QPN
    -> Ordering
    forall a b. (a -> b) -> a -> b
    $ \Variable QPN
    v -> Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Var QPN -> ConflictSet -> Bool
    CS.member (Variable QPN -> Var QPN
    toVar Variable QPN
    v) ConflictSet
    cs

    -- | Goal ordering that chooses the given goal first.
    preferGoal :: Var QPN -> Variable QPN -> Variable QPN -> Ordering
    preferGoal :: Var QPN -> Variable QPN -> Variable QPN -> Ordering
    preferGoal Var QPN
    preferred = (Variable QPN -> Bool) -> Variable QPN -> Variable QPN -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing ((Variable QPN -> Bool)
     -> Variable QPN -> Variable QPN -> Ordering)
    -> (Variable QPN -> Bool)
    -> Variable QPN
    -> Variable QPN
    -> Ordering
    forall a b. (a -> b) -> a -> b
    $ \Variable QPN
    v -> Variable QPN -> Var QPN
    toVar Variable QPN
    v Var QPN -> Var QPN -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Var QPN
    preferred

    toVar :: Variable QPN -> Var QPN
    toVar :: Variable QPN -> Var QPN
    toVar (PackageVar QPN
    qpn)    = QPN -> Var QPN
    forall qpn. qpn -> Var qpn
    P QPN
    qpn
    toVar (FlagVar    QPN
    qpn FlagName
    fn) = FN QPN -> Var QPN
    forall qpn. FN qpn -> Var qpn
    F (QPN -> FlagName -> FN QPN
    forall qpn. qpn -> FlagName -> FN qpn
    FN QPN
    qpn FlagName
    fn)
    toVar (StanzaVar  QPN
    qpn OptionalStanza
    sn) = SN QPN -> Var QPN
    forall qpn. SN qpn -> Var qpn
    S (QPN -> OptionalStanza -> SN QPN
    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, "
              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "these were the goals I've had most trouble fulfilling: "
              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ConflictMap -> ConflictSet -> String
    showCS ConflictMap
    cm ConflictSet
    cs
              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    flagSuggestion
            where
              showCS :: ConflictMap -> ConflictSet -> String
    showCS = if SolverConfig -> Verbosity
    solverVerbosity SolverConfig
    sc Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    > Verbosity
    normal
                       then ConflictMap -> ConflictSet -> String
    CS.showCSWithFrequency
                       else ConflictMap -> ConflictSet -> String
    CS.showCSSortedByFrequency
              flagSuggestion :: String
    flagSuggestion =
                  -- Don't suggest --minimize-conflict-set if the conflict set is
                  -- already small, because it is unlikely to be reduced further.
                  if ConflictSet -> Int
    CS.size ConflictSet
    cs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    3 Bool -> Bool -> Bool
    && Bool -> Bool
    not (MinimizeConflictSet -> Bool
    forall a. BooleanFlag a => a -> Bool
    asBool (SolverConfig -> MinimizeConflictSet
    minimizeConflictSet SolverConfig
    sc))
                  then String
    "\nTry running with --minimize-conflict-set to improve the "
                        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "error message."
                  else String
    ""
          SolverFailure
    BackjumpLimitReached ->
              String
    "Backjump limit reached (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Maybe Int -> String
    forall {a}. Show a => Maybe a -> String
    currlimit (SolverConfig -> Maybe Int
    maxBackjumps SolverConfig
    sc) String -> String -> String
    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 " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", "
                  currlimit Maybe a
    Nothing  = String
    ""