    {-# LANGUAGE ScopedTypeVariables #-}
    -- | Reordering or pruning the tree in order to prefer or make certain choices.
    module Distribution.Solver.Modular.Preference
        ( avoidReinstalls
        , deferSetupExeChoices
        , deferWeakFlagChoices
        , enforceManualFlags
        , enforcePackageConstraints
        , enforceSingleInstanceRestriction
        , firstGoal
        , preferBaseGoalChoice
        , preferLinked
        , preferPackagePreferences
        , preferReallyEasyGoalChoices
        , onlyConstrained
        , sortGoals
        , pruneAfterFirstSuccess
        ) where

    import Prelude ()
    import Distribution.Solver.Compat.Prelude

    import qualified Data.List as L
    import qualified Data.Map as M
    import Control.Monad.Trans.Reader (Reader, runReader, ask, local)

    import Distribution.PackageDescription (lookupFlagAssignment, unFlagAssignment) -- from Cabal

    import Distribution.Solver.Types.Flag
    import Distribution.Solver.Types.InstalledPreference
    import Distribution.Solver.Types.LabeledPackageConstraint
    import Distribution.Solver.Types.OptionalStanza
    import Distribution.Solver.Types.PackageConstraint
    import Distribution.Solver.Types.PackagePath
    import Distribution.Solver.Types.PackagePreferences
    import Distribution.Solver.Types.Variable

    import Distribution.Solver.Modular.Dependency
    import Distribution.Solver.Modular.Flag
    import Distribution.Solver.Modular.Package
    import qualified Distribution.Solver.Modular.PSQ as P
    import Distribution.Solver.Modular.Tree
    import Distribution.Solver.Modular.Version
    import qualified Distribution.Solver.Modular.ConflictSet as CS
    import qualified Distribution.Solver.Modular.WeightedPSQ as W

    -- | Update the weights of children under 'PChoice' nodes. 'addWeights' takes a
    -- list of weight-calculating functions in order to avoid sorting the package
    -- choices multiple times. Each function takes the package name, sorted list of
    -- children's versions, and package option. 'addWeights' prepends the new
    -- weights to the existing weights, which gives precedence to preferences that
    -- are applied later.
    addWeights :: [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
    addWeights :: forall d c. [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
    addWeights [PN -> [Ver] -> POption -> Weight]
    fs = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go
      where
        go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
        go :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go (PChoiceF qpn :: QPN
    qpn@(Q PackagePath
    _ PN
    pn) RevDepMap
    rdm c
    x WeightedPSQ [Weight] POption (Tree d c)
    cs) =
          let sortedVersions :: [Ver]
    sortedVersions = (Ver -> Ver -> Ordering) -> [Ver] -> [Ver]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    L.sortBy ((Ver -> Ver -> Ordering) -> Ver -> Ver -> Ordering
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Ver -> Ver -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare) ([Ver] -> [Ver]) -> [Ver] -> [Ver]
    forall a b. (a -> b) -> a -> b
    $ (POption -> Ver) -> [POption] -> [Ver]
    forall a b. (a -> b) -> [a] -> [b]
    L.map POption -> Ver
    version (WeightedPSQ [Weight] POption (Tree d c) -> [POption]
    forall w k v. WeightedPSQ w k v -> [k]
    W.keys WeightedPSQ [Weight] POption (Tree d c)
    cs)
              weights :: POption -> [Weight]
    weights POption
    k = [PN -> [Ver] -> POption -> Weight
    f PN
    pn [Ver]
    sortedVersions POption
    k | PN -> [Ver] -> POption -> Weight
    f <- [PN -> [Ver] -> POption -> Weight]
    fs]

              elemsToWhnf :: [a] -> ()
              elemsToWhnf :: forall a. [a] -> ()
    elemsToWhnf = (a -> () -> ()) -> () -> [a] -> ()
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr a -> () -> ()
    forall a b. a -> b -> b
    seq ()
          in  QPN
    -> RevDepMap
    -> c
    -> WeightedPSQ [Weight] POption (Tree d c)
    -> TreeF d c (Tree d c)
    forall d c a.
    QPN
    -> RevDepMap -> c -> WeightedPSQ [Weight] POption a -> TreeF d c a
    PChoiceF QPN
    qpn RevDepMap
    rdm c
    x
              -- Evaluate the children's versions before evaluating any of the
              -- subtrees, so that 'sortedVersions' doesn't hold onto all of the
              -- subtrees (referenced by cs) and cause a space leak.
              ([Ver] -> ()
    forall a. [a] -> ()
    elemsToWhnf [Ver]
    sortedVersions ()
    -> WeightedPSQ [Weight] POption (Tree d c)
    -> WeightedPSQ [Weight] POption (Tree d c)
    forall a b. a -> b -> b
    `seq`
                 (POption -> [Weight] -> [Weight])
    -> WeightedPSQ [Weight] POption (Tree d c)
    -> WeightedPSQ [Weight] POption (Tree d c)
    forall w2 k w1 v.
    Ord w2 =>
    (k -> w1 -> w2) -> WeightedPSQ w1 k v -> WeightedPSQ w2 k v
    W.mapWeightsWithKey (\POption
    k [Weight]
    w -> POption -> [Weight]
    weights POption
    k [Weight] -> [Weight] -> [Weight]
    forall a. [a] -> [a] -> [a]
    ++ [Weight]
    w) WeightedPSQ [Weight] POption (Tree d c)
    cs)
        go TreeF d c (Tree d c)
    x                            = TreeF d c (Tree d c)
    x

    addWeight :: (PN -> [Ver] -> POption -> Weight) -> EndoTreeTrav d c
    addWeight :: forall d c. (PN -> [Ver] -> POption -> Weight) -> EndoTreeTrav d c
    addWeight PN -> [Ver] -> POption -> Weight
    f = [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
    forall d c. [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
    addWeights [PN -> [Ver] -> POption -> Weight
    f]

    version :: POption -> Ver
    version :: POption -> Ver
    version (POption (I Ver
    v Loc
    _) Maybe PackagePath
    _) = Ver
    v

    -- | Prefer to link packages whenever possible.
    preferLinked :: EndoTreeTrav d c
    preferLinked :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    preferLinked = (PN -> [Ver] -> POption -> Weight) -> EndoTreeTrav d c
    forall d c. (PN -> [Ver] -> POption -> Weight) -> EndoTreeTrav d c
    addWeight (([Ver] -> POption -> Weight) -> PN -> [Ver] -> POption -> Weight
    forall a b. a -> b -> a
    const ((POption -> Weight) -> [Ver] -> POption -> Weight
    forall a b. a -> b -> a
    const POption -> Weight
    forall {a}. Num a => POption -> a
    linked))
      where
        linked :: POption -> a
    linked (POption I
    _ Maybe PackagePath
    Nothing)  = a
    1
        linked (POption I
    _ (Just PackagePath
    _)) = a
    0

    -- Works by setting weights on choice nodes. Also applies stanza preferences.
    preferPackagePreferences :: (PN -> PackagePreferences) -> EndoTreeTrav d c
    preferPackagePreferences :: forall d c. (PN -> PackagePreferences) -> EndoTreeTrav d c
    preferPackagePreferences PN -> PackagePreferences
    pcs =
        (PN -> PackagePreferences) -> EndoTreeTrav d c
    forall d c. (PN -> PackagePreferences) -> EndoTreeTrav d c
    preferPackageStanzaPreferences PN -> PackagePreferences
    pcs EndoTreeTrav d c -> EndoTreeTrav d c -> EndoTreeTrav d c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        -- Each package is assigned a list of weights (currently three of them),
        -- and options are ordered by comparison of these lists.
        --
        -- The head of the list (and thus the top priority for ordering)
        -- is whether the package version is "preferred"
        -- (https://hackage.haskell.org/packages/preferred-versions).
        --
        -- The next two elements depend on 'PackagePreferences'.
        -- For 'PreferInstalled' they are whether the version is installed (0 or 1)
        -- and how close is the version to the latest one (between 0.0 and 1.0).
        -- For 'PreferLatest' the weights are the same, but swapped, so that
        -- ordering considers how new is the package first.
        -- For 'PreferOldest' one weight measures how close is the version to the
        -- the oldest one possible (between 0.0 and 1.0) and another checks whether
        -- the version is installed (0 or 1).
        [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
    forall d c. [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
    addWeights [
              \PN
    pn [Ver]
    _  POption
    opt -> PN -> POption -> Weight
    preferred PN
    pn POption
    opt
            , \PN
    pn [Ver]
    vs POption
    opt -> case PN -> InstalledPreference
    preference PN
    pn of
                              InstalledPreference
    PreferInstalled -> POption -> Weight
    installed POption
    opt
                              InstalledPreference
    PreferLatest    -> [Ver] -> POption -> Weight
    latest [Ver]
    vs POption
    opt
                              InstalledPreference
    PreferOldest    -> [Ver] -> POption -> Weight
    oldest [Ver]
    vs POption
    opt
            , \PN
    pn [Ver]
    vs POption
    opt -> case PN -> InstalledPreference
    preference PN
    pn of
                              InstalledPreference
    PreferInstalled -> [Ver] -> POption -> Weight
    latest [Ver]
    vs POption
    opt
                              InstalledPreference
    PreferLatest    -> POption -> Weight
    installed POption
    opt
                              InstalledPreference
    PreferOldest    -> POption -> Weight
    installed POption
    opt
            ]
      where
        -- Prefer packages with higher version numbers over packages with
        -- lower version numbers.
        latest :: [Ver] -> POption -> Weight
        latest :: [Ver] -> POption -> Weight
    latest [Ver]
    sortedVersions POption
    opt =
          let l :: Int
    l = [Ver] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Ver]
    sortedVersions
              index :: Int
    index = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    l (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ (Ver -> Bool) -> [Ver] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    L.findIndex (Ver -> Ver -> Bool
    forall a. Ord a => a -> a -> Bool
    <= POption -> Ver
    version POption
    opt) [Ver]
    sortedVersions
          in  Int -> Weight
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    index Weight -> Weight -> Weight
    forall a. Fractional a => a -> a -> a
    / Int -> Weight
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    l

        -- Prefer packages with lower version numbers over packages with
        -- higher version numbers.
        oldest :: [Ver] -> POption -> Weight
        oldest :: [Ver] -> POption -> Weight
    oldest [Ver]
    sortedVersions POption
    opt = Weight
    1 Weight -> Weight -> Weight
    forall a. Num a => a -> a -> a
    - [Ver] -> POption -> Weight
    latest [Ver]
    sortedVersions POption
    opt

        preference :: PN -> InstalledPreference
        preference :: PN -> InstalledPreference
    preference PN
    pn =
          let PackagePreferences [VersionRange]
    _ InstalledPreference
    ipref [OptionalStanza]
    _ = PN -> PackagePreferences
    pcs PN
    pn
          in  InstalledPreference
    ipref

        -- | Prefer versions satisfying more preferred version ranges.
        preferred :: PN -> POption -> Weight
        preferred :: PN -> POption -> Weight
    preferred PN
    pn POption
    opt =
          let PackagePreferences [VersionRange]
    vrs InstalledPreference
    _ [OptionalStanza]
    _ = PN -> PackagePreferences
    pcs PN
    pn
          in Int -> Weight
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Weight)
    -> ([VersionRange] -> Int) -> [VersionRange] -> Weight
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int
    forall a. Num a => a -> a
    negate (Int -> Int) -> ([VersionRange] -> Int) -> [VersionRange] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [VersionRange] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    L.length ([VersionRange] -> Weight) -> [VersionRange] -> Weight
    forall a b. (a -> b) -> a -> b
    $
             (VersionRange -> Bool) -> [VersionRange] -> [VersionRange]
    forall a. (a -> Bool) -> [a] -> [a]
    L.filter ((VersionRange -> Ver -> Bool) -> Ver -> VersionRange -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip VersionRange -> Ver -> Bool
    checkVR (POption -> Ver
    version POption
    opt)) [VersionRange]
    vrs

        -- Prefer installed packages over non-installed packages.
        installed :: POption -> Weight
        installed :: POption -> Weight
    installed (POption (I Ver
    _ (Inst PId
    _)) Maybe PackagePath
    _) = Weight
    0
        installed POption
    _                          = Weight
    1

    -- | Traversal that tries to establish package stanza enable\/disable
    -- preferences. Works by reordering the branches of stanza choices.
    -- Note that this works on packages lower in the path as well as at the top level.
    -- This is because stanza preferences apply to local packages only
    -- and for local packages, a single version is fixed, which means
    -- (for now) that all stanza preferences must be uniform at all levels.
    -- Further, even when we can have multiple versions of the same package,
    -- the build plan will be more efficient if we can attempt to keep
    -- stanza preferences aligned at all levels.
    preferPackageStanzaPreferences :: (PN -> PackagePreferences) -> EndoTreeTrav d c
    preferPackageStanzaPreferences :: forall d c. (PN -> PackagePreferences) -> EndoTreeTrav d c
    preferPackageStanzaPreferences PN -> PackagePreferences
    pcs = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    forall {d} {c} {a}. TreeF d c a -> TreeF d c a
    go
      where
        go :: TreeF d c a -> TreeF d c a
    go (SChoiceF qsn :: QSN
    qsn@(SN (Q PackagePath
    _pp PN
    pn) OptionalStanza
    s) RevDepMap
    rdm c
    gr WeakOrTrivial
    _tr WeightedPSQ [Weight] Bool a
    ts)
          | PN -> OptionalStanza -> Bool
    enableStanzaPref PN
    pn OptionalStanza
    s =
              -- move True case first to try enabling the stanza
              let ts' :: WeightedPSQ [Weight] Bool a
    ts' = (Bool -> [Weight] -> [Weight])
    -> WeightedPSQ [Weight] Bool a -> WeightedPSQ [Weight] Bool a
    forall w2 k w1 v.
    Ord w2 =>
    (k -> w1 -> w2) -> WeightedPSQ w1 k v -> WeightedPSQ w2 k v
    W.mapWeightsWithKey (\Bool
    k [Weight]
    w -> Bool -> Weight
    forall {a}. Num a => Bool -> a
    weight Bool
    k Weight -> [Weight] -> [Weight]
    forall a. a -> [a] -> [a]
    : [Weight]
    w) WeightedPSQ [Weight] Bool a
    ts
                  weight :: Bool -> a
    weight Bool
    k = if Bool
    k then a
    0 else a
    1
              -- defer the choice by setting it to weak
              in  QSN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> WeightedPSQ [Weight] Bool a
    -> TreeF d c a
    forall d c a.
    QSN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> WeightedPSQ [Weight] Bool a
    -> TreeF d c a
    SChoiceF QSN
    qsn RevDepMap
    rdm c
    gr (Bool -> WeakOrTrivial
    WeakOrTrivial Bool
    True) WeightedPSQ [Weight] Bool a
    ts'
        go TreeF d c a
    x = TreeF d c a
    x

        enableStanzaPref :: PN -> OptionalStanza -> Bool
        enableStanzaPref :: PN -> OptionalStanza -> Bool
    enableStanzaPref PN
    pn OptionalStanza
    s =
          let PackagePreferences [VersionRange]
    _ InstalledPreference
    _ [OptionalStanza]
    spref = PN -> PackagePreferences
    pcs PN
    pn
          in  OptionalStanza
    s OptionalStanza -> [OptionalStanza] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [OptionalStanza]
    spref

    -- | Helper function that tries to enforce a single package constraint on a
    -- given instance for a P-node. Translates the constraint into a
    -- tree-transformer that either leaves the subtree untouched, or replaces it
    -- with an appropriate failure node.
    processPackageConstraintP :: forall d c. QPN
                              -> ConflictSet
                              -> I
                              -> LabeledPackageConstraint
                              -> Tree d c
                              -> Tree d c
    processPackageConstraintP :: forall d c.
    QPN
    -> ConflictSet
    -> I
    -> LabeledPackageConstraint
    -> Tree d c
    -> Tree d c
    processPackageConstraintP QPN
    qpn ConflictSet
    c I
    i (LabeledPackageConstraint (PackageConstraint ConstraintScope
    scope PackageProperty
    prop) ConstraintSource
    src) Tree d c
    r =
        if ConstraintScope -> QPN -> Bool
    constraintScopeMatches ConstraintScope
    scope QPN
    qpn
        then I -> PackageProperty -> Tree d c
    go I
    i PackageProperty
    prop
        else Tree d c
    r
      where
        go :: I -> PackageProperty -> Tree d c
        go :: I -> PackageProperty -> Tree d c
    go (I Ver
    v Loc
    _) (PackagePropertyVersion VersionRange
    vr)
            | VersionRange -> Ver -> Bool
    checkVR VersionRange
    vr Ver
    v  = Tree d c
    r
            | Bool
    otherwise     = ConflictSet -> FailReason -> Tree d c
    forall d c. ConflictSet -> FailReason -> Tree d c
    Fail ConflictSet
    c (VersionRange -> ConstraintSource -> FailReason
    GlobalConstraintVersion VersionRange
    vr ConstraintSource
    src)
        go I
    _       PackageProperty
    PackagePropertyInstalled
            | I -> Bool
    instI I
    i       = Tree d c
    r
            | Bool
    otherwise     = ConflictSet -> FailReason -> Tree d c
    forall d c. ConflictSet -> FailReason -> Tree d c
    Fail ConflictSet
    c (ConstraintSource -> FailReason
    GlobalConstraintInstalled ConstraintSource
    src)
        go I
    _       PackageProperty
    PackagePropertySource
            | Bool -> Bool
    not (I -> Bool
    instI I
    i) = Tree d c
    r
            | Bool
    otherwise     = ConflictSet -> FailReason -> Tree d c
    forall d c. ConflictSet -> FailReason -> Tree d c
    Fail ConflictSet
    c (ConstraintSource -> FailReason
    GlobalConstraintSource ConstraintSource
    src)
        go I
    _       PackageProperty
    _        = Tree d c
    r

    -- | Helper function that tries to enforce a single package constraint on a
    -- given flag setting for an F-node. Translates the constraint into a
    -- tree-transformer that either leaves the subtree untouched, or replaces it
    -- with an appropriate failure node.
    processPackageConstraintF :: forall d c. QPN
                              -> Flag
                              -> ConflictSet
                              -> Bool
                              -> LabeledPackageConstraint
                              -> Tree d c
                              -> Tree d c
    processPackageConstraintF :: forall d c.
    QPN
    -> Flag
    -> ConflictSet
    -> Bool
    -> LabeledPackageConstraint
    -> Tree d c
    -> Tree d c
    processPackageConstraintF QPN
    qpn Flag
    f ConflictSet
    c Bool
    b' (LabeledPackageConstraint (PackageConstraint ConstraintScope
    scope PackageProperty
    prop) ConstraintSource
    src) Tree d c
    r =
        if ConstraintScope -> QPN -> Bool
    constraintScopeMatches ConstraintScope
    scope QPN
    qpn
        then PackageProperty -> Tree d c
    go PackageProperty
    prop
        else Tree d c
    r
      where
        go :: PackageProperty -> Tree d c
        go :: PackageProperty -> Tree d c
    go (PackagePropertyFlags FlagAssignment
    fa) =
            case Flag -> FlagAssignment -> Maybe Bool
    lookupFlagAssignment Flag
    f FlagAssignment
    fa of
              Maybe Bool
    Nothing            -> Tree d c
    r
              Just Bool
    b | Bool
    b Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    b'   -> Tree d c
    r
                     | Bool
    otherwise -> ConflictSet -> FailReason -> Tree d c
    forall d c. ConflictSet -> FailReason -> Tree d c
    Fail ConflictSet
    c (ConstraintSource -> FailReason
    GlobalConstraintFlag ConstraintSource
    src)
        go PackageProperty
    _                             = Tree d c
    r

    -- | Helper function that tries to enforce a single package constraint on a
    -- given flag setting for an F-node. Translates the constraint into a
    -- tree-transformer that either leaves the subtree untouched, or replaces it
    -- with an appropriate failure node.
    processPackageConstraintS :: forall d c. QPN
                              -> OptionalStanza
                              -> ConflictSet
                              -> Bool
                              -> LabeledPackageConstraint
                              -> Tree d c
                              -> Tree d c
    processPackageConstraintS :: forall d c.
    QPN
    -> OptionalStanza
    -> ConflictSet
    -> Bool
    -> LabeledPackageConstraint
    -> Tree d c
    -> Tree d c
    processPackageConstraintS QPN
    qpn OptionalStanza
    s ConflictSet
    c Bool
    b' (LabeledPackageConstraint (PackageConstraint ConstraintScope
    scope PackageProperty
    prop) ConstraintSource
    src) Tree d c
    r =
        if ConstraintScope -> QPN -> Bool
    constraintScopeMatches ConstraintScope
    scope QPN
    qpn
        then PackageProperty -> Tree d c
    go PackageProperty
    prop
        else Tree d c
    r
      where
        go :: PackageProperty -> Tree d c
        go :: PackageProperty -> Tree d c
    go (PackagePropertyStanzas [OptionalStanza]
    ss) =
            if Bool -> Bool
    not Bool
    b' Bool -> Bool -> Bool
    && OptionalStanza
    s OptionalStanza -> [OptionalStanza] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [OptionalStanza]
    ss then ConflictSet -> FailReason -> Tree d c
    forall d c. ConflictSet -> FailReason -> Tree d c
    Fail ConflictSet
    c (ConstraintSource -> FailReason
    GlobalConstraintFlag ConstraintSource
    src)
                                     else Tree d c
    r
        go PackageProperty
    _                               = Tree d c
    r

    -- | Traversal that tries to establish various kinds of user constraints. Works
    -- by selectively disabling choices that have been ruled out by global user
    -- constraints.
    enforcePackageConstraints :: M.Map PN [LabeledPackageConstraint]
                              -> EndoTreeTrav d c
    enforcePackageConstraints :: forall d c. Map PN [LabeledPackageConstraint] -> EndoTreeTrav d c
    enforcePackageConstraints Map PN [LabeledPackageConstraint]
    pcs = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    forall {d} {c} {d} {c}.
    TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go
      where
        go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go (PChoiceF qpn :: QPN
    qpn@(Q PackagePath
    _ PN
    pn) RevDepMap
    rdm c
    gr                    WeightedPSQ [Weight] POption (Tree d c)
    ts) =
          let c :: ConflictSet
    c = Var QPN -> ConflictSet
    varToConflictSet (QPN -> Var QPN
    forall qpn. qpn -> Var qpn
    P QPN
    qpn)
              -- compose the transformation functions for each of the relevant constraint
              g :: POption -> Tree d c -> Tree d c
    g = \ (POption I
    i Maybe PackagePath
    _) -> ((Tree d c -> Tree d c)
     -> LabeledPackageConstraint -> Tree d c -> Tree d c)
    -> (Tree d c -> Tree d c)
    -> [LabeledPackageConstraint]
    -> Tree d c
    -> Tree d c
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\ Tree d c -> Tree d c
    h LabeledPackageConstraint
    pc -> Tree d c -> Tree d c
    h (Tree d c -> Tree d c)
    -> (Tree d c -> Tree d c) -> Tree d c -> Tree d c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QPN
    -> ConflictSet
    -> I
    -> LabeledPackageConstraint
    -> Tree d c
    -> Tree d c
    forall d c.
    QPN
    -> ConflictSet
    -> I
    -> LabeledPackageConstraint
    -> Tree d c
    -> Tree d c
    processPackageConstraintP QPN
    qpn ConflictSet
    c I
    i LabeledPackageConstraint
    pc)
                                           Tree d c -> Tree d c
    forall a. a -> a
    id
                                           ([LabeledPackageConstraint]
    -> PN
    -> Map PN [LabeledPackageConstraint]
    -> [LabeledPackageConstraint]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] PN
    pn Map PN [LabeledPackageConstraint]
    pcs)
          in QPN
    -> RevDepMap
    -> c
    -> WeightedPSQ [Weight] POption (Tree d c)
    -> TreeF d c (Tree d c)
    forall d c a.
    QPN
    -> RevDepMap -> c -> WeightedPSQ [Weight] POption a -> TreeF d c a
    PChoiceF QPN
    qpn RevDepMap
    rdm c
    gr        ((POption -> Tree d c -> Tree d c)
    -> WeightedPSQ [Weight] POption (Tree d c)
    -> WeightedPSQ [Weight] POption (Tree d c)
    forall k v1 v2 w.
    (k -> v1 -> v2) -> WeightedPSQ w k v1 -> WeightedPSQ w k v2
    W.mapWithKey POption -> Tree d c -> Tree d c
    forall {d} {c}. POption -> Tree d c -> Tree d c
    g WeightedPSQ [Weight] POption (Tree d c)
    ts)
        go (FChoiceF qfn :: QFN
    qfn@(FN qpn :: QPN
    qpn@(Q PackagePath
    _ PN
    pn) Flag
    f) RevDepMap
    rdm c
    gr WeakOrTrivial
    tr FlagType
    m Bool
    d WeightedPSQ [Weight] Bool (Tree d c)
    ts) =
          let c :: ConflictSet
    c = Var QPN -> ConflictSet
    varToConflictSet (QFN -> Var QPN
    forall qpn. FN qpn -> Var qpn
    F QFN
    qfn)
              -- compose the transformation functions for each of the relevant constraint
              g :: Bool -> Tree d c -> Tree d c
    g = \ Bool
    b -> ((Tree d c -> Tree d c)
     -> LabeledPackageConstraint -> Tree d c -> Tree d c)
    -> (Tree d c -> Tree d c)
    -> [LabeledPackageConstraint]
    -> Tree d c
    -> Tree d c
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\ Tree d c -> Tree d c
    h LabeledPackageConstraint
    pc -> Tree d c -> Tree d c
    h (Tree d c -> Tree d c)
    -> (Tree d c -> Tree d c) -> Tree d c -> Tree d c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QPN
    -> Flag
    -> ConflictSet
    -> Bool
    -> LabeledPackageConstraint
    -> Tree d c
    -> Tree d c
    forall d c.
    QPN
    -> Flag
    -> ConflictSet
    -> Bool
    -> LabeledPackageConstraint
    -> Tree d c
    -> Tree d c
    processPackageConstraintF QPN
    qpn Flag
    f ConflictSet
    c Bool
    b LabeledPackageConstraint
    pc)
                               Tree d c -> Tree d c
    forall a. a -> a
    id
                               ([LabeledPackageConstraint]
    -> PN
    -> Map PN [LabeledPackageConstraint]
    -> [LabeledPackageConstraint]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] PN
    pn Map PN [LabeledPackageConstraint]
    pcs)
          in QFN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> FlagType
    -> Bool
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> TreeF d c (Tree d c)
    forall d c a.
    QFN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> FlagType
    -> Bool
    -> WeightedPSQ [Weight] Bool a
    -> TreeF d c a
    FChoiceF QFN
    qfn RevDepMap
    rdm c
    gr WeakOrTrivial
    tr FlagType
    m Bool
    d ((Bool -> Tree d c -> Tree d c)
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> WeightedPSQ [Weight] Bool (Tree d c)
    forall k v1 v2 w.
    (k -> v1 -> v2) -> WeightedPSQ w k v1 -> WeightedPSQ w k v2
    W.mapWithKey Bool -> Tree d c -> Tree d c
    forall {d} {c}. Bool -> Tree d c -> Tree d c
    g WeightedPSQ [Weight] Bool (Tree d c)
    ts)
        go (SChoiceF qsn :: QSN
    qsn@(SN qpn :: QPN
    qpn@(Q PackagePath
    _ PN
    pn) OptionalStanza
    f) RevDepMap
    rdm c
    gr WeakOrTrivial
    tr   WeightedPSQ [Weight] Bool (Tree d c)
    ts) =
          let c :: ConflictSet
    c = Var QPN -> ConflictSet
    varToConflictSet (QSN -> Var QPN
    forall qpn. SN qpn -> Var qpn
    S QSN
    qsn)
              -- compose the transformation functions for each of the relevant constraint
              g :: Bool -> Tree d c -> Tree d c
    g = \ Bool
    b -> ((Tree d c -> Tree d c)
     -> LabeledPackageConstraint -> Tree d c -> Tree d c)
    -> (Tree d c -> Tree d c)
    -> [LabeledPackageConstraint]
    -> Tree d c
    -> Tree d c
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\ Tree d c -> Tree d c
    h LabeledPackageConstraint
    pc -> Tree d c -> Tree d c
    h (Tree d c -> Tree d c)
    -> (Tree d c -> Tree d c) -> Tree d c -> Tree d c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QPN
    -> OptionalStanza
    -> ConflictSet
    -> Bool
    -> LabeledPackageConstraint
    -> Tree d c
    -> Tree d c
    forall d c.
    QPN
    -> OptionalStanza
    -> ConflictSet
    -> Bool
    -> LabeledPackageConstraint
    -> Tree d c
    -> Tree d c
    processPackageConstraintS QPN
    qpn OptionalStanza
    f ConflictSet
    c Bool
    b LabeledPackageConstraint
    pc)
                               Tree d c -> Tree d c
    forall a. a -> a
    id
                               ([LabeledPackageConstraint]
    -> PN
    -> Map PN [LabeledPackageConstraint]
    -> [LabeledPackageConstraint]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] PN
    pn Map PN [LabeledPackageConstraint]
    pcs)
          in QSN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> TreeF d c (Tree d c)
    forall d c a.
    QSN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> WeightedPSQ [Weight] Bool a
    -> TreeF d c a
    SChoiceF QSN
    qsn RevDepMap
    rdm c
    gr WeakOrTrivial
    tr     ((Bool -> Tree d c -> Tree d c)
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> WeightedPSQ [Weight] Bool (Tree d c)
    forall k v1 v2 w.
    (k -> v1 -> v2) -> WeightedPSQ w k v1 -> WeightedPSQ w k v2
    W.mapWithKey Bool -> Tree d c -> Tree d c
    forall {d} {c}. Bool -> Tree d c -> Tree d c
    g WeightedPSQ [Weight] Bool (Tree d c)
    ts)
        go TreeF d c (Tree d c)
    x = TreeF d c (Tree d c)
    x

    -- | Transformation that tries to enforce the rule that manual flags can only be
    -- set by the user.
    --
    -- If there are no constraints on a manual flag, this function prunes all but
    -- the default value. If there are constraints, then the flag is allowed to have
    -- the values specified by the constraints. Note that the type used for flag
    -- values doesn't need to be Bool.
    --
    -- This function makes an exception for the case where there are multiple goals
    -- for a single package (with different qualifiers), and flag constraints for
    -- manual flag x only apply to some of those goals. In that case, we allow the
    -- unconstrained goals to use the default value for x OR any of the values in
    -- the constraints on x (even though the constraints don't apply), in order to
    -- allow the unconstrained goals to be linked to the constrained goals. See
    -- https://github.com/haskell/cabal/issues/4299. Removing the single instance
    -- restriction (SIR) would also fix #4299, so we may want to remove this
    -- exception and only let the user toggle manual flags if we remove the SIR.
    --
    -- This function does not enforce any of the constraints, since that is done by
    -- 'enforcePackageConstraints'.
    enforceManualFlags :: M.Map PN [LabeledPackageConstraint] -> EndoTreeTrav d c
    enforceManualFlags :: forall d c. Map PN [LabeledPackageConstraint] -> EndoTreeTrav d c
    enforceManualFlags Map PN [LabeledPackageConstraint]
    pcs = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    forall {d} {c} {d} {c}.
    TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go
      where
        go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go (FChoiceF qfn :: QFN
    qfn@(FN (Q PackagePath
    _ PN
    pn) Flag
    fn) RevDepMap
    rdm c
    gr WeakOrTrivial
    tr FlagType
    Manual Bool
    d WeightedPSQ [Weight] Bool (Tree d c)
    ts) =
            QFN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> FlagType
    -> Bool
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> TreeF d c (Tree d c)
    forall d c a.
    QFN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> FlagType
    -> Bool
    -> WeightedPSQ [Weight] Bool a
    -> TreeF d c a
    FChoiceF QFN
    qfn RevDepMap
    rdm c
    gr WeakOrTrivial
    tr FlagType
    Manual Bool
    d (WeightedPSQ [Weight] Bool (Tree d c) -> TreeF d c (Tree d c))
    -> WeightedPSQ [Weight] Bool (Tree d c) -> TreeF d c (Tree d c)
    forall a b. (a -> b) -> a -> b
    $
              let -- A list of all values specified by constraints on 'fn'.
                  -- We ignore the constraint scope in order to handle issue #4299.
                  flagConstraintValues :: [Bool]
                  flagConstraintValues :: [Bool]
    flagConstraintValues =
                      [ Bool
    flagVal
                      | let lpcs :: [LabeledPackageConstraint]
    lpcs = [LabeledPackageConstraint]
    -> PN
    -> Map PN [LabeledPackageConstraint]
    -> [LabeledPackageConstraint]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] PN
    pn Map PN [LabeledPackageConstraint]
    pcs
                      , (LabeledPackageConstraint (PackageConstraint ConstraintScope
    _ (PackagePropertyFlags FlagAssignment
    fa)) ConstraintSource
    _) <- [LabeledPackageConstraint]
    lpcs
                      , (Flag
    fn', Bool
    flagVal) <- FlagAssignment -> [(Flag, Bool)]
    unFlagAssignment FlagAssignment
    fa
                      , Flag
    fn' Flag -> Flag -> Bool
    forall a. Eq a => a -> a -> Bool
    == Flag
    fn ]

                  -- Prune flag values that are not the default and do not match any
                  -- of the constraints.
                  restrictToggling :: Eq a => a -> [a] -> a -> Tree d c -> Tree d c
                  restrictToggling :: forall a d c. Eq a => a -> [a] -> a -> Tree d c -> Tree d c
    restrictToggling a
    flagDefault [a]
    constraintVals a
    flagVal Tree d c
    r =
                      if a
    flagVal a -> [a] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [a]
    constraintVals Bool -> Bool -> Bool
    || a
    flagVal a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    flagDefault
                      then Tree d c
    r
                      else ConflictSet -> FailReason -> Tree d c
    forall d c. ConflictSet -> FailReason -> Tree d c
    Fail (Var QPN -> ConflictSet
    varToConflictSet (QFN -> Var QPN
    forall qpn. FN qpn -> Var qpn
    F QFN
    qfn)) FailReason
    ManualFlag

          in (Bool -> Tree d c -> Tree d c)
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> WeightedPSQ [Weight] Bool (Tree d c)
    forall k v1 v2 w.
    (k -> v1 -> v2) -> WeightedPSQ w k v1 -> WeightedPSQ w k v2
    W.mapWithKey (Bool -> [Bool] -> Bool -> Tree d c -> Tree d c
    forall a d c. Eq a => a -> [a] -> a -> Tree d c -> Tree d c
    restrictToggling Bool
    d [Bool]
    flagConstraintValues) WeightedPSQ [Weight] Bool (Tree d c)
    ts
        go TreeF d c (Tree d c)
    x                                                            = TreeF d c (Tree d c)
    x

    -- | Avoid reinstalls.
    --
    -- This is a tricky strategy. If a package version is installed already and the
    -- same version is available from a repo, the repo version will never be chosen.
    -- This would result in a reinstall (either destructively, or potentially,
    -- shadowing). The old instance won't be visible or even present anymore, but
    -- other packages might have depended on it.
    --
    -- TODO: It would be better to actually check the reverse dependencies of installed
    -- packages. If they're not depended on, then reinstalling should be fine. Even if
    -- they are, perhaps this should just result in trying to reinstall those other
    -- packages as well. However, doing this all neatly in one pass would require to
    -- change the builder, or at least to change the goal set after building.
    avoidReinstalls :: (PN -> Bool) -> EndoTreeTrav d c
    avoidReinstalls :: forall d c. (PN -> Bool) -> EndoTreeTrav d c
    avoidReinstalls PN -> Bool
    p = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    forall {d} {c} {d} {c}.
    TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go
      where
        go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go (PChoiceF qpn :: QPN
    qpn@(Q PackagePath
    _ PN
    pn) RevDepMap
    rdm c
    gr WeightedPSQ [Weight] POption (Tree d c)
    cs)
          | PN -> Bool
    p PN
    pn      = QPN
    -> RevDepMap
    -> c
    -> WeightedPSQ [Weight] POption (Tree d c)
    -> TreeF d c (Tree d c)
    forall d c a.
    QPN
    -> RevDepMap -> c -> WeightedPSQ [Weight] POption a -> TreeF d c a
    PChoiceF QPN
    qpn RevDepMap
    rdm c
    gr WeightedPSQ [Weight] POption (Tree d c)
    disableReinstalls
          | Bool
    otherwise = QPN
    -> RevDepMap
    -> c
    -> WeightedPSQ [Weight] POption (Tree d c)
    -> TreeF d c (Tree d c)
    forall d c a.
    QPN
    -> RevDepMap -> c -> WeightedPSQ [Weight] POption a -> TreeF d c a
    PChoiceF QPN
    qpn RevDepMap
    rdm c
    gr WeightedPSQ [Weight] POption (Tree d c)
    cs
          where
            disableReinstalls :: WeightedPSQ [Weight] POption (Tree d c)
    disableReinstalls =
              let installed :: [Ver]
    installed = [ Ver
    v | ([Weight]
    _, POption (I Ver
    v (Inst PId
    _)) Maybe PackagePath
    _, Tree d c
    _) <- WeightedPSQ [Weight] POption (Tree d c)
    -> [([Weight], POption, Tree d c)]
    forall w k v. WeightedPSQ w k v -> [(w, k, v)]
    W.toList WeightedPSQ [Weight] POption (Tree d c)
    cs ]
              in  (POption -> Tree d c -> Tree d c)
    -> WeightedPSQ [Weight] POption (Tree d c)
    -> WeightedPSQ [Weight] POption (Tree d c)
    forall k v1 v2 w.
    (k -> v1 -> v2) -> WeightedPSQ w k v1 -> WeightedPSQ w k v2
    W.mapWithKey ([Ver] -> POption -> Tree d c -> Tree d c
    forall {t :: * -> *} {d} {c}.
    Foldable t =>
    t Ver -> POption -> Tree d c -> Tree d c
    notReinstall [Ver]
    installed) WeightedPSQ [Weight] POption (Tree d c)
    cs

            notReinstall :: t Ver -> POption -> Tree d c -> Tree d c
    notReinstall t Ver
    vs (POption (I Ver
    v Loc
    InRepo) Maybe PackagePath
    _) Tree d c
    _ | Ver
    v Ver -> t Ver -> Bool
    forall a. Eq a => a -> t a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` t Ver
    vs =
              ConflictSet -> FailReason -> Tree d c
    forall d c. ConflictSet -> FailReason -> Tree d c
    Fail (Var QPN -> ConflictSet
    varToConflictSet (QPN -> Var QPN
    forall qpn. qpn -> Var qpn
    P QPN
    qpn)) FailReason
    CannotReinstall
            notReinstall t Ver
    _ POption
    _ Tree d c
    x =
              Tree d c
    x
        go TreeF d c (Tree d c)
    x          = TreeF d c (Tree d c)
    x

    -- | Require all packages to be mentioned in a constraint or as a goal.
    onlyConstrained :: (PN -> Bool) -> EndoTreeTrav d QGoalReason
    onlyConstrained :: forall d. (PN -> Bool) -> EndoTreeTrav d QGoalReason
    onlyConstrained PN -> Bool
    p = TreeF d QGoalReason (Tree d QGoalReason)
    -> TreeF d QGoalReason (Tree d QGoalReason)
    forall {d} {a}. TreeF d QGoalReason a -> TreeF d QGoalReason a
    go
      where
        go :: TreeF d QGoalReason a -> TreeF d QGoalReason a
    go (PChoiceF v :: QPN
    v@(Q PackagePath
    _ PN
    pn) RevDepMap
    _ QGoalReason
    gr WeightedPSQ [Weight] POption a
    _) | Bool -> Bool
    not (PN -> Bool
    p PN
    pn)
          = ConflictSet -> FailReason -> TreeF d QGoalReason a
    forall d c a. ConflictSet -> FailReason -> TreeF d c a
    FailF
            (Var QPN -> ConflictSet
    varToConflictSet (QPN -> Var QPN
    forall qpn. qpn -> Var qpn
    P QPN
    v) ConflictSet -> ConflictSet -> ConflictSet
    `CS.union` QPN -> QGoalReason -> ConflictSet
    goalReasonToConflictSetWithConflict QPN
    v QGoalReason
    gr)
            FailReason
    NotExplicit
        go TreeF d QGoalReason a
    x
          = TreeF d QGoalReason a
    x

    -- | Sort all goals using the provided function.
    sortGoals :: (Variable QPN -> Variable QPN -> Ordering) -> EndoTreeTrav d c
    sortGoals :: forall d c.
    (Variable QPN -> Variable QPN -> Ordering) -> EndoTreeTrav d c
    sortGoals Variable QPN -> Variable QPN -> Ordering
    variableOrder = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    forall {d} {c} {a}. TreeF d c a -> TreeF d c a
    go
      where
        go :: TreeF d c a -> TreeF d c a
    go (GoalChoiceF RevDepMap
    rdm PSQ (Goal QPN) a
    xs) = RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
    forall d c a. RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
    GoalChoiceF RevDepMap
    rdm ((Goal QPN -> Goal QPN -> Ordering)
    -> PSQ (Goal QPN) a -> PSQ (Goal QPN) a
    forall k a. (k -> k -> Ordering) -> PSQ k a -> PSQ k a
    P.sortByKeys Goal QPN -> Goal QPN -> Ordering
    goalOrder PSQ (Goal QPN) a
    xs)
        go TreeF d c a
    x                    = TreeF d c a
    x

        goalOrder :: Goal QPN -> Goal QPN -> Ordering
        goalOrder :: Goal QPN -> Goal QPN -> Ordering
    goalOrder = Variable QPN -> Variable QPN -> Ordering
    variableOrder (Variable QPN -> Variable QPN -> Ordering)
    -> (Goal QPN -> Variable QPN) -> Goal QPN -> Goal QPN -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (Var QPN -> Variable QPN
    varToVariable (Var QPN -> Variable QPN)
    -> (Goal QPN -> Var QPN) -> Goal QPN -> Variable QPN
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Goal QPN -> Var QPN
    forall a. Goal a -> Var a
    goalToVar)

        varToVariable :: Var QPN -> Variable QPN
        varToVariable :: Var QPN -> Variable QPN
    varToVariable (P QPN
    qpn)                    = QPN -> Variable QPN
    forall qpn. qpn -> Variable qpn
    PackageVar QPN
    qpn
        varToVariable (F (FN QPN
    qpn Flag
    fn))     = QPN -> Flag -> Variable QPN
    forall qpn. qpn -> Flag -> Variable qpn
    FlagVar QPN
    qpn Flag
    fn
        varToVariable (S (SN QPN
    qpn OptionalStanza
    stanza)) = QPN -> OptionalStanza -> Variable QPN
    forall qpn. qpn -> OptionalStanza -> Variable qpn
    StanzaVar QPN
    qpn OptionalStanza
    stanza

    -- | Reduce the branching degree of the search tree by removing all choices
    -- after the first successful choice at each level. The returned tree is the
    -- minimal subtree containing the path to the first backjump.
    pruneAfterFirstSuccess :: EndoTreeTrav d c
    pruneAfterFirstSuccess :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    pruneAfterFirstSuccess = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    forall {d} {c} {d} {c}.
    TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go
      where
        go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go (PChoiceF QPN
    qpn RevDepMap
    rdm c
    gr       WeightedPSQ [Weight] POption (Tree d c)
    ts) = QPN
    -> RevDepMap
    -> c
    -> WeightedPSQ [Weight] POption (Tree d c)
    -> TreeF d c (Tree d c)
    forall d c a.
    QPN
    -> RevDepMap -> c -> WeightedPSQ [Weight] POption a -> TreeF d c a
    PChoiceF QPN
    qpn RevDepMap
    rdm c
    gr       ((Tree d c -> Bool)
    -> WeightedPSQ [Weight] POption (Tree d c)
    -> WeightedPSQ [Weight] POption (Tree d c)
    forall w k v. (v -> Bool) -> WeightedPSQ w k v -> WeightedPSQ w k v
    W.takeUntil Tree d c -> Bool
    forall d c. Tree d c -> Bool
    active WeightedPSQ [Weight] POption (Tree d c)
    ts)
        go (FChoiceF QFN
    qfn RevDepMap
    rdm c
    gr WeakOrTrivial
    w FlagType
    m Bool
    d WeightedPSQ [Weight] Bool (Tree d c)
    ts) = QFN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> FlagType
    -> Bool
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> TreeF d c (Tree d c)
    forall d c a.
    QFN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> FlagType
    -> Bool
    -> WeightedPSQ [Weight] Bool a
    -> TreeF d c a
    FChoiceF QFN
    qfn RevDepMap
    rdm c
    gr WeakOrTrivial
    w FlagType
    m Bool
    d ((Tree d c -> Bool)
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> WeightedPSQ [Weight] Bool (Tree d c)
    forall w k v. (v -> Bool) -> WeightedPSQ w k v -> WeightedPSQ w k v
    W.takeUntil Tree d c -> Bool
    forall d c. Tree d c -> Bool
    active WeightedPSQ [Weight] Bool (Tree d c)
    ts)
        go (SChoiceF QSN
    qsn RevDepMap
    rdm c
    gr WeakOrTrivial
    w     WeightedPSQ [Weight] Bool (Tree d c)
    ts) = QSN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> TreeF d c (Tree d c)
    forall d c a.
    QSN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> WeightedPSQ [Weight] Bool a
    -> TreeF d c a
    SChoiceF QSN
    qsn RevDepMap
    rdm c
    gr WeakOrTrivial
    w     ((Tree d c -> Bool)
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> WeightedPSQ [Weight] Bool (Tree d c)
    forall w k v. (v -> Bool) -> WeightedPSQ w k v -> WeightedPSQ w k v
    W.takeUntil Tree d c -> Bool
    forall d c. Tree d c -> Bool
    active WeightedPSQ [Weight] Bool (Tree d c)
    ts)
        go TreeF d c (Tree d c)
    x                              = TreeF d c (Tree d c)
    x

    -- | Always choose the first goal in the list next, abandoning all
    -- other choices.
    --
    -- This is unnecessary for the default search strategy, because
    -- it descends only into the first goal choice anyway,
    -- but may still make sense to just reduce the tree size a bit.
    firstGoal :: EndoTreeTrav d c
    firstGoal :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    firstGoal = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    forall {d} {c} {a}. TreeF d c a -> TreeF d c a
    go
      where
        go :: TreeF d c a -> TreeF d c a
    go (GoalChoiceF RevDepMap
    rdm PSQ (Goal QPN) a
    xs) = RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
    forall d c a. RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
    GoalChoiceF RevDepMap
    rdm (PSQ (Goal QPN) a -> PSQ (Goal QPN) a
    forall k a. PSQ k a -> PSQ k a
    P.firstOnly PSQ (Goal QPN) a
    xs)
        go TreeF d c a
    x                    = TreeF d c a
    x
        -- Note that we keep empty choice nodes, because they mean success.

    -- | Transformation that tries to make a decision on base as early as
    -- possible by pruning all other goals when base is available. In nearly
    -- all cases, there's a single choice for the base package. Also, fixing
    -- base early should lead to better error messages.
    preferBaseGoalChoice :: EndoTreeTrav d c
    preferBaseGoalChoice :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    preferBaseGoalChoice = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    forall {d} {c} {a}. TreeF d c a -> TreeF d c a
    go
      where
        go :: TreeF d c a -> TreeF d c a
    go (GoalChoiceF RevDepMap
    rdm PSQ (Goal QPN) a
    xs) = RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
    forall d c a. RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
    GoalChoiceF RevDepMap
    rdm ((Goal QPN -> Bool) -> PSQ (Goal QPN) a -> PSQ (Goal QPN) a
    forall k a. (k -> Bool) -> PSQ k a -> PSQ k a
    P.filterIfAnyByKeys Goal QPN -> Bool
    isBase PSQ (Goal QPN) a
    xs)
        go TreeF d c a
    x                    = TreeF d c a
    x

        isBase :: Goal QPN -> Bool
        isBase :: Goal QPN -> Bool
    isBase (Goal (P (Q PackagePath
    _pp PN
    pn)) QGoalReason
    _) = PN -> String
    unPN PN
    pn String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "base"
        isBase Goal QPN
    _                       = Bool
    False

    -- | Deal with setup and build-tool-depends dependencies after regular dependencies,
    -- so we will link setup/exe dependencies against package dependencies when possible
    deferSetupExeChoices :: EndoTreeTrav d c
    deferSetupExeChoices :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    deferSetupExeChoices = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    forall {d} {c} {a}. TreeF d c a -> TreeF d c a
    go
      where
        go :: TreeF d c a -> TreeF d c a
    go (GoalChoiceF RevDepMap
    rdm PSQ (Goal QPN) a
    xs) = RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
    forall d c a. RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
    GoalChoiceF RevDepMap
    rdm ((Goal QPN -> Bool) -> PSQ (Goal QPN) a -> PSQ (Goal QPN) a
    forall k a. (k -> Bool) -> PSQ k a -> PSQ k a
    P.preferByKeys Goal QPN -> Bool
    noSetupOrExe PSQ (Goal QPN) a
    xs)
        go TreeF d c a
    x                    = TreeF d c a
    x

        noSetupOrExe :: Goal QPN -> Bool
        noSetupOrExe :: Goal QPN -> Bool
    noSetupOrExe (Goal (P (Q (PackagePath Namespace
    _ns (QualSetup PN
    _)) PN
    _)) QGoalReason
    _) = Bool
    False
        noSetupOrExe (Goal (P (Q (PackagePath Namespace
    _ns (QualExe PN
    _ PN
    _)) PN
    _)) QGoalReason
    _) = Bool
    False
        noSetupOrExe Goal QPN
    _                                                  = Bool
    True

    -- | Transformation that tries to avoid making weak flag choices early.
    -- Weak flags are trivial flags (not influencing dependencies) or such
    -- flags that are explicitly declared to be weak in the index.
    deferWeakFlagChoices :: EndoTreeTrav d c
    deferWeakFlagChoices :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    deferWeakFlagChoices = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    forall {d} {c} {d} {c}.
    TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go
      where
        go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go (GoalChoiceF RevDepMap
    rdm PSQ (Goal QPN) (Tree d c)
    xs) = RevDepMap -> PSQ (Goal QPN) (Tree d c) -> TreeF d c (Tree d c)
    forall d c a. RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
    GoalChoiceF RevDepMap
    rdm ((Tree d c -> Bool)
    -> PSQ (Goal QPN) (Tree d c) -> PSQ (Goal QPN) (Tree d c)
    forall a k. (a -> Bool) -> PSQ k a -> PSQ k a
    P.prefer Tree d c -> Bool
    forall d c. Tree d c -> Bool
    noWeakFlag ((Tree d c -> Bool)
    -> PSQ (Goal QPN) (Tree d c) -> PSQ (Goal QPN) (Tree d c)
    forall a k. (a -> Bool) -> PSQ k a -> PSQ k a
    P.prefer Tree d c -> Bool
    forall d c. Tree d c -> Bool
    noWeakStanza PSQ (Goal QPN) (Tree d c)
    xs))
        go TreeF d c (Tree d c)
    x                    = TreeF d c (Tree d c)
    x

        noWeakStanza :: Tree d c -> Bool
        noWeakStanza :: forall d c. Tree d c -> Bool
    noWeakStanza (SChoice QSN
    _ RevDepMap
    _ c
    _ (WeakOrTrivial Bool
    True)   WeightedPSQ [Weight] Bool (Tree d c)
    _) = Bool
    False
        noWeakStanza Tree d c
    _                                        = Bool
    True

        noWeakFlag :: Tree d c -> Bool
        noWeakFlag :: forall d c. Tree d c -> Bool
    noWeakFlag (FChoice QFN
    _ RevDepMap
    _ c
    _ (WeakOrTrivial Bool
    True) FlagType
    _ Bool
    _ WeightedPSQ [Weight] Bool (Tree d c)
    _) = Bool
    False
        noWeakFlag Tree d c
    _                                          = Bool
    True

    -- | Transformation that prefers goals with lower branching degrees.
    --
    -- When a goal choice node has at least one goal with zero or one children, this
    -- function prunes all other goals. This transformation can help the solver find
    -- a solution in fewer steps by allowing it to backtrack sooner when it is
    -- exploring a subtree with no solutions. However, each step is more expensive.
    preferReallyEasyGoalChoices :: EndoTreeTrav d c
    preferReallyEasyGoalChoices :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    preferReallyEasyGoalChoices = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    forall {d} {c} {d} {c}.
    TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go
      where
        go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go (GoalChoiceF RevDepMap
    rdm PSQ (Goal QPN) (Tree d c)
    xs) = RevDepMap -> PSQ (Goal QPN) (Tree d c) -> TreeF d c (Tree d c)
    forall d c a. RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
    GoalChoiceF RevDepMap
    rdm ((Tree d c -> Bool)
    -> PSQ (Goal QPN) (Tree d c) -> PSQ (Goal QPN) (Tree d c)
    forall a k. (a -> Bool) -> PSQ k a -> PSQ k a
    P.filterIfAny Tree d c -> Bool
    forall d c. Tree d c -> Bool
    zeroOrOneChoices PSQ (Goal QPN) (Tree d c)
    xs)
        go TreeF d c (Tree d c)
    x                    = TreeF d c (Tree d c)
    x

    -- | Monad used internally in enforceSingleInstanceRestriction
    --
    -- For each package instance we record the goal for which we picked a concrete
    -- instance. The SIR means that for any package instance there can only be one.
    type EnforceSIR = Reader (Map (PI PN) QPN)

    -- | Enforce ghc's single instance restriction
    --
    -- From the solver's perspective, this means that for any package instance
    -- (that is, package name + package version) there can be at most one qualified
    -- goal resolving to that instance (there may be other goals _linking_ to that
    -- instance however).
    enforceSingleInstanceRestriction :: Tree d c -> Tree d c
    enforceSingleInstanceRestriction :: forall d c. Tree d c -> Tree d c
    enforceSingleInstanceRestriction = (Reader (Map (PI PN) QPN) (Tree d c) -> Map (PI PN) QPN -> Tree d c
    forall r a. Reader r a -> r -> a
    `runReader` Map (PI PN) QPN
    forall k a. Map k a
    M.empty) (Reader (Map (PI PN) QPN) (Tree d c) -> Tree d c)
    -> (Tree d c -> Reader (Map (PI PN) QPN) (Tree d c))
    -> Tree d c
    -> Tree d c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree d c -> Reader (Map (PI PN) QPN) (Tree d c)
    forall d c. Tree d c -> EnforceSIR (Tree d c)
    go
      where
        go :: Tree d c -> EnforceSIR (Tree d c)

        -- We just verify package choices.
        go :: forall d c. Tree d c -> EnforceSIR (Tree d c)
    go (PChoice QPN
    qpn RevDepMap
    rdm c
    gr WeightedPSQ [Weight] POption (Tree d c)
    cs) =
          QPN
    -> RevDepMap
    -> c
    -> WeightedPSQ [Weight] POption (Tree d c)
    -> Tree d c
    forall d c.
    QPN
    -> RevDepMap
    -> c
    -> WeightedPSQ [Weight] POption (Tree d c)
    -> Tree d c
    PChoice QPN
    qpn RevDepMap
    rdm c
    gr (WeightedPSQ [Weight] POption (Tree d c) -> Tree d c)
    -> ReaderT
         (Map (PI PN) QPN)
         Identity
         (WeightedPSQ [Weight] POption (Tree d c))
    -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WeightedPSQ
      [Weight] POption (ReaderT (Map (PI PN) QPN) Identity (Tree d c))
    -> ReaderT
         (Map (PI PN) QPN)
         Identity
         (WeightedPSQ [Weight] POption (Tree d c))
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a.
    Applicative f =>
    WeightedPSQ [Weight] POption (f a)
    -> f (WeightedPSQ [Weight] POption a)
    sequenceA ((POption
     -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
     -> ReaderT (Map (PI PN) QPN) Identity (Tree d c))
    -> WeightedPSQ
         [Weight] POption (ReaderT (Map (PI PN) QPN) Identity (Tree d c))
    -> WeightedPSQ
         [Weight] POption (ReaderT (Map (PI PN) QPN) Identity (Tree d c))
    forall k v1 v2 w.
    (k -> v1 -> v2) -> WeightedPSQ w k v1 -> WeightedPSQ w k v2
    W.mapWithKey (QPN
    -> POption
    -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
    -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
    forall d c.
    QPN -> POption -> EnforceSIR (Tree d c) -> EnforceSIR (Tree d c)
    goP QPN
    qpn) ((Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c))
    -> WeightedPSQ [Weight] POption (Tree d c)
    -> WeightedPSQ
         [Weight] POption (ReaderT (Map (PI PN) QPN) Identity (Tree d c))
    forall a b.
    (a -> b)
    -> WeightedPSQ [Weight] POption a -> WeightedPSQ [Weight] POption b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
    forall d c. Tree d c -> EnforceSIR (Tree d c)
    go WeightedPSQ [Weight] POption (Tree d c)
    cs))
        go (FChoice QFN
    qfn RevDepMap
    rdm c
    y WeakOrTrivial
    t FlagType
    m Bool
    d WeightedPSQ [Weight] Bool (Tree d c)
    ts) =
          QFN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> FlagType
    -> Bool
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> Tree d c
    forall d c.
    QFN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> FlagType
    -> Bool
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> Tree d c
    FChoice QFN
    qfn RevDepMap
    rdm c
    y WeakOrTrivial
    t FlagType
    m Bool
    d (WeightedPSQ [Weight] Bool (Tree d c) -> Tree d c)
    -> ReaderT
         (Map (PI PN) QPN) Identity (WeightedPSQ [Weight] Bool (Tree d c))
    -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c))
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> ReaderT
         (Map (PI PN) QPN) Identity (WeightedPSQ [Weight] Bool (Tree d c))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b)
    -> WeightedPSQ [Weight] Bool a -> f (WeightedPSQ [Weight] Bool b)
    traverse Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
    forall d c. Tree d c -> EnforceSIR (Tree d c)
    go WeightedPSQ [Weight] Bool (Tree d c)
    ts
        go (SChoice QSN
    qsn RevDepMap
    rdm c
    y WeakOrTrivial
    t WeightedPSQ [Weight] Bool (Tree d c)
    ts) =
          QSN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> Tree d c
    forall d c.
    QSN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> Tree d c
    SChoice QSN
    qsn RevDepMap
    rdm c
    y WeakOrTrivial
    t (WeightedPSQ [Weight] Bool (Tree d c) -> Tree d c)
    -> ReaderT
         (Map (PI PN) QPN) Identity (WeightedPSQ [Weight] Bool (Tree d c))
    -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c))
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> ReaderT
         (Map (PI PN) QPN) Identity (WeightedPSQ [Weight] Bool (Tree d c))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b)
    -> WeightedPSQ [Weight] Bool a -> f (WeightedPSQ [Weight] Bool b)
    traverse Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
    forall d c. Tree d c -> EnforceSIR (Tree d c)
    go WeightedPSQ [Weight] Bool (Tree d c)
    ts
        go (GoalChoice RevDepMap
    rdm PSQ (Goal QPN) (Tree d c)
    ts) =
          RevDepMap -> PSQ (Goal QPN) (Tree d c) -> Tree d c
    forall d c. RevDepMap -> PSQ (Goal QPN) (Tree d c) -> Tree d c
    GoalChoice RevDepMap
    rdm (PSQ (Goal QPN) (Tree d c) -> Tree d c)
    -> ReaderT (Map (PI PN) QPN) Identity (PSQ (Goal QPN) (Tree d c))
    -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c))
    -> PSQ (Goal QPN) (Tree d c)
    -> ReaderT (Map (PI PN) QPN) Identity (PSQ (Goal QPN) (Tree d c))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> PSQ (Goal QPN) a -> f (PSQ (Goal QPN) b)
    traverse Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
    forall d c. Tree d c -> EnforceSIR (Tree d c)
    go PSQ (Goal QPN) (Tree d c)
    ts
        go x :: Tree d c
    x@(Fail ConflictSet
    _ FailReason
    _) = Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
    forall a. a -> ReaderT (Map (PI PN) QPN) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Tree d c
    x
        go x :: Tree d c
    x@(Done RevDepMap
    _ d
    _) = Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
    forall a. a -> ReaderT (Map (PI PN) QPN) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Tree d c
    x

        -- The check proper
        goP :: QPN -> POption -> EnforceSIR (Tree d c) -> EnforceSIR (Tree d c)
        goP :: forall d c.
    QPN -> POption -> EnforceSIR (Tree d c) -> EnforceSIR (Tree d c)
    goP qpn :: QPN
    qpn@(Q PackagePath
    _ PN
    pn) (POption I
    i Maybe PackagePath
    linkedTo) EnforceSIR (Tree d c)
    r = do
          let inst :: PI PN
    inst = PN -> I -> PI PN
    forall qpn. qpn -> I -> PI qpn
    PI PN
    pn I
    i
          env <- ReaderT (Map (PI PN) QPN) Identity (Map (PI PN) QPN)
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
          case (linkedTo, M.lookup inst env) of
            (Just PackagePath
    _, Maybe QPN
    _) ->
              -- For linked nodes we don't check anything
              EnforceSIR (Tree d c)
    r
            (Maybe PackagePath
    Nothing, Maybe QPN
    Nothing) ->
              -- Not linked, not already used
              (Map (PI PN) QPN -> Map (PI PN) QPN)
    -> EnforceSIR (Tree d c) -> EnforceSIR (Tree d c)
    forall r (m :: * -> *) a.
    (r -> r) -> ReaderT r m a -> ReaderT r m a
    local (PI PN -> QPN -> Map (PI PN) QPN -> Map (PI PN) QPN
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert PI PN
    inst QPN
    qpn) EnforceSIR (Tree d c)
    r
            (Maybe PackagePath
    Nothing, Just QPN
    qpn') -> do
              -- Not linked, already used. This is an error
              Tree d c -> EnforceSIR (Tree d c)
    forall a. a -> ReaderT (Map (PI PN) QPN) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Tree d c -> EnforceSIR (Tree d c))
    -> Tree d c -> EnforceSIR (Tree d c)
    forall a b. (a -> b) -> a -> b
    $ ConflictSet -> FailReason -> Tree d c
    forall d c. ConflictSet -> FailReason -> Tree d c
    Fail (ConflictSet -> ConflictSet -> ConflictSet
    CS.union (Var QPN -> ConflictSet
    varToConflictSet (QPN -> Var QPN
    forall qpn. qpn -> Var qpn
    P QPN
    qpn)) (Var QPN -> ConflictSet
    varToConflictSet (QPN -> Var QPN
    forall qpn. qpn -> Var qpn
    P QPN
    qpn'))) FailReason
    MultipleInstances