    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    module Distribution.Solver.Modular.Validate (validateTree) where

    -- Validation of the tree.
    --
    -- The task here is to make sure all constraints hold. After validation, any
    -- assignment returned by exploration of the tree should be a complete valid
    -- assignment, i.e., actually constitute a solution.

    import Control.Monad (foldM, mzero, liftM2)
    import Control.Monad.Reader (MonadReader, Reader, runReader, local, asks)
    import Data.Either (lefts)
    import Data.Function (on)

    import qualified Data.List as L
    import qualified Data.Set as S

    import Language.Haskell.Extension (Extension, Language)

    import Data.Map.Strict as M
    import Distribution.Compiler (CompilerInfo(..))

    import Distribution.Solver.Modular.Assignment
    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.Package
    import Distribution.Solver.Modular.Tree
    import Distribution.Solver.Modular.Version
    import qualified Distribution.Solver.Modular.WeightedPSQ as W

    import Distribution.Solver.Types.PackagePath
    import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb, pkgConfigPkgIsPresent)
    import Distribution.Types.LibraryName
    import Distribution.Types.PkgconfigVersionRange

    -- In practice, most constraints are implication constraints (IF we have made
    -- a number of choices, THEN we also have to ensure that). We call constraints
    -- that for which the preconditions are fulfilled ACTIVE. We maintain a set
    -- of currently active constraints that we pass down the node.
    --
    -- We aim at detecting inconsistent states as early as possible.
    --
    -- Whenever we make a choice, there are two things that need to happen:
    --
    --   (1) We must check that the choice is consistent with the currently
    --       active constraints.
    --
    --   (2) The choice increases the set of active constraints. For the new
    --       active constraints, we must check that they are consistent with
    --       the current state.
    --
    -- We can actually merge (1) and (2) by saying the current choice is
    -- a new active constraint, fixing the choice.
    --
    -- If a test fails, we have detected an inconsistent state. We can
    -- disable the current subtree and do not have to traverse it any further.
    --
    -- We need a good way to represent the current state, i.e., the current
    -- set of active constraints. Since the main situation where we have to
    -- search in it is (1), it seems best to store the state by package: for
    -- every package, we store which versions are still allowed. If for any
    -- package, we have inconsistent active constraints, we can also stop.
    -- This is a particular way to read task (2):
    --
    --   (2, weak) We only check if the new constraints are consistent with
    --       the choices we've already made, and add them to the active set.
    --
    --   (2, strong) We check if the new constraints are consistent with the
    --       choices we've already made, and the constraints we already have.
    --
    -- It currently seems as if we're implementing the weak variant. However,
    -- when used together with 'preferEasyGoalChoices', we will find an
    -- inconsistent state in the very next step.
    --
    -- What do we do about flags?
    --
    -- Like for packages, we store the flag choices we have already made.
    -- Now, regarding (1), we only have to test whether we've decided the
    -- current flag before. Regarding (2), the interesting bit is in discovering
    -- the new active constraints. To this end, we look up the constraints for
    -- the package the flag belongs to, and traverse its flagged dependencies.
    -- Wherever we find the flag in question, we start recording dependencies
    -- underneath as new active dependencies. If we encounter other flags, we
    -- check if we've chosen them already and either proceed or stop.

    -- | The state needed during validation.
    data ValidateState = VS {
      ValidateState -> Extension -> Bool
    supportedExt        :: Extension -> Bool,
      ValidateState -> Language -> Bool
    supportedLang       :: Language  -> Bool,
      ValidateState -> PkgconfigName -> PkgconfigVersionRange -> Bool
    presentPkgs         :: PkgconfigName -> PkgconfigVersionRange  -> Bool,
      ValidateState -> Index
    index               :: Index,

      -- Saved, scoped, dependencies. Every time 'validate' makes a package choice,
      -- it qualifies the package's dependencies and saves them in this map. Then
      -- the qualified dependencies are available for subsequent flag and stanza
      -- choices for the same package.
      ValidateState -> Map QPN (FlaggedDeps QPN)
    saved               :: Map QPN (FlaggedDeps QPN),

      ValidateState -> PreAssignment
    pa                  :: PreAssignment,

      -- Map from package name to the components that are provided by the chosen
      -- instance of that package, and whether those components are visible and
      -- buildable.
      ValidateState -> Map QPN (Map ExposedComponent ComponentInfo)
    availableComponents :: Map QPN (Map ExposedComponent ComponentInfo),

      -- Map from package name to the components that are required from that
      -- package.
      ValidateState -> Map QPN ComponentDependencyReasons
    requiredComponents  :: Map QPN ComponentDependencyReasons,

      ValidateState -> QualifyOptions
    qualifyOptions      :: QualifyOptions
    }

    newtype Validate a = Validate (Reader ValidateState a)
      deriving ((forall a b. (a -> b) -> Validate a -> Validate b)
    -> (forall a b. a -> Validate b -> Validate a) -> Functor Validate
    forall a b. a -> Validate b -> Validate a
    forall a b. (a -> b) -> Validate a -> Validate b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Validate a -> Validate b
    fmap :: forall a b. (a -> b) -> Validate a -> Validate b
    $c<$ :: forall a b. a -> Validate b -> Validate a
    <$ :: forall a b. a -> Validate b -> Validate a
    Functor, Functor Validate
    Functor Validate =>
    (forall a. a -> Validate a)
    -> (forall a b. Validate (a -> b) -> Validate a -> Validate b)
    -> (forall a b c.
        (a -> b -> c) -> Validate a -> Validate b -> Validate c)
    -> (forall a b. Validate a -> Validate b -> Validate b)
    -> (forall a b. Validate a -> Validate b -> Validate a)
    -> Applicative Validate
    forall a. a -> Validate a
    forall a b. Validate a -> Validate b -> Validate a
    forall a b. Validate a -> Validate b -> Validate b
    forall a b. Validate (a -> b) -> Validate a -> Validate b
    forall a b c.
    (a -> b -> c) -> Validate a -> Validate b -> Validate c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> Validate a
    pure :: forall a. a -> Validate a
    $c<*> :: forall a b. Validate (a -> b) -> Validate a -> Validate b
    <*> :: forall a b. Validate (a -> b) -> Validate a -> Validate b
    $cliftA2 :: forall a b c.
    (a -> b -> c) -> Validate a -> Validate b -> Validate c
    liftA2 :: forall a b c.
    (a -> b -> c) -> Validate a -> Validate b -> Validate c
    $c*> :: forall a b. Validate a -> Validate b -> Validate b
    *> :: forall a b. Validate a -> Validate b -> Validate b
    $c<* :: forall a b. Validate a -> Validate b -> Validate a
    <* :: forall a b. Validate a -> Validate b -> Validate a
    Applicative, Applicative Validate
    Applicative Validate =>
    (forall a b. Validate a -> (a -> Validate b) -> Validate b)
    -> (forall a b. Validate a -> Validate b -> Validate b)
    -> (forall a. a -> Validate a)
    -> Monad Validate
    forall a. a -> Validate a
    forall a b. Validate a -> Validate b -> Validate b
    forall a b. Validate a -> (a -> Validate b) -> Validate b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a b. Validate a -> (a -> Validate b) -> Validate b
    >>= :: forall a b. Validate a -> (a -> Validate b) -> Validate b
    $c>> :: forall a b. Validate a -> Validate b -> Validate b
    >> :: forall a b. Validate a -> Validate b -> Validate b
    $creturn :: forall a. a -> Validate a
    return :: forall a. a -> Validate a
    Monad, MonadReader ValidateState)

    runValidate :: Validate a -> ValidateState -> a
    runValidate :: forall a. Validate a -> ValidateState -> a
    runValidate (Validate Reader ValidateState a
    r) = Reader ValidateState a -> ValidateState -> a
    forall r a. Reader r a -> r -> a
    runReader Reader ValidateState a
    r

    -- | A preassignment comprises knowledge about variables, but not
    -- necessarily fixed values.
    data PreAssignment = PA PPreAssignment FAssignment SAssignment

    -- | A (partial) package preassignment. Qualified package names
    -- are associated with MergedPkgDeps.
    type PPreAssignment = Map QPN MergedPkgDep

    -- | A dependency on a component, including its DependencyReason.
    data PkgDep = PkgDep (DependencyReason QPN) (PkgComponent QPN) CI

    -- | Map from component name to one of the reasons that the component is
    -- required.
    type ComponentDependencyReasons = Map ExposedComponent (DependencyReason QPN)

    -- | MergedPkgDep records constraints about the instances that can still be
    -- chosen, and in the extreme case fixes a concrete instance. Otherwise, it is a
    -- list of version ranges paired with the goals / variables that introduced
    -- them. It also records whether a package is a build-tool dependency, for each
    -- reason that it was introduced.
    --
    -- It is important to store the component name with the version constraint, for
    -- error messages, because whether something is a build-tool dependency affects
    -- its qualifier, which affects which constraint is applied.
    data MergedPkgDep =
        MergedDepFixed ExposedComponent (DependencyReason QPN) I
      | MergedDepConstrained [VROrigin]

    -- | Version ranges paired with origins.
    type VROrigin = (VR, ExposedComponent, DependencyReason QPN)

    -- | The information needed to create a 'Fail' node.
    type Conflict = (ConflictSet, FailReason)

    validate :: Tree d c -> Validate (Tree d c)
    validate :: forall d c. Tree d c -> Validate (Tree d c)
    validate = Tree d c -> Validate (Tree d c)
    forall d c. Tree d c -> Validate (Tree d c)
    go
      where
        go :: Tree d c -> Validate (Tree d c)

        go :: forall d c. Tree d c -> Validate (Tree d c)
    go (PChoice QPN
    qpn RevDepMap
    rdm c
    gr       WeightedPSQ [Weight] POption (Tree d c)
    ts) = 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)
    -> Validate (WeightedPSQ [Weight] POption (Tree d c))
    -> Validate (Tree d c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (POption -> Tree d c -> Validate (Tree d c))
    -> WeightedPSQ [Weight] POption (Tree d c)
    -> Validate (WeightedPSQ [Weight] POption (Tree d c))
    forall (f :: * -> *) k v v' w.
    Applicative f =>
    (k -> v -> f v') -> WeightedPSQ w k v -> f (WeightedPSQ w k v')
    W.traverseWithKey (\POption
    k -> QPN -> POption -> Validate (Tree d c) -> Validate (Tree d c)
    forall d c.
    QPN -> POption -> Validate (Tree d c) -> Validate (Tree d c)
    goP QPN
    qpn POption
    k (Validate (Tree d c) -> Validate (Tree d c))
    -> (Tree d c -> Validate (Tree d c))
    -> Tree d c
    -> Validate (Tree d c)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree d c -> Validate (Tree d c)
    forall d c. Tree d c -> Validate (Tree d c)
    go) WeightedPSQ [Weight] POption (Tree d c)
    ts
        go (FChoice FN QPN
    qfn RevDepMap
    rdm c
    gr WeakOrTrivial
    b FlagType
    m Bool
    d WeightedPSQ [Weight] Bool (Tree d c)
    ts) =
          do
            -- Flag choices may occur repeatedly (because they can introduce new constraints
            -- in various places). However, subsequent choices must be consistent. We thereby
            -- collapse repeated flag choice nodes.
            PA _ pfa _ <- (ValidateState -> PreAssignment) -> Validate PreAssignment
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ValidateState -> PreAssignment
    pa -- obtain current flag-preassignment
            case M.lookup qfn pfa of
              Just Bool
    rb -> -- flag has already been assigned; collapse choice to the correct branch
                         case Bool -> WeightedPSQ [Weight] Bool (Tree d c) -> Maybe (Tree d c)
    forall k w v. Eq k => k -> WeightedPSQ w k v -> Maybe v
    W.lookup Bool
    rb WeightedPSQ [Weight] Bool (Tree d c)
    ts of
                           Just Tree d c
    t  -> FN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
    forall d c.
    FN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
    goF FN QPN
    qfn Bool
    rb (Tree d c -> Validate (Tree d c)
    forall d c. Tree d c -> Validate (Tree d c)
    go Tree d c
    t)
                           Maybe (Tree d c)
    Nothing -> Tree d c -> Validate (Tree d c)
    forall a. a -> Validate a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Tree d c -> Validate (Tree d c))
    -> Tree d c -> Validate (Tree d c)
    forall a b. (a -> b) -> a -> b
    $ ConflictSet -> FailReason -> Tree d c
    forall d c. ConflictSet -> FailReason -> Tree d c
    Fail (Var QPN -> ConflictSet
    varToConflictSet (FN QPN -> Var QPN
    forall qpn. FN qpn -> Var qpn
    F FN QPN
    qfn)) (FN QPN -> FailReason
    MalformedFlagChoice FN QPN
    qfn)
              Maybe Bool
    Nothing -> -- flag choice is new, follow both branches
                         FN QPN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> FlagType
    -> Bool
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> Tree d c
    forall d c.
    FN QPN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> FlagType
    -> Bool
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> Tree d c
    FChoice FN QPN
    qfn RevDepMap
    rdm c
    gr WeakOrTrivial
    b FlagType
    m Bool
    d (WeightedPSQ [Weight] Bool (Tree d c) -> Tree d c)
    -> Validate (WeightedPSQ [Weight] Bool (Tree d c))
    -> Validate (Tree d c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Bool -> Tree d c -> Validate (Tree d c))
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> Validate (WeightedPSQ [Weight] Bool (Tree d c))
    forall (f :: * -> *) k v v' w.
    Applicative f =>
    (k -> v -> f v') -> WeightedPSQ w k v -> f (WeightedPSQ w k v')
    W.traverseWithKey (\Bool
    k -> FN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
    forall d c.
    FN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
    goF FN QPN
    qfn Bool
    k (Validate (Tree d c) -> Validate (Tree d c))
    -> (Tree d c -> Validate (Tree d c))
    -> Tree d c
    -> Validate (Tree d c)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree d c -> Validate (Tree d c)
    forall d c. Tree d c -> Validate (Tree d c)
    go) WeightedPSQ [Weight] Bool (Tree d c)
    ts
        go (SChoice SN QPN
    qsn RevDepMap
    rdm c
    gr WeakOrTrivial
    b   WeightedPSQ [Weight] Bool (Tree d c)
    ts) =
          do
            -- Optional stanza choices are very similar to flag choices.
            PA _ _ psa <- (ValidateState -> PreAssignment) -> Validate PreAssignment
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ValidateState -> PreAssignment
    pa -- obtain current stanza-preassignment
            case M.lookup qsn psa of
              Just Bool
    rb -> -- stanza choice has already been made; collapse choice to the correct branch
                         case Bool -> WeightedPSQ [Weight] Bool (Tree d c) -> Maybe (Tree d c)
    forall k w v. Eq k => k -> WeightedPSQ w k v -> Maybe v
    W.lookup Bool
    rb WeightedPSQ [Weight] Bool (Tree d c)
    ts of
                           Just Tree d c
    t  -> SN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
    forall d c.
    SN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
    goS SN QPN
    qsn Bool
    rb (Tree d c -> Validate (Tree d c)
    forall d c. Tree d c -> Validate (Tree d c)
    go Tree d c
    t)
                           Maybe (Tree d c)
    Nothing -> Tree d c -> Validate (Tree d c)
    forall a. a -> Validate a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Tree d c -> Validate (Tree d c))
    -> Tree d c -> Validate (Tree d c)
    forall a b. (a -> b) -> a -> b
    $ ConflictSet -> FailReason -> Tree d c
    forall d c. ConflictSet -> FailReason -> Tree d c
    Fail (Var QPN -> ConflictSet
    varToConflictSet (SN QPN -> Var QPN
    forall qpn. SN qpn -> Var qpn
    S SN QPN
    qsn)) (SN QPN -> FailReason
    MalformedStanzaChoice SN QPN
    qsn)
              Maybe Bool
    Nothing -> -- stanza choice is new, follow both branches
                         SN QPN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> Tree d c
    forall d c.
    SN QPN
    -> RevDepMap
    -> c
    -> WeakOrTrivial
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> Tree d c
    SChoice SN QPN
    qsn RevDepMap
    rdm c
    gr WeakOrTrivial
    b (WeightedPSQ [Weight] Bool (Tree d c) -> Tree d c)
    -> Validate (WeightedPSQ [Weight] Bool (Tree d c))
    -> Validate (Tree d c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Bool -> Tree d c -> Validate (Tree d c))
    -> WeightedPSQ [Weight] Bool (Tree d c)
    -> Validate (WeightedPSQ [Weight] Bool (Tree d c))
    forall (f :: * -> *) k v v' w.
    Applicative f =>
    (k -> v -> f v') -> WeightedPSQ w k v -> f (WeightedPSQ w k v')
    W.traverseWithKey (\Bool
    k -> SN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
    forall d c.
    SN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
    goS SN QPN
    qsn Bool
    k (Validate (Tree d c) -> Validate (Tree d c))
    -> (Tree d c -> Validate (Tree d c))
    -> Tree d c
    -> Validate (Tree d c)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree d c -> Validate (Tree d c)
    forall d c. Tree d c -> Validate (Tree d c)
    go) WeightedPSQ [Weight] Bool (Tree d c)
    ts

        -- We don't need to do anything for goal choices or failure nodes.
        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)
    -> Validate (PSQ (Goal QPN) (Tree d c)) -> Validate (Tree d c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Tree d c -> Validate (Tree d c))
    -> PSQ (Goal QPN) (Tree d c)
    -> Validate (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 -> Validate (Tree d c)
    forall d c. Tree d c -> Validate (Tree d c)
    go PSQ (Goal QPN) (Tree d c)
    ts
        go (Done       RevDepMap
    rdm d
    s           ) = Tree d c -> Validate (Tree d c)
    forall a. a -> Validate a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (RevDepMap -> d -> Tree d c
    forall d c. RevDepMap -> d -> Tree d c
    Done RevDepMap
    rdm d
    s)
        go (Fail    ConflictSet
    c FailReason
    fr               ) = Tree d c -> Validate (Tree d c)
    forall a. a -> Validate a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ConflictSet -> FailReason -> Tree d c
    forall d c. ConflictSet -> FailReason -> Tree d c
    Fail ConflictSet
    c FailReason
    fr)

        -- What to do for package nodes ...
        goP :: QPN -> POption -> Validate (Tree d c) -> Validate (Tree d c)
        goP :: forall d c.
    QPN -> POption -> Validate (Tree d c) -> Validate (Tree d c)
    goP qpn :: QPN
    qpn@(Q PackagePath
    _pp PackageName
    pn) (POption I
    i Maybe PackagePath
    _) Validate (Tree d c)
    r = do
          PA ppa pfa psa <- (ValidateState -> PreAssignment) -> Validate PreAssignment
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ValidateState -> PreAssignment
    pa    -- obtain current preassignment
          extSupported   <- asks supportedExt  -- obtain the supported extensions
          langSupported  <- asks supportedLang -- obtain the supported languages
          pkgPresent     <- asks presentPkgs -- obtain the present pkg-config pkgs
          idx            <- asks index -- obtain the index
          svd            <- asks saved -- obtain saved dependencies
          aComps         <- asks availableComponents
          rComps         <- asks requiredComponents
          qo             <- asks qualifyOptions
          -- obtain dependencies and index-dictated exclusions introduced by the choice
          let (PInfo deps comps _ mfr) = idx ! pn ! i
          -- qualify the deps in the current scope
          let qdeps = QualifyOptions -> QPN -> FlaggedDeps PackageName -> FlaggedDeps QPN
    qualifyDeps QualifyOptions
    qo QPN
    qpn FlaggedDeps PackageName
    deps
          -- the new active constraints are given by the instance we have chosen,
          -- plus the dependency information we have for that instance
          let newactives = FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
    extractAllDeps FAssignment
    pfa SAssignment
    psa FlaggedDeps QPN
    qdeps
          -- We now try to extend the partial assignment with the new active constraints.
          let mnppa = (Extension -> Bool)
    -> (Language -> Bool)
    -> (PkgconfigName -> PkgconfigVersionRange -> Bool)
    -> [LDep QPN]
    -> PPreAssignment
    -> Either Conflict PPreAssignment
    extend Extension -> Bool
    extSupported Language -> Bool
    langSupported PkgconfigName -> PkgconfigVersionRange -> Bool
    pkgPresent [LDep QPN]
    newactives
                       (PPreAssignment -> Either Conflict PPreAssignment)
    -> Either Conflict PPreAssignment -> Either Conflict PPreAssignment
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< PI QPN -> PPreAssignment -> Either Conflict PPreAssignment
    extendWithPackageChoice (QPN -> I -> PI QPN
    forall qpn. qpn -> I -> PI qpn
    PI QPN
    qpn I
    i) PPreAssignment
    ppa
          -- In case we continue, we save the scoped dependencies
          let nsvd = QPN
    -> FlaggedDeps QPN
    -> Map QPN (FlaggedDeps QPN)
    -> Map QPN (FlaggedDeps QPN)
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert QPN
    qpn FlaggedDeps QPN
    qdeps Map QPN (FlaggedDeps QPN)
    svd
          case mfr of
            Just FailReason
    fr -> -- The index marks this as an invalid choice. We can stop.
                       Tree d c -> Validate (Tree d c)
    forall a. a -> Validate a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (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
    fr)
            Maybe FailReason
    Nothing ->
              let newDeps :: Either Conflict (PPreAssignment, Map QPN ComponentDependencyReasons)
                  newDeps :: Either
      Conflict (PPreAssignment, Map QPN ComponentDependencyReasons)
    newDeps = do
                    nppa <- Either Conflict PPreAssignment
    mnppa
                    rComps' <- extendRequiredComponents qpn aComps rComps newactives
                    checkComponentsInNewPackage (M.findWithDefault M.empty qpn rComps) qpn comps
                    return (nppa, rComps')
              in case Either
      Conflict (PPreAssignment, Map QPN ComponentDependencyReasons)
    newDeps of
                   Left (ConflictSet
    c, FailReason
    fr)          -> -- We have an inconsistency. We can stop.
                                            Tree d c -> Validate (Tree d c)
    forall a. a -> Validate a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ConflictSet -> FailReason -> Tree d c
    forall d c. ConflictSet -> FailReason -> Tree d c
    Fail ConflictSet
    c FailReason
    fr)
                   Right (PPreAssignment
    nppa, Map QPN ComponentDependencyReasons
    rComps') -> -- We have an updated partial assignment for the recursive validation.
                                            (ValidateState -> ValidateState)
    -> Validate (Tree d c) -> Validate (Tree d c)
    forall a.
    (ValidateState -> ValidateState) -> Validate a -> Validate a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\ ValidateState
    s -> ValidateState
    s { pa = PA nppa pfa psa
                                                            , saved = nsvd
                                                            , availableComponents = M.insert qpn comps aComps
                                                            , requiredComponents = rComps'
                                                            }) Validate (Tree d c)
    r

        -- What to do for flag nodes ...
        goF :: QFN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
        goF :: forall d c.
    FN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
    goF qfn :: FN QPN
    qfn@(FN QPN
    qpn Flag
    _f) Bool
    b Validate (Tree d c)
    r = do
          PA ppa pfa psa <- (ValidateState -> PreAssignment) -> Validate PreAssignment
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ValidateState -> PreAssignment
    pa -- obtain current preassignment
          extSupported   <- asks supportedExt  -- obtain the supported extensions
          langSupported  <- asks supportedLang -- obtain the supported languages
          pkgPresent     <- asks presentPkgs   -- obtain the present pkg-config pkgs
          svd            <- asks saved         -- obtain saved dependencies
          aComps         <- asks availableComponents
          rComps         <- asks requiredComponents
          -- Note that there should be saved dependencies for the package in question,
          -- because while building, we do not choose flags before we see the packages
          -- that define them.
          let qdeps = Map QPN (FlaggedDeps QPN)
    svd Map QPN (FlaggedDeps QPN) -> QPN -> FlaggedDeps QPN
    forall k a. Ord k => Map k a -> k -> a
    ! QPN
    qpn
          -- We take the *saved* dependencies, because these have been qualified in the
          -- correct scope.
          --
          -- Extend the flag assignment
          let npfa = FN QPN -> Bool -> FAssignment -> FAssignment
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert FN QPN
    qfn Bool
    b FAssignment
    pfa
          -- We now try to get the new active dependencies we might learn about because
          -- we have chosen a new flag.
          let newactives = Var QPN
    -> Bool
    -> FAssignment
    -> SAssignment
    -> FlaggedDeps QPN
    -> [LDep QPN]
    extractNewDeps (FN QPN -> Var QPN
    forall qpn. FN qpn -> Var qpn
    F FN QPN
    qfn) Bool
    b FAssignment
    npfa SAssignment
    psa FlaggedDeps QPN
    qdeps
              mNewRequiredComps = QPN
    -> Map QPN (Map ExposedComponent ComponentInfo)
    -> Map QPN ComponentDependencyReasons
    -> [LDep QPN]
    -> Either Conflict (Map QPN ComponentDependencyReasons)
    extendRequiredComponents QPN
    qpn Map QPN (Map ExposedComponent ComponentInfo)
    aComps Map QPN ComponentDependencyReasons
    rComps [LDep QPN]
    newactives
          -- As in the package case, we try to extend the partial assignment.
          let mnppa = (Extension -> Bool)
    -> (Language -> Bool)
    -> (PkgconfigName -> PkgconfigVersionRange -> Bool)
    -> [LDep QPN]
    -> PPreAssignment
    -> Either Conflict PPreAssignment
    extend Extension -> Bool
    extSupported Language -> Bool
    langSupported PkgconfigName -> PkgconfigVersionRange -> Bool
    pkgPresent [LDep QPN]
    newactives PPreAssignment
    ppa
          case liftM2 (,) mnppa mNewRequiredComps of
            Left (ConflictSet
    c, FailReason
    fr)         -> Tree d c -> Validate (Tree d c)
    forall a. a -> Validate a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ConflictSet -> FailReason -> Tree d c
    forall d c. ConflictSet -> FailReason -> Tree d c
    Fail ConflictSet
    c FailReason
    fr) -- inconsistency found
            Right (PPreAssignment
    nppa, Map QPN ComponentDependencyReasons
    rComps') ->
                (ValidateState -> ValidateState)
    -> Validate (Tree d c) -> Validate (Tree d c)
    forall a.
    (ValidateState -> ValidateState) -> Validate a -> Validate a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\ ValidateState
    s -> ValidateState
    s { pa = PA nppa npfa psa, requiredComponents = rComps' }) Validate (Tree d c)
    r

        -- What to do for stanza nodes (similar to flag nodes) ...
        goS :: QSN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
        goS :: forall d c.
    SN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
    goS qsn :: SN QPN
    qsn@(SN QPN
    qpn Stanza
    _f) Bool
    b Validate (Tree d c)
    r = do
          PA ppa pfa psa <- (ValidateState -> PreAssignment) -> Validate PreAssignment
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ValidateState -> PreAssignment
    pa -- obtain current preassignment
          extSupported   <- asks supportedExt  -- obtain the supported extensions
          langSupported  <- asks supportedLang -- obtain the supported languages
          pkgPresent     <- asks presentPkgs -- obtain the present pkg-config pkgs
          svd            <- asks saved         -- obtain saved dependencies
          aComps         <- asks availableComponents
          rComps         <- asks requiredComponents
          -- Note that there should be saved dependencies for the package in question,
          -- because while building, we do not choose flags before we see the packages
          -- that define them.
          let qdeps = Map QPN (FlaggedDeps QPN)
    svd Map QPN (FlaggedDeps QPN) -> QPN -> FlaggedDeps QPN
    forall k a. Ord k => Map k a -> k -> a
    ! QPN
    qpn
          -- We take the *saved* dependencies, because these have been qualified in the
          -- correct scope.
          --
          -- Extend the flag assignment
          let npsa = SN QPN -> Bool -> SAssignment -> SAssignment
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert SN QPN
    qsn Bool
    b SAssignment
    psa
          -- We now try to get the new active dependencies we might learn about because
          -- we have chosen a new flag.
          let newactives = Var QPN
    -> Bool
    -> FAssignment
    -> SAssignment
    -> FlaggedDeps QPN
    -> [LDep QPN]
    extractNewDeps (SN QPN -> Var QPN
    forall qpn. SN qpn -> Var qpn
    S SN QPN
    qsn) Bool
    b FAssignment
    pfa SAssignment
    npsa FlaggedDeps QPN
    qdeps
              mNewRequiredComps = QPN
    -> Map QPN (Map ExposedComponent ComponentInfo)
    -> Map QPN ComponentDependencyReasons
    -> [LDep QPN]
    -> Either Conflict (Map QPN ComponentDependencyReasons)
    extendRequiredComponents QPN
    qpn Map QPN (Map ExposedComponent ComponentInfo)
    aComps Map QPN ComponentDependencyReasons
    rComps [LDep QPN]
    newactives
          -- As in the package case, we try to extend the partial assignment.
          let mnppa = (Extension -> Bool)
    -> (Language -> Bool)
    -> (PkgconfigName -> PkgconfigVersionRange -> Bool)
    -> [LDep QPN]
    -> PPreAssignment
    -> Either Conflict PPreAssignment
    extend Extension -> Bool
    extSupported Language -> Bool
    langSupported PkgconfigName -> PkgconfigVersionRange -> Bool
    pkgPresent [LDep QPN]
    newactives PPreAssignment
    ppa
          case liftM2 (,) mnppa mNewRequiredComps of
            Left (ConflictSet
    c, FailReason
    fr)         -> Tree d c -> Validate (Tree d c)
    forall a. a -> Validate a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ConflictSet -> FailReason -> Tree d c
    forall d c. ConflictSet -> FailReason -> Tree d c
    Fail ConflictSet
    c FailReason
    fr) -- inconsistency found
            Right (PPreAssignment
    nppa, Map QPN ComponentDependencyReasons
    rComps') ->
                (ValidateState -> ValidateState)
    -> Validate (Tree d c) -> Validate (Tree d c)
    forall a.
    (ValidateState -> ValidateState) -> Validate a -> Validate a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\ ValidateState
    s -> ValidateState
    s { pa = PA nppa pfa npsa, requiredComponents = rComps' }) Validate (Tree d c)
    r

    -- | Check that a newly chosen package instance contains all components that
    -- are required from that package so far. The components must also be visible
    -- and buildable.
    checkComponentsInNewPackage :: ComponentDependencyReasons
                                -> QPN
                                -> Map ExposedComponent ComponentInfo
                                -> Either Conflict ()
    checkComponentsInNewPackage :: ComponentDependencyReasons
    -> QPN -> Map ExposedComponent ComponentInfo -> Either Conflict ()
    checkComponentsInNewPackage ComponentDependencyReasons
    required QPN
    qpn Map ExposedComponent ComponentInfo
    providedComps =
        case ComponentDependencyReasons
    -> [(ExposedComponent, DependencyReason QPN)]
    forall k a. Map k a -> [(k, a)]
    M.toList (ComponentDependencyReasons
     -> [(ExposedComponent, DependencyReason QPN)])
    -> ComponentDependencyReasons
    -> [(ExposedComponent, DependencyReason QPN)]
    forall a b. (a -> b) -> a -> b
    $ [ExposedComponent]
    -> ComponentDependencyReasons -> ComponentDependencyReasons
    forall k v. Ord k => [k] -> Map k v -> Map k v
    deleteKeys (Map ExposedComponent ComponentInfo -> [ExposedComponent]
    forall k a. Map k a -> [k]
    M.keys Map ExposedComponent ComponentInfo
    providedComps) ComponentDependencyReasons
    required of
          (ExposedComponent
    missingComp, DependencyReason QPN
    dr) : [(ExposedComponent, DependencyReason QPN)]
    _ ->
              Conflict -> Either Conflict ()
    forall a b. a -> Either a b
    Left (Conflict -> Either Conflict ()) -> Conflict -> Either Conflict ()
    forall a b. (a -> b) -> a -> b
    $ ExposedComponent
    -> DependencyReason QPN
    -> (ExposedComponent -> DependencyReason QPN -> FailReason)
    -> Conflict
    mkConflict ExposedComponent
    missingComp DependencyReason QPN
    dr ExposedComponent -> DependencyReason QPN -> FailReason
    NewPackageIsMissingRequiredComponent
          []                    ->
              let failures :: [Conflict]
    failures = [Either Conflict ()] -> [Conflict]
    forall a b. [Either a b] -> [a]
    lefts
                      [ case () of
                          ()
    _ | ComponentInfo -> IsVisible
    compIsVisible ComponentInfo
    compInfo IsVisible -> IsVisible -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool -> IsVisible
    IsVisible Bool
    False ->
                              Conflict -> Either Conflict ()
    forall a b. a -> Either a b
    Left (Conflict -> Either Conflict ()) -> Conflict -> Either Conflict ()
    forall a b. (a -> b) -> a -> b
    $ ExposedComponent
    -> DependencyReason QPN
    -> (ExposedComponent -> DependencyReason QPN -> FailReason)
    -> Conflict
    mkConflict ExposedComponent
    comp DependencyReason QPN
    dr ExposedComponent -> DependencyReason QPN -> FailReason
    NewPackageHasPrivateRequiredComponent
                            | ComponentInfo -> IsBuildable
    compIsBuildable ComponentInfo
    compInfo IsBuildable -> IsBuildable -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool -> IsBuildable
    IsBuildable Bool
    False ->
                              Conflict -> Either Conflict ()
    forall a b. a -> Either a b
    Left (Conflict -> Either Conflict ()) -> Conflict -> Either Conflict ()
    forall a b. (a -> b) -> a -> b
    $ ExposedComponent
    -> DependencyReason QPN
    -> (ExposedComponent -> DependencyReason QPN -> FailReason)
    -> Conflict
    mkConflict ExposedComponent
    comp DependencyReason QPN
    dr ExposedComponent -> DependencyReason QPN -> FailReason
    NewPackageHasUnbuildableRequiredComponent
                            | Bool
    otherwise -> () -> Either Conflict ()
    forall a b. b -> Either a b
    Right ()
                      | let merged :: Map ExposedComponent (DependencyReason QPN, ComponentInfo)
    merged = (DependencyReason QPN
     -> ComponentInfo -> (DependencyReason QPN, ComponentInfo))
    -> ComponentDependencyReasons
    -> Map ExposedComponent ComponentInfo
    -> Map ExposedComponent (DependencyReason QPN, ComponentInfo)
    forall k a b c.
    Ord k =>
    (a -> b -> c) -> Map k a -> Map k b -> Map k c
    M.intersectionWith (,) ComponentDependencyReasons
    required Map ExposedComponent ComponentInfo
    providedComps
                      , (ExposedComponent
    comp, (DependencyReason QPN
    dr, ComponentInfo
    compInfo)) <- Map ExposedComponent (DependencyReason QPN, ComponentInfo)
    -> [(ExposedComponent, (DependencyReason QPN, ComponentInfo))]
    forall k a. Map k a -> [(k, a)]
    M.toList Map ExposedComponent (DependencyReason QPN, ComponentInfo)
    merged ]
              in case [Conflict]
    failures of
                   Conflict
    failure : [Conflict]
    _ -> Conflict -> Either Conflict ()
    forall a b. a -> Either a b
    Left Conflict
    failure
                   []          -> () -> Either Conflict ()
    forall a b. b -> Either a b
    Right ()
      where
        mkConflict :: ExposedComponent
                   -> DependencyReason QPN
                   -> (ExposedComponent -> DependencyReason QPN -> FailReason)
                   -> Conflict
        mkConflict :: ExposedComponent
    -> DependencyReason QPN
    -> (ExposedComponent -> DependencyReason QPN -> FailReason)
    -> Conflict
    mkConflict ExposedComponent
    comp DependencyReason QPN
    dr ExposedComponent -> DependencyReason QPN -> FailReason
    mkFailure =
            (Var QPN -> ConflictSet -> ConflictSet
    CS.insert (QPN -> Var QPN
    forall qpn. qpn -> Var qpn
    P QPN
    qpn) (DependencyReason QPN -> ConflictSet
    dependencyReasonToConflictSet DependencyReason QPN
    dr), ExposedComponent -> DependencyReason QPN -> FailReason
    mkFailure ExposedComponent
    comp DependencyReason QPN
    dr)

        deleteKeys :: Ord k => [k] -> Map k v -> Map k v
        deleteKeys :: forall k v. Ord k => [k] -> Map k v -> Map k v
    deleteKeys [k]
    ks Map k v
    m = (k -> Map k v -> Map k v) -> Map k v -> [k] -> Map k v
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    L.foldr k -> Map k v -> Map k v
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete Map k v
    m [k]
    ks

    -- | We try to extract as many concrete dependencies from the given flagged
    -- dependencies as possible. We make use of all the flag knowledge we have
    -- already acquired.
    extractAllDeps :: FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
    extractAllDeps :: FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
    extractAllDeps FAssignment
    fa SAssignment
    sa FlaggedDeps QPN
    deps = do
      d <- FlaggedDeps QPN
    deps
      case d of
        Simple LDep QPN
    sd Component
    _         -> LDep QPN -> [LDep QPN]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return LDep QPN
    sd
        Flagged FN QPN
    qfn FInfo
    _ FlaggedDeps QPN
    td FlaggedDeps QPN
    fd -> case FN QPN -> FAssignment -> Maybe Bool
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup FN QPN
    qfn FAssignment
    fa of
                                 Maybe Bool
    Nothing    -> [LDep QPN]
    forall a. [a]
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
                                 Just Bool
    True  -> FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
    extractAllDeps FAssignment
    fa SAssignment
    sa FlaggedDeps QPN
    td
                                 Just Bool
    False -> FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
    extractAllDeps FAssignment
    fa SAssignment
    sa FlaggedDeps QPN
    fd
        Stanza SN QPN
    qsn FlaggedDeps QPN
    td       -> case SN QPN -> SAssignment -> Maybe Bool
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup SN QPN
    qsn SAssignment
    sa of
                                 Maybe Bool
    Nothing    -> [LDep QPN]
    forall a. [a]
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
                                 Just Bool
    True  -> FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
    extractAllDeps FAssignment
    fa SAssignment
    sa FlaggedDeps QPN
    td
                                 Just Bool
    False -> []

    -- | We try to find new dependencies that become available due to the given
    -- flag or stanza choice. We therefore look for the choice in question, and then call
    -- 'extractAllDeps' for everything underneath.
    extractNewDeps :: Var QPN -> Bool -> FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
    extractNewDeps :: Var QPN
    -> Bool
    -> FAssignment
    -> SAssignment
    -> FlaggedDeps QPN
    -> [LDep QPN]
    extractNewDeps Var QPN
    v Bool
    b FAssignment
    fa SAssignment
    sa = FlaggedDeps QPN -> [LDep QPN]
    go
      where
        go :: FlaggedDeps QPN -> [LDep QPN]
        go :: FlaggedDeps QPN -> [LDep QPN]
    go FlaggedDeps QPN
    deps = do
          d <- FlaggedDeps QPN
    deps
          case d of
            Simple LDep QPN
    _ Component
    _           -> [LDep QPN]
    forall a. [a]
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
            Flagged FN QPN
    qfn' FInfo
    _ FlaggedDeps QPN
    td FlaggedDeps QPN
    fd
              | Var QPN
    v Var QPN -> Var QPN -> Bool
    forall a. Eq a => a -> a -> Bool
    == FN QPN -> Var QPN
    forall qpn. FN qpn -> Var qpn
    F FN QPN
    qfn'      -> if Bool
    b then FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
    extractAllDeps FAssignment
    fa SAssignment
    sa FlaggedDeps QPN
    td else FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
    extractAllDeps FAssignment
    fa SAssignment
    sa FlaggedDeps QPN
    fd
              | Bool
    otherwise        -> case FN QPN -> FAssignment -> Maybe Bool
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup FN QPN
    qfn' FAssignment
    fa of
                                      Maybe Bool
    Nothing    -> [LDep QPN]
    forall a. [a]
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
                                      Just Bool
    True  -> FlaggedDeps QPN -> [LDep QPN]
    go FlaggedDeps QPN
    td
                                      Just Bool
    False -> FlaggedDeps QPN -> [LDep QPN]
    go FlaggedDeps QPN
    fd
            Stanza SN QPN
    qsn' FlaggedDeps QPN
    td
              | Var QPN
    v Var QPN -> Var QPN -> Bool
    forall a. Eq a => a -> a -> Bool
    == SN QPN -> Var QPN
    forall qpn. SN qpn -> Var qpn
    S SN QPN
    qsn'      -> if Bool
    b then FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
    extractAllDeps FAssignment
    fa SAssignment
    sa FlaggedDeps QPN
    td else []
              | Bool
    otherwise        -> case SN QPN -> SAssignment -> Maybe Bool
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup SN QPN
    qsn' SAssignment
    sa of
                                      Maybe Bool
    Nothing    -> [LDep QPN]
    forall a. [a]
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
                                      Just Bool
    True  -> FlaggedDeps QPN -> [LDep QPN]
    go FlaggedDeps QPN
    td
                                      Just Bool
    False -> []

    -- | Extend a package preassignment.
    --
    -- Takes the variable that causes the new constraints, a current preassignment
    -- and a set of new dependency constraints.
    --
    -- We're trying to extend the preassignment with each dependency one by one.
    -- Each dependency is for a particular variable. We check if we already have
    -- constraints for that variable in the current preassignment. If so, we're
    -- trying to merge the constraints.
    --
    -- Either returns a witness of the conflict that would arise during the merge,
    -- or the successfully extended assignment.
    extend :: (Extension -> Bool)            -- ^ is a given extension supported
           -> (Language  -> Bool)            -- ^ is a given language supported
           -> (PkgconfigName -> PkgconfigVersionRange -> Bool) -- ^ is a given pkg-config requirement satisfiable
           -> [LDep QPN]
           -> PPreAssignment
           -> Either Conflict PPreAssignment
    extend :: (Extension -> Bool)
    -> (Language -> Bool)
    -> (PkgconfigName -> PkgconfigVersionRange -> Bool)
    -> [LDep QPN]
    -> PPreAssignment
    -> Either Conflict PPreAssignment
    extend Extension -> Bool
    extSupported Language -> Bool
    langSupported PkgconfigName -> PkgconfigVersionRange -> Bool
    pkgPresent [LDep QPN]
    newactives PPreAssignment
    ppa = (PPreAssignment -> LDep QPN -> Either Conflict PPreAssignment)
    -> PPreAssignment -> [LDep QPN] -> Either Conflict PPreAssignment
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM PPreAssignment -> LDep QPN -> Either Conflict PPreAssignment
    extendSingle PPreAssignment
    ppa [LDep QPN]
    newactives
      where

        extendSingle :: PPreAssignment -> LDep QPN -> Either Conflict PPreAssignment
        extendSingle :: PPreAssignment -> LDep QPN -> Either Conflict PPreAssignment
    extendSingle PPreAssignment
    a (LDep DependencyReason QPN
    dr (Ext  Extension
    ext ))  =
          if Extension -> Bool
    extSupported  Extension
    ext  then PPreAssignment -> Either Conflict PPreAssignment
    forall a b. b -> Either a b
    Right PPreAssignment
    a
                                else Conflict -> Either Conflict PPreAssignment
    forall a b. a -> Either a b
    Left (DependencyReason QPN -> ConflictSet
    dependencyReasonToConflictSet DependencyReason QPN
    dr, Extension -> FailReason
    UnsupportedExtension Extension
    ext)
        extendSingle PPreAssignment
    a (LDep DependencyReason QPN
    dr (Lang Language
    lang))  =
          if Language -> Bool
    langSupported Language
    lang then PPreAssignment -> Either Conflict PPreAssignment
    forall a b. b -> Either a b
    Right PPreAssignment
    a
                                else Conflict -> Either Conflict PPreAssignment
    forall a b. a -> Either a b
    Left (DependencyReason QPN -> ConflictSet
    dependencyReasonToConflictSet DependencyReason QPN
    dr, Language -> FailReason
    UnsupportedLanguage Language
    lang)
        extendSingle PPreAssignment
    a (LDep DependencyReason QPN
    dr (Pkg PkgconfigName
    pn PkgconfigVersionRange
    vr))  =
          if PkgconfigName -> PkgconfigVersionRange -> Bool
    pkgPresent PkgconfigName
    pn PkgconfigVersionRange
    vr then PPreAssignment -> Either Conflict PPreAssignment
    forall a b. b -> Either a b
    Right PPreAssignment
    a
                              else Conflict -> Either Conflict PPreAssignment
    forall a b. a -> Either a b
    Left (DependencyReason QPN -> ConflictSet
    dependencyReasonToConflictSet DependencyReason QPN
    dr, PkgconfigName -> PkgconfigVersionRange -> FailReason
    MissingPkgconfigPackage PkgconfigName
    pn PkgconfigVersionRange
    vr)
        extendSingle PPreAssignment
    a (LDep DependencyReason QPN
    dr (Dep dep :: PkgComponent QPN
    dep@(PkgComponent QPN
    qpn ExposedComponent
    _) CI
    ci)) =
          let mergedDep :: MergedPkgDep
    mergedDep = MergedPkgDep -> QPN -> PPreAssignment -> MergedPkgDep
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault ([VROrigin] -> MergedPkgDep
    MergedDepConstrained []) QPN
    qpn PPreAssignment
    a
          in  case (\ MergedPkgDep
    x -> QPN -> MergedPkgDep -> PPreAssignment -> PPreAssignment
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert QPN
    qpn MergedPkgDep
    x PPreAssignment
    a) (MergedPkgDep -> PPreAssignment)
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) PPreAssignment
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MergedPkgDep
    -> PkgDep
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    merge MergedPkgDep
    mergedDep (DependencyReason QPN -> PkgComponent QPN -> CI -> PkgDep
    PkgDep DependencyReason QPN
    dr PkgComponent QPN
    dep CI
    ci) of
                Left (ConflictSet
    c, (ConflictingDep
    d, ConflictingDep
    d')) -> Conflict -> Either Conflict PPreAssignment
    forall a b. a -> Either a b
    Left (ConflictSet
    c, ConflictingDep -> ConflictingDep -> FailReason
    ConflictingConstraints ConflictingDep
    d ConflictingDep
    d')
                Right PPreAssignment
    x           -> PPreAssignment -> Either Conflict PPreAssignment
    forall a b. b -> Either a b
    Right PPreAssignment
    x

    -- | Extend a package preassignment with a package choice. For example, when
    -- the solver chooses foo-2.0, it tries to add the constraint foo==2.0.
    --
    -- TODO: The new constraint is implemented as a dependency from foo to foo's
    -- main library. That isn't correct, because foo might only be needed as a build
    -- tool dependency. The implementation may need to change when we support
    -- component-based dependency solving.
    extendWithPackageChoice :: PI QPN -> PPreAssignment -> Either Conflict PPreAssignment
    extendWithPackageChoice :: PI QPN -> PPreAssignment -> Either Conflict PPreAssignment
    extendWithPackageChoice (PI QPN
    qpn I
    i) PPreAssignment
    ppa =
      let mergedDep :: MergedPkgDep
    mergedDep = MergedPkgDep -> QPN -> PPreAssignment -> MergedPkgDep
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault ([VROrigin] -> MergedPkgDep
    MergedDepConstrained []) QPN
    qpn PPreAssignment
    ppa
          newChoice :: PkgDep
    newChoice = DependencyReason QPN -> PkgComponent QPN -> CI -> PkgDep
    PkgDep (QPN -> Map Flag FlagValue -> Set Stanza -> DependencyReason QPN
    forall qpn.
    qpn -> Map Flag FlagValue -> Set Stanza -> DependencyReason qpn
    DependencyReason QPN
    qpn Map Flag FlagValue
    forall k a. Map k a
    M.empty Set Stanza
    forall a. Set a
    S.empty)
                             (QPN -> ExposedComponent -> PkgComponent QPN
    forall qpn. qpn -> ExposedComponent -> PkgComponent qpn
    PkgComponent QPN
    qpn (LibraryName -> ExposedComponent
    ExposedLib LibraryName
    LMainLibName))
                             (I -> CI
    Fixed I
    i)
      in  case (\ MergedPkgDep
    x -> QPN -> MergedPkgDep -> PPreAssignment -> PPreAssignment
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert QPN
    qpn MergedPkgDep
    x PPreAssignment
    ppa) (MergedPkgDep -> PPreAssignment)
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) PPreAssignment
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MergedPkgDep
    -> PkgDep
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    merge MergedPkgDep
    mergedDep PkgDep
    newChoice of
            Left (ConflictSet
    c, (ConflictingDep
    d, ConflictingDep
    _d')) -> -- Don't include the package choice in the
                                  -- FailReason, because it is redundant.
                                  Conflict -> Either Conflict PPreAssignment
    forall a b. a -> Either a b
    Left (ConflictSet
    c, ConflictingDep -> FailReason
    NewPackageDoesNotMatchExistingConstraint ConflictingDep
    d)
            Right PPreAssignment
    x            -> PPreAssignment -> Either Conflict PPreAssignment
    forall a b. b -> Either a b
    Right PPreAssignment
    x

    -- | Merge constrained instances. We currently adopt a lazy strategy for
    -- merging, i.e., we only perform actual checking if one of the two choices
    -- is fixed. If the merge fails, we return a conflict set indicating the
    -- variables responsible for the failure, as well as the two conflicting
    -- fragments.
    --
    -- Note that while there may be more than one conflicting pair of version
    -- ranges, we only return the first we find.
    --
    -- The ConflictingDeps are returned in order, i.e., the first describes the
    -- conflicting part of the MergedPkgDep, and the second describes the PkgDep.
    --
    -- TODO: Different pairs might have different conflict sets. We're
    -- obviously interested to return a conflict that has a "better" conflict
    -- set in the sense the it contains variables that allow us to backjump
    -- further. We might apply some heuristics here, such as to change the
    -- order in which we check the constraints.
    merge :: MergedPkgDep -> PkgDep -> Either (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    merge :: MergedPkgDep
    -> PkgDep
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    merge (MergedDepFixed ExposedComponent
    comp1 DependencyReason QPN
    vs1 I
    i1) (PkgDep DependencyReason QPN
    vs2 (PkgComponent QPN
    p ExposedComponent
    comp2) ci :: CI
    ci@(Fixed I
    i2))
      | I
    i1 I -> I -> Bool
    forall a. Eq a => a -> a -> Bool
    == I
    i2  = MergedPkgDep
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    forall a b. b -> Either a b
    Right (MergedPkgDep
     -> Either
          (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep)
    -> MergedPkgDep
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    forall a b. (a -> b) -> a -> b
    $ ExposedComponent -> DependencyReason QPN -> I -> MergedPkgDep
    MergedDepFixed ExposedComponent
    comp1 DependencyReason QPN
    vs1 I
    i1
      | Bool
    otherwise =
          (ConflictSet, (ConflictingDep, ConflictingDep))
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    forall a b. a -> Either a b
    Left ( (ConflictSet -> ConflictSet -> ConflictSet
    CS.union (ConflictSet -> ConflictSet -> ConflictSet)
    -> (DependencyReason QPN -> ConflictSet)
    -> DependencyReason QPN
    -> DependencyReason QPN
    -> ConflictSet
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` DependencyReason QPN -> ConflictSet
    dependencyReasonToConflictSet) DependencyReason QPN
    vs1 DependencyReason QPN
    vs2
               , ( DependencyReason QPN -> PkgComponent QPN -> CI -> ConflictingDep
    ConflictingDep DependencyReason QPN
    vs1 (QPN -> ExposedComponent -> PkgComponent QPN
    forall qpn. qpn -> ExposedComponent -> PkgComponent qpn
    PkgComponent QPN
    p ExposedComponent
    comp1) (I -> CI
    Fixed I
    i1)
                 , DependencyReason QPN -> PkgComponent QPN -> CI -> ConflictingDep
    ConflictingDep DependencyReason QPN
    vs2 (QPN -> ExposedComponent -> PkgComponent QPN
    forall qpn. qpn -> ExposedComponent -> PkgComponent qpn
    PkgComponent QPN
    p ExposedComponent
    comp2) CI
    ci ) )

    merge (MergedDepFixed ExposedComponent
    comp1 DependencyReason QPN
    vs1 i :: I
    i@(I Ver
    v Loc
    _)) (PkgDep DependencyReason QPN
    vs2 (PkgComponent QPN
    p ExposedComponent
    comp2) ci :: CI
    ci@(Constrained VR
    vr))
      | VR -> Ver -> Bool
    checkVR VR
    vr Ver
    v = MergedPkgDep
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    forall a b. b -> Either a b
    Right (MergedPkgDep
     -> Either
          (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep)
    -> MergedPkgDep
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    forall a b. (a -> b) -> a -> b
    $ ExposedComponent -> DependencyReason QPN -> I -> MergedPkgDep
    MergedDepFixed ExposedComponent
    comp1 DependencyReason QPN
    vs1 I
    i
      | Bool
    otherwise    =
          (ConflictSet, (ConflictingDep, ConflictingDep))
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    forall a b. a -> Either a b
    Left ( QPN
    -> Ver
    -> DependencyReason QPN
    -> VR
    -> DependencyReason QPN
    -> ConflictSet
    createConflictSetForVersionConflict QPN
    p Ver
    v DependencyReason QPN
    vs1 VR
    vr DependencyReason QPN
    vs2
               , ( DependencyReason QPN -> PkgComponent QPN -> CI -> ConflictingDep
    ConflictingDep DependencyReason QPN
    vs1 (QPN -> ExposedComponent -> PkgComponent QPN
    forall qpn. qpn -> ExposedComponent -> PkgComponent qpn
    PkgComponent QPN
    p ExposedComponent
    comp1) (I -> CI
    Fixed I
    i)
                 , DependencyReason QPN -> PkgComponent QPN -> CI -> ConflictingDep
    ConflictingDep DependencyReason QPN
    vs2 (QPN -> ExposedComponent -> PkgComponent QPN
    forall qpn. qpn -> ExposedComponent -> PkgComponent qpn
    PkgComponent QPN
    p ExposedComponent
    comp2) CI
    ci ) )

    merge (MergedDepConstrained [VROrigin]
    vrOrigins) (PkgDep DependencyReason QPN
    vs2 (PkgComponent QPN
    p ExposedComponent
    comp2) ci :: CI
    ci@(Fixed i :: I
    i@(I Ver
    v Loc
    _))) =
        [VROrigin]
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    go [VROrigin]
    vrOrigins -- I tried "reverse vrOrigins" here, but it seems to slow things down ...
      where
        go :: [VROrigin] -> Either (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
        go :: [VROrigin]
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    go [] = MergedPkgDep
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    forall a b. b -> Either a b
    Right (ExposedComponent -> DependencyReason QPN -> I -> MergedPkgDep
    MergedDepFixed ExposedComponent
    comp2 DependencyReason QPN
    vs2 I
    i)
        go ((VR
    vr, ExposedComponent
    comp1, DependencyReason QPN
    vs1) : [VROrigin]
    vros)
           | VR -> Ver -> Bool
    checkVR VR
    vr Ver
    v = [VROrigin]
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    go [VROrigin]
    vros
           | Bool
    otherwise    =
               (ConflictSet, (ConflictingDep, ConflictingDep))
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    forall a b. a -> Either a b
    Left ( QPN
    -> Ver
    -> DependencyReason QPN
    -> VR
    -> DependencyReason QPN
    -> ConflictSet
    createConflictSetForVersionConflict QPN
    p Ver
    v DependencyReason QPN
    vs2 VR
    vr DependencyReason QPN
    vs1
                    , ( DependencyReason QPN -> PkgComponent QPN -> CI -> ConflictingDep
    ConflictingDep DependencyReason QPN
    vs1 (QPN -> ExposedComponent -> PkgComponent QPN
    forall qpn. qpn -> ExposedComponent -> PkgComponent qpn
    PkgComponent QPN
    p ExposedComponent
    comp1) (VR -> CI
    Constrained VR
    vr)
                      , DependencyReason QPN -> PkgComponent QPN -> CI -> ConflictingDep
    ConflictingDep DependencyReason QPN
    vs2 (QPN -> ExposedComponent -> PkgComponent QPN
    forall qpn. qpn -> ExposedComponent -> PkgComponent qpn
    PkgComponent QPN
    p ExposedComponent
    comp2) CI
    ci ) )

    merge (MergedDepConstrained [VROrigin]
    vrOrigins) (PkgDep DependencyReason QPN
    vs2 (PkgComponent QPN
    _ ExposedComponent
    comp2) (Constrained VR
    vr)) =
        MergedPkgDep
    -> Either
         (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
    forall a b. b -> Either a b
    Right ([VROrigin] -> MergedPkgDep
    MergedDepConstrained ([VROrigin] -> MergedPkgDep) -> [VROrigin] -> MergedPkgDep
    forall a b. (a -> b) -> a -> b
    $

        -- TODO: This line appends the new version range, to preserve the order used
        -- before a refactoring. Consider prepending the version range, if there is
        -- no negative performance impact.
        [VROrigin]
    vrOrigins [VROrigin] -> [VROrigin] -> [VROrigin]
    forall a. [a] -> [a] -> [a]
    ++ [(VR
    vr, ExposedComponent
    comp2, DependencyReason QPN
    vs2)])

    -- | Creates a conflict set representing a conflict between a version constraint
    -- and the fixed version chosen for a package.
    createConflictSetForVersionConflict :: QPN
                                        -> Ver
                                        -> DependencyReason QPN
                                        -> VR
                                        -> DependencyReason QPN
                                        -> ConflictSet
    createConflictSetForVersionConflict :: QPN
    -> Ver
    -> DependencyReason QPN
    -> VR
    -> DependencyReason QPN
    -> ConflictSet
    createConflictSetForVersionConflict QPN
    pkg
                                        Ver
    conflictingVersion
                                        versionDR :: DependencyReason QPN
    versionDR@(DependencyReason QPN
    p1 Map Flag FlagValue
    _ Set Stanza
    _)
                                        VR
    conflictingVersionRange
                                        versionRangeDR :: DependencyReason QPN
    versionRangeDR@(DependencyReason QPN
    p2 Map Flag FlagValue
    _ Set Stanza
    _) =
      let hasFlagsOrStanzas :: DependencyReason qpn -> Bool
    hasFlagsOrStanzas (DependencyReason qpn
    _ Map Flag FlagValue
    fs Set Stanza
    ss) = Bool -> Bool
    not (Map Flag FlagValue -> Bool
    forall k a. Map k a -> Bool
    M.null Map Flag FlagValue
    fs) Bool -> Bool -> Bool
    || Bool -> Bool
    not (Set Stanza -> Bool
    forall a. Set a -> Bool
    S.null Set Stanza
    ss)
      in
        -- The solver currently only optimizes the case where there is a conflict
        -- between the version chosen for a package and a version constraint that
        -- is not under any flags or stanzas. Here is how we check for this case:
        --
        --   (1) Choosing a specific version for a package foo is implemented as
        --       adding a dependency from foo to that version of foo (See
        --       extendWithPackageChoice), so we check that the DependencyReason
        --       contains the current package and no flag or stanza choices.
        --
        --   (2) We check that the DependencyReason for the version constraint also
        --       contains no flag or stanza choices.
        --
        -- When these criteria are not met, we fall back to calling
        -- dependencyReasonToConflictSet.
        if QPN
    p1 QPN -> QPN -> Bool
    forall a. Eq a => a -> a -> Bool
    == QPN
    pkg Bool -> Bool -> Bool
    && Bool -> Bool
    not (DependencyReason QPN -> Bool
    forall {qpn}. DependencyReason qpn -> Bool
    hasFlagsOrStanzas DependencyReason QPN
    versionDR) Bool -> Bool -> Bool
    && Bool -> Bool
    not (DependencyReason QPN -> Bool
    forall {qpn}. DependencyReason qpn -> Bool
    hasFlagsOrStanzas DependencyReason QPN
    versionRangeDR)
        then let cs1 :: ConflictSet
    cs1 = QPN -> OrderedVersionRange -> DependencyReason QPN -> ConflictSet
    dependencyReasonToConflictSetWithVersionConflict
                       QPN
    p2
                       (VR -> OrderedVersionRange
    CS.OrderedVersionRange VR
    conflictingVersionRange)
                       DependencyReason QPN
    versionDR
                 cs2 :: ConflictSet
    cs2 = QPN -> Ver -> DependencyReason QPN -> ConflictSet
    dependencyReasonToConflictSetWithVersionConstraintConflict
                       QPN
    pkg Ver
    conflictingVersion DependencyReason QPN
    versionRangeDR
             in ConflictSet
    cs1 ConflictSet -> ConflictSet -> ConflictSet
    `CS.union` ConflictSet
    cs2
        else DependencyReason QPN -> ConflictSet
    dependencyReasonToConflictSet DependencyReason QPN
    versionRangeDR ConflictSet -> ConflictSet -> ConflictSet
    `CS.union` DependencyReason QPN -> ConflictSet
    dependencyReasonToConflictSet DependencyReason QPN
    versionDR

    -- | Takes a list of new dependencies and uses it to try to update the map of
    -- known component dependencies. It returns a failure when a new dependency
    -- requires a component that is missing, private, or unbuildable in a previously
    -- chosen package.
    extendRequiredComponents :: QPN -- ^ package we extend
                             -> Map QPN (Map ExposedComponent ComponentInfo)
                             -> Map QPN ComponentDependencyReasons
                             -> [LDep QPN]
                             -> Either Conflict (Map QPN ComponentDependencyReasons)
    extendRequiredComponents :: QPN
    -> Map QPN (Map ExposedComponent ComponentInfo)
    -> Map QPN ComponentDependencyReasons
    -> [LDep QPN]
    -> Either Conflict (Map QPN ComponentDependencyReasons)
    extendRequiredComponents QPN
    eqpn Map QPN (Map ExposedComponent ComponentInfo)
    available = (Map QPN ComponentDependencyReasons
     -> LDep QPN
     -> Either Conflict (Map QPN ComponentDependencyReasons))
    -> Map QPN ComponentDependencyReasons
    -> [LDep QPN]
    -> Either Conflict (Map QPN ComponentDependencyReasons)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Map QPN ComponentDependencyReasons
    -> LDep QPN -> Either Conflict (Map QPN ComponentDependencyReasons)
    extendSingle
      where
        extendSingle :: Map QPN ComponentDependencyReasons
                     -> LDep QPN
                     -> Either Conflict (Map QPN ComponentDependencyReasons)
        extendSingle :: Map QPN ComponentDependencyReasons
    -> LDep QPN -> Either Conflict (Map QPN ComponentDependencyReasons)
    extendSingle Map QPN ComponentDependencyReasons
    required (LDep DependencyReason QPN
    dr (Dep (PkgComponent QPN
    qpn ExposedComponent
    comp) CI
    _)) =
          let compDeps :: ComponentDependencyReasons
    compDeps = ComponentDependencyReasons
    -> QPN
    -> Map QPN ComponentDependencyReasons
    -> ComponentDependencyReasons
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault ComponentDependencyReasons
    forall k a. Map k a
    M.empty QPN
    qpn Map QPN ComponentDependencyReasons
    required
              success :: Either a (Map QPN ComponentDependencyReasons)
    success = Map QPN ComponentDependencyReasons
    -> Either a (Map QPN ComponentDependencyReasons)
    forall a b. b -> Either a b
    Right (Map QPN ComponentDependencyReasons
     -> Either a (Map QPN ComponentDependencyReasons))
    -> Map QPN ComponentDependencyReasons
    -> Either a (Map QPN ComponentDependencyReasons)
    forall a b. (a -> b) -> a -> b
    $ (ComponentDependencyReasons
     -> ComponentDependencyReasons -> ComponentDependencyReasons)
    -> QPN
    -> ComponentDependencyReasons
    -> Map QPN ComponentDependencyReasons
    -> Map QPN ComponentDependencyReasons
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    M.insertWith ComponentDependencyReasons
    -> ComponentDependencyReasons -> ComponentDependencyReasons
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    M.union QPN
    qpn (ExposedComponent
    -> DependencyReason QPN
    -> ComponentDependencyReasons
    -> ComponentDependencyReasons
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert ExposedComponent
    comp DependencyReason QPN
    dr ComponentDependencyReasons
    compDeps) Map QPN ComponentDependencyReasons
    required
          in -- Only check for the existence of the component if its package has
             -- already been chosen.
             case QPN
    -> Map QPN (Map ExposedComponent ComponentInfo)
    -> Maybe (Map ExposedComponent ComponentInfo)
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup QPN
    qpn Map QPN (Map ExposedComponent ComponentInfo)
    available of
               Just Map ExposedComponent ComponentInfo
    comps ->
                   case ExposedComponent
    -> Map ExposedComponent ComponentInfo -> Maybe ComponentInfo
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup ExposedComponent
    comp Map ExposedComponent ComponentInfo
    comps of
                     Maybe ComponentInfo
    Nothing ->
                         Conflict -> Either Conflict (Map QPN ComponentDependencyReasons)
    forall a b. a -> Either a b
    Left (Conflict -> Either Conflict (Map QPN ComponentDependencyReasons))
    -> Conflict -> Either Conflict (Map QPN ComponentDependencyReasons)
    forall a b. (a -> b) -> a -> b
    $ QPN
    -> ExposedComponent
    -> DependencyReason QPN
    -> (QPN -> ExposedComponent -> FailReason)
    -> Conflict
    mkConflict QPN
    qpn ExposedComponent
    comp DependencyReason QPN
    dr QPN -> ExposedComponent -> FailReason
    PackageRequiresMissingComponent
                     Just ComponentInfo
    compInfo
                       | ComponentInfo -> IsVisible
    compIsVisible ComponentInfo
    compInfo IsVisible -> IsVisible -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool -> IsVisible
    IsVisible Bool
    False
                       , QPN
    eqpn QPN -> QPN -> Bool
    forall a. Eq a => a -> a -> Bool
    /= QPN
    qpn -- package components can depend on other components
                       ->
                         Conflict -> Either Conflict (Map QPN ComponentDependencyReasons)
    forall a b. a -> Either a b
    Left (Conflict -> Either Conflict (Map QPN ComponentDependencyReasons))
    -> Conflict -> Either Conflict (Map QPN ComponentDependencyReasons)
    forall a b. (a -> b) -> a -> b
    $ QPN
    -> ExposedComponent
    -> DependencyReason QPN
    -> (QPN -> ExposedComponent -> FailReason)
    -> Conflict
    mkConflict QPN
    qpn ExposedComponent
    comp DependencyReason QPN
    dr QPN -> ExposedComponent -> FailReason
    PackageRequiresPrivateComponent
                       | ComponentInfo -> IsBuildable
    compIsBuildable ComponentInfo
    compInfo IsBuildable -> IsBuildable -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool -> IsBuildable
    IsBuildable Bool
    False ->
                         Conflict -> Either Conflict (Map QPN ComponentDependencyReasons)
    forall a b. a -> Either a b
    Left (Conflict -> Either Conflict (Map QPN ComponentDependencyReasons))
    -> Conflict -> Either Conflict (Map QPN ComponentDependencyReasons)
    forall a b. (a -> b) -> a -> b
    $ QPN
    -> ExposedComponent
    -> DependencyReason QPN
    -> (QPN -> ExposedComponent -> FailReason)
    -> Conflict
    mkConflict QPN
    qpn ExposedComponent
    comp DependencyReason QPN
    dr QPN -> ExposedComponent -> FailReason
    PackageRequiresUnbuildableComponent
                       | Bool
    otherwise -> Either Conflict (Map QPN ComponentDependencyReasons)
    forall {a}. Either a (Map QPN ComponentDependencyReasons)
    success
               Maybe (Map ExposedComponent ComponentInfo)
    Nothing    -> Either Conflict (Map QPN ComponentDependencyReasons)
    forall {a}. Either a (Map QPN ComponentDependencyReasons)
    success
        extendSingle Map QPN ComponentDependencyReasons
    required LDep QPN
    _                                         = Map QPN ComponentDependencyReasons
    -> Either Conflict (Map QPN ComponentDependencyReasons)
    forall a b. b -> Either a b
    Right Map QPN ComponentDependencyReasons
    required

        mkConflict :: QPN
                   -> ExposedComponent
                   -> DependencyReason QPN
                   -> (QPN -> ExposedComponent -> FailReason)
                   -> Conflict
        mkConflict :: QPN
    -> ExposedComponent
    -> DependencyReason QPN
    -> (QPN -> ExposedComponent -> FailReason)
    -> Conflict
    mkConflict QPN
    qpn ExposedComponent
    comp DependencyReason QPN
    dr QPN -> ExposedComponent -> FailReason
    mkFailure =
          (Var QPN -> ConflictSet -> ConflictSet
    CS.insert (QPN -> Var QPN
    forall qpn. qpn -> Var qpn
    P QPN
    qpn) (DependencyReason QPN -> ConflictSet
    dependencyReasonToConflictSet DependencyReason QPN
    dr), QPN -> ExposedComponent -> FailReason
    mkFailure QPN
    qpn ExposedComponent
    comp)

    -- | Interface.
    validateTree :: CompilerInfo -> Index -> PkgConfigDb -> Tree d c -> Tree d c
    validateTree :: forall d c.
    CompilerInfo -> Index -> PkgConfigDb -> Tree d c -> Tree d c
    validateTree CompilerInfo
    cinfo Index
    idx PkgConfigDb
    pkgConfigDb Tree d c
    t = Validate (Tree d c) -> ValidateState -> Tree d c
    forall a. Validate a -> ValidateState -> a
    runValidate (Tree d c -> Validate (Tree d c)
    forall d c. Tree d c -> Validate (Tree d c)
    validate Tree d c
    t) VS {
        supportedExt :: Extension -> Bool
    supportedExt        = (Extension -> Bool)
    -> ([Extension] -> Extension -> Bool)
    -> Maybe [Extension]
    -> Extension
    -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Bool -> Extension -> Bool
    forall a b. a -> b -> a
    const Bool
    True) -- if compiler has no list of extensions, we assume everything is supported
                                    (\ [Extension]
    es -> let s :: Set Extension
    s = [Extension] -> Set Extension
    forall a. Ord a => [a] -> Set a
    S.fromList [Extension]
    es in \ Extension
    x -> Extension -> Set Extension -> Bool
    forall a. Ord a => a -> Set a -> Bool
    S.member Extension
    x Set Extension
    s)
                                    (CompilerInfo -> Maybe [Extension]
    compilerInfoExtensions CompilerInfo
    cinfo)
      , supportedLang :: Language -> Bool
    supportedLang       = (Language -> Bool)
    -> ([Language] -> Language -> Bool)
    -> Maybe [Language]
    -> Language
    -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Bool -> Language -> Bool
    forall a b. a -> b -> a
    const Bool
    True)
                                    ((Language -> [Language] -> Bool) -> [Language] -> Language -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Language -> [Language] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    L.elem) -- use list lookup because language list is small and no Ord instance
                                    (CompilerInfo -> Maybe [Language]
    compilerInfoLanguages  CompilerInfo
    cinfo)
      , presentPkgs :: PkgconfigName -> PkgconfigVersionRange -> Bool
    presentPkgs         = PkgConfigDb -> PkgconfigName -> PkgconfigVersionRange -> Bool
    pkgConfigPkgIsPresent PkgConfigDb
    pkgConfigDb
      , index :: Index
    index               = Index
    idx
      , saved :: Map QPN (FlaggedDeps QPN)
    saved               = Map QPN (FlaggedDeps QPN)
    forall k a. Map k a
    M.empty
      , pa :: PreAssignment
    pa                  = PPreAssignment -> FAssignment -> SAssignment -> PreAssignment
    PA PPreAssignment
    forall k a. Map k a
    M.empty FAssignment
    forall k a. Map k a
    M.empty SAssignment
    forall k a. Map k a
    M.empty
      , availableComponents :: Map QPN (Map ExposedComponent ComponentInfo)
    availableComponents = Map QPN (Map ExposedComponent ComponentInfo)
    forall k a. Map k a
    M.empty
      , requiredComponents :: Map QPN ComponentDependencyReasons
    requiredComponents  = Map QPN ComponentDependencyReasons
    forall k a. Map k a
    M.empty
      , qualifyOptions :: QualifyOptions
    qualifyOptions      = Index -> QualifyOptions
    defaultQualifyOptions Index
    idx
      }