-- | 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 [PackageConstraint] -> Tree QGoalReasons -> Tree QGoalReasons
enforcePackageConstraints pcs = trav go
  where
    go (PChoiceF qpn@(Q _ pn)               gr    ts) =
      let c = toConflictSet (Goal (P qpn) gr)
          -- compose the transformation functions for each of the relevant constraint
          g = \ i -> foldl (\ h pc -> h . processPackageConstraintP   c i pc) id
                           (M.findWithDefault [] pn pcs)
      in PChoiceF qpn gr    (P.mapWithKey g ts)
    go (FChoiceF qfn@(FN (PI (Q _ pn) _) f) gr tr ts) =
      let c = toConflictSet (Goal (F qfn) gr)
          -- compose the transformation functions for each of the relevant constraint
          g = \ b -> foldl (\ h pc -> h . processPackageConstraintF f c b pc) id
                           (M.findWithDefault [] pn pcs)
      in FChoiceF qfn gr tr (P.mapWithKey g ts)
    go (SChoiceF qsn@(SN (PI (Q _ pn) _) f) gr tr ts) =
      let c = toConflictSet (Goal (S qsn) gr)
          -- compose the transformation functions for each of the relevant constraint
          g = \ b -> foldl (\ h pc -> h . processPackageConstraintS f c b pc) id
                           (M.findWithDefault [] pn pcs)
      in SChoiceF qsn gr tr (P.mapWithKey g ts)
    go x = x

-- | Prefer installed packages over non-installed packages, generally.
-- All installed packages or non-installed packages are treated as
-- equivalent.
enforcePackageConstraints :: M.Map PN [PackageConstraint] -> Tree QGoalReasons -> Tree QGoalReasons
enforcePackageConstraints pcs = trav go
  where
    go (PChoiceF qpn@(Q _ pn)               gr    ts) =
      let c = toConflictSet (Goal (P qpn) gr)
          -- compose the transformation functions for each of the relevant constraint
          g = \ i -> foldl (\ h pc -> h . processPackageConstraintP   c i pc) id
                           (M.findWithDefault [] pn pcs)
      in PChoiceF qpn gr    (P.mapWithKey g ts)
    go (FChoiceF qfn@(FN (PI (Q _ pn) _) f) gr tr ts) =
      let c = toConflictSet (Goal (F qfn) gr)
          -- compose the transformation functions for each of the relevant constraint
          g = \ b -> foldl (\ h pc -> h . processPackageConstraintF f c b pc) id
                           (M.findWithDefault [] pn pcs)
      in FChoiceF qfn gr tr (P.mapWithKey g ts)
    go (SChoiceF qsn@(SN (PI (Q _ pn) _) f) gr tr ts) =
      let c = toConflictSet (Goal (S qsn) gr)
          -- compose the transformation functions for each of the relevant constraint
          g = \ b -> foldl (\ h pc -> h . processPackageConstraintS f c b pc) id
                           (M.findWithDefault [] pn pcs)
      in SChoiceF qsn gr tr (P.mapWithKey g ts)
    go x = x

-- | Prefer installed packages over non-installed packages, generally.
-- All installed packages or non-installed packages are treated as
-- equivalent.
enforcePackageConstraints pcs = trav go
  where
    go (PChoiceF qpn@(Q _ pn)               gr    ts) =
      let c = toConflictSet (Goal (P qpn) gr)
          -- compose the transformation functions for each of the relevant constraint
          g = \ i -> foldl (\ h pc -> h . processPackageConstraintP   c i pc) id
                           (M.findWithDefault [] pn pcs)
      in PChoiceF qpn gr    (P.mapWithKey g ts)
    go (FChoiceF qfn@(FN (PI (Q _ pn) _) f) gr tr ts) =
      let c = toConflictSet (Goal (F qfn) gr)
          -- compose the transformation functions for each of the relevant constraint
          g = \ b -> foldl (\ h pc -> h . processPackageConstraintF f c b pc) id
                           (M.findWithDefault [] pn pcs)
      in FChoiceF qfn gr tr (P.mapWithKey g ts)
    go (SChoiceF qsn@(SN (PI (Q _ pn) _) f) gr tr ts) =
      let c = toConflictSet (Goal (S qsn) gr)
          -- compose the transformation functions for each of the relevant constraint
          g = \ b -> foldl (\ h pc -> h . processPackageConstraintS f c b pc) id
                           (M.findWithDefault [] pn pcs)
      in SChoiceF qsn gr tr (P.mapWithKey g ts)
    go x = x

-- | Prefer installed packages over non-installed packages, generally.
-- All installed packages or non-installed packages are treated as
-- equivalent.