Constraints.hs 23.6 KB
Newer Older
1
{-# LANGUAGE CPP #-}
2 3
-----------------------------------------------------------------------------
-- |
4
-- Module      :  Distribution.Client.Dependency.TopDown.Constraints
5 6 7
-- Copyright   :  (c) Duncan Coutts 2008
-- License     :  BSD-like
--
Duncan Coutts's avatar
Duncan Coutts committed
8
-- Maintainer  :  duncan@community.haskell.org
9 10 11
-- Stability   :  provisional
-- Portability :  portable
--
12
-- A set of satisfiable constraints on a set of packages.
13
-----------------------------------------------------------------------------
14
module Distribution.Client.Dependency.TopDown.Constraints (
15 16
  Constraints,
  empty,
17
  packages,
18
  choices,
19
  isPaired,
20

21
  addTarget,
22 23 24 25 26
  constrain,
  Satisfiable(..),
  conflicting,
  ) where

27
import Distribution.Client.Dependency.TopDown.Types
28 29
import qualified Distribution.Client.PackageIndex as PackageIndex
import Distribution.Client.PackageIndex (PackageIndex)
30
import Distribution.Package
31
         ( PackageName, PackageId, PackageIdentifier(..)
32
         , Package(packageId), packageName, packageVersion
33
         , Dependency, PackageFixedDeps(depends) )
34
import Distribution.Version
35
         ( Version )
36
import Distribution.Client.Utils
37 38
         ( mergeBy, MergeResult(..) )

39
#if !MIN_VERSION_base(4,8,0)
40 41
import Data.Monoid
         ( Monoid(mempty) )
42
#endif
43
import Data.Either
Andres Löh's avatar
Andres Löh committed
44
         ( partitionEithers )
45 46
import qualified Data.Map as Map
import Data.Map (Map)
47 48
import qualified Data.Set as Set
import Data.Set (Set)
49 50 51
import Control.Exception
         ( assert )

52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75

-- | A set of satisfiable constraints on a set of packages.
--
-- The 'Constraints' type keeps track of a set of targets (identified by
-- package name) that we know that we need. It also keeps track of a set of
-- constraints over all packages in the environment.
--
-- It maintains the guarantee that, for the target set, the constraints are
-- satisfiable, meaning that there is at least one instance available for each
-- package name that satisfies the constraints on that package name.
--
-- Note that it is possible to over-constrain a package in the environment that
-- is not in the target set -- the satisfiability guarantee is only maintained
-- for the target set. This is useful because it allows us to exclude packages
-- without needing to know if it would ever be needed or not (e.g. allows
-- excluding broken installed packages).
--
-- Adding a constraint for a target package can fail if it would mean that
-- there are no remaining choices.
--
-- Adding a constraint for package that is not a target never fails.
--
-- Adding a new target package can fail if that package already has conflicting
-- constraints.
76
--
Andres Löh's avatar
Andres Löh committed
77
data Constraints installed source reason
78 79
   = Constraints

80 81 82 83 84 85 86 87 88 89 90 91 92
       -- | Targets that we know we need. This is the set for which we
       -- guarantee the constraints are satisfiable.
       !(Set PackageName)

       -- | The available/remaining set. These are packages that have available
       -- choices remaining. This is guaranteed to cover the target packages,
       -- but can also cover other packages in the environment. New targets can
       -- only be added if there are available choices remaining for them.
       !(PackageIndex (InstalledOrSource installed source))

       -- | The excluded set. Choices that we have excluded by applying
       -- constraints. Excluded choices are tagged with the reason.
       !(PackageIndex (ExcludedPkg (InstalledOrSource installed source) reason))
93

94 95
       -- | Paired choices, this is an ugly hack.
       !(Map PackageName (Version, Version))
96

97 98
       -- | Purely for the invariant, we keep a copy of the original index
       !(PackageIndex (InstalledOrSource installed source))
99

100

101 102 103 104 105 106 107 108 109 110 111
-- | Reasons for excluding all, or some choices for a package version.
--
-- Each package version can have a source instance, an installed instance or
-- both. We distinguish reasons for constraints that excluded both instances,
-- from reasons for constraints that excluded just one instance.
--
data ExcludedPkg pkg reason
   = ExcludedPkg pkg
       [reason] -- ^ reasons for excluding both source and installed instances
       [reason] -- ^ reasons for excluding the installed instance
       [reason] -- ^ reasons for excluding the source instance
112

113 114
instance Package pkg => Package (ExcludedPkg pkg reason) where
  packageId (ExcludedPkg p _ _ _) = packageId p
115 116


117
-- | There is a conservation of packages property. Packages are never gained or
118
-- lost, they just transfer from the remaining set to the excluded set.
119
--
120 121
invariant :: (Package installed, Package source)
          => Constraints installed source a -> Bool
122
invariant (Constraints targets available excluded _ original) =
Andres Löh's avatar
Andres Löh committed
123

124 125 126 127 128 129
    -- Relationship between available, excluded and original
    all check merged

    -- targets is a subset of available
 && all (PackageIndex.elemByPackageName available) (Set.elems targets)

130
  where
131 132 133 134 135 136 137 138 139 140
    merged = mergeBy (\a b -> packageId a `compare` mergedPackageId b)
                     (PackageIndex.allPackages original)
                     (mergeBy (\a b -> packageId a `compare` packageId b)
                              (PackageIndex.allPackages available)
                              (PackageIndex.allPackages excluded))
      where
        mergedPackageId (OnlyInLeft  p  ) = packageId p
        mergedPackageId (OnlyInRight   p) = packageId p
        mergedPackageId (InBoth      p _) = packageId p

141
    -- If the package was originally installed only, then
142 143
    check (InBoth (InstalledOnly _) cur) = case cur of
      -- now it's either still remaining as installed only
144 145 146 147
      OnlyInLeft               (InstalledOnly _)              -> True
      -- or it has been excluded
      OnlyInRight (ExcludedPkg (InstalledOnly _) [] (_:_) []) -> True
      _                                                       -> False
148

149
    -- If the package was originally available only, then
150
    check (InBoth (SourceOnly _) cur) = case cur of
151 152 153 154 155 156 157
      -- now it's either still remaining as source only
      OnlyInLeft               (SourceOnly _)              -> True
      -- or it has been excluded
      OnlyInRight (ExcludedPkg (SourceOnly _) [] [] (_:_)) -> True
      _                                                    -> False

    -- If the package was originally installed and source, then
158
    check (InBoth (InstalledAndSource _ _) cur) = case cur of
159
      -- We can have both remaining:
160 161 162 163 164 165 166 167 168 169 170 171 172 173 174
      OnlyInLeft               (InstalledAndSource _ _)        -> True

      -- both excluded, in particular it can have had the just source or
      -- installed excluded and later had both excluded so we do not mind if
      -- the source or installed excluded is empty or non-empty.
      OnlyInRight (ExcludedPkg (InstalledAndSource _ _) _ _ _) -> True

      -- the installed remaining and the source excluded:
      InBoth                   (InstalledOnly _)
                  (ExcludedPkg (SourceOnly _) [] [] (_:_))     -> True

      -- the source remaining and the installed excluded:
      InBoth                   (SourceOnly _)
                  (ExcludedPkg (InstalledOnly _) [] (_:_) [])  -> True
      _                                                        -> False
175 176

    check _ = False
177

178

179 180
-- | An update to the constraints can move packages between the two piles
-- but not gain or loose packages.
181 182 183
transitionsTo :: (Package installed, Package source)
              => Constraints installed source a
              -> Constraints installed source a -> Bool
184 185 186
transitionsTo constraints @(Constraints _ available  excluded  _ _)
              constraints'@(Constraints _ available' excluded' _ _) =

187 188
     invariant constraints && invariant constraints'
  && null availableGained  && null excludedLost
189 190
  &&    map (mapInstalledOrSource packageId packageId) availableLost
     == map (mapInstalledOrSource packageId packageId) excludedGained
191 192

  where
193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
    (availableLost, availableGained)
      = partitionEithers (foldr lostAndGained [] availableChange)

    (excludedLost, excludedGained)
      = partitionEithers (foldr lostAndGained [] excludedChange)

    availableChange =
      mergeBy (\a b -> packageId a `compare` packageId b)
        (PackageIndex.allPackages available)
        (PackageIndex.allPackages available')

    excludedChange =
      mergeBy (\a b -> packageId a `compare` packageId b)
        [ pkg | ExcludedPkg pkg _ _ _ <- PackageIndex.allPackages excluded  ]
        [ pkg | ExcludedPkg pkg _ _ _ <- PackageIndex.allPackages excluded' ]
Andres Löh's avatar
Andres Löh committed
208

209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226
    lostAndGained mr rest = case mr of
      OnlyInLeft pkg                    -> Left pkg : rest
      InBoth (InstalledAndSource pkg _)
             (SourceOnly _)             -> Left (InstalledOnly pkg) : rest
      InBoth (InstalledAndSource _ pkg)
             (InstalledOnly _)          -> Left (SourceOnly pkg) : rest
      InBoth (SourceOnly _)
             (InstalledAndSource pkg _) -> Right (InstalledOnly pkg) : rest
      InBoth (InstalledOnly _)
             (InstalledAndSource _ pkg) -> Right (SourceOnly pkg) : rest
      OnlyInRight pkg                   -> Right pkg : rest
      _                                 -> rest

    mapInstalledOrSource f g pkg = case pkg of
      InstalledOnly      a   -> InstalledOnly (f a)
      SourceOnly           b -> SourceOnly    (g b)
      InstalledAndSource a b -> InstalledAndSource (f a) (g b)

227 228 229 230

-- | We construct 'Constraints' with an initial 'PackageIndex' of all the
-- packages available.
--
231
empty :: (PackageFixedDeps installed, Package source)
232
      => PackageIndex installed
233 234
      -> PackageIndex source
      -> Constraints installed source reason
235 236
empty installed source =
    Constraints targets pkgs excluded pairs pkgs
237
  where
238 239
    targets  = mempty
    excluded = mempty
240
    pkgs = PackageIndex.fromList
241
         . map toInstalledOrSource
242
         $ mergeBy (\a b -> packageId a `compare` packageId b)
243
                   (PackageIndex.allPackages installed)
244 245 246 247
                   (PackageIndex.allPackages source)
    toInstalledOrSource (OnlyInLeft  i  ) = InstalledOnly      i
    toInstalledOrSource (OnlyInRight   a) = SourceOnly           a
    toInstalledOrSource (InBoth      i a) = InstalledAndSource i a
248

249 250
    -- pick up cases like base-3 and 4 where one version depends on the other:
    pairs = Map.fromList
251
      [ (name, (packageVersion pkgid1, packageVersion pkgid2))
252
      | [pkg1, pkg2] <- PackageIndex.allPackagesByName installed
253 254 255 256 257
      , let name   = packageName pkg1
            pkgid1 = packageId pkg1
            pkgid2 = packageId pkg2
      ,    any ((pkgid1==) . packageId) (depends pkg2)
        || any ((pkgid2==) . packageId) (depends pkg1) ]
258

259 260 261

-- | The package targets.
--
262
packages :: Constraints installed source reason
263 264 265 266
         -> Set PackageName
packages (Constraints ts _ _ _ _) = ts


267 268
-- | The package choices that are still available.
--
269
choices :: Constraints installed source reason
270
        -> PackageIndex (InstalledOrSource installed source)
271
choices (Constraints _ available _ _ _) = available
272

273
isPaired :: Constraints installed source reason
274 275
         -> PackageId -> Maybe PackageId
isPaired (Constraints _ _ _ pairs _) (PackageIdentifier name version) =
276 277 278 279 280
  case Map.lookup name pairs of
    Just (v1, v2)
      | version == v1 -> Just (PackageIdentifier name v2)
      | version == v2 -> Just (PackageIdentifier name v1)
    _                 -> Nothing
281

282

283 284
data Satisfiable constraints discarded reason
       = Satisfiable constraints discarded
285
       | Unsatisfiable
286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315
       | ConflictsWith [(PackageId, [reason])]


addTarget :: (Package installed, Package source)
          => PackageName
          -> Constraints installed source reason
          -> Satisfiable (Constraints installed source reason)
                         () reason
addTarget pkgname
          constraints@(Constraints targets available excluded paired original)

    -- If it's already a target then there's no change
  | pkgname `Set.member` targets
  = Satisfiable constraints ()

    -- If there is some possible choice available for this target then we're ok
  | PackageIndex.elemByPackageName available pkgname
  = let targets'     = Set.insert pkgname targets
        constraints' = Constraints targets' available excluded paired original
     in assert (constraints `transitionsTo` constraints') $
        Satisfiable constraints' ()

    -- If it's not available and it is excluded then we return the conflicts
  | PackageIndex.elemByPackageName excluded pkgname
  = ConflictsWith conflicts

    -- Otherwise, it's not available and it has not been excluded so the
    -- package is simply completely unknown.
  | otherwise
  = Unsatisfiable
Andres Löh's avatar
Andres Löh committed
316

317 318 319 320 321 322 323
  where
    conflicts =
      [ (packageId pkg, reasons)
      | let excludedChoices = PackageIndex.lookupPackageName excluded pkgname
      , ExcludedPkg pkg isReasons iReasons sReasons <- excludedChoices
      , let reasons = isReasons ++ iReasons ++ sReasons ]

324

325
constrain :: (Package installed, Package source)
326 327 328
          => PackageName                -- ^ which package to constrain
          -> (Version -> Bool -> Bool)  -- ^ the constraint test
          -> reason                     -- ^ the reason for the constraint
329 330
          -> Constraints installed source reason
          -> Satisfiable (Constraints installed source reason)
331 332 333
                         [PackageId] reason
constrain pkgname constraint reason
          constraints@(Constraints targets available excluded paired original)
334

335
  | pkgname `Set.member` targets  &&  not anyRemaining
336 337 338
  = if null conflicts then Unsatisfiable
                      else ConflictsWith conflicts

339
  | otherwise
340
  = let constraints' = Constraints targets available' excluded' paired original
341
     in assert (constraints `transitionsTo` constraints') $
342
        Satisfiable constraints' (map packageId newExcluded)
343 344

  where
345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404
    -- This tells us if any packages would remain at all for this package name if
    -- we applied this constraint. This amounts to checking if any package
    -- satisfies the given constraint, including version range and installation
    -- status.
    --
    (available', excluded', newExcluded, anyRemaining, conflicts) =
      updatePkgsStatus
        available excluded
        [] False []
        (mergeBy (\pkg pkg' -> packageVersion pkg `compare` packageVersion pkg')
                 (PackageIndex.lookupPackageName available pkgname)
                 (PackageIndex.lookupPackageName excluded  pkgname))

    testConstraint pkg =
      let ver = packageVersion pkg in
      case Map.lookup (packageName pkg) paired of

        Just (v1, v2)
          | ver == v1 || ver == v2
          -> case pkg of
               InstalledOnly ipkg -> InstalledOnly (ipkg, iOk)
               SourceOnly    spkg -> SourceOnly    (spkg, sOk)
               InstalledAndSource ipkg spkg ->
                 InstalledAndSource (ipkg, iOk) (spkg, sOk)
          where
            iOk = constraint v1 True  || constraint v2 True
            sOk = constraint v1 False || constraint v2 False

        _ -> case pkg of
               InstalledOnly ipkg -> InstalledOnly (ipkg, iOk)
               SourceOnly    spkg -> SourceOnly    (spkg, sOk)
               InstalledAndSource ipkg spkg ->
                 InstalledAndSource (ipkg, iOk) (spkg, sOk)
          where
            iOk = constraint ver True
            sOk = constraint ver False

    -- For the info about available and excluded versions of the package in
    -- question, update the info given the current constraint
    --
    -- We update the available package map and the excluded package map
    -- we also collect:
    --   * the change in available packages (for logging)
    --   * whether there are any remaining choices
    --   * any constraints that conflict with the current constraint

    updatePkgsStatus _ _ nePkgs ok cs _
      | seq nePkgs $ seq ok $ seq cs False = undefined

    updatePkgsStatus aPkgs ePkgs nePkgs ok cs []
      = (aPkgs, ePkgs, reverse nePkgs, ok, reverse cs)

    updatePkgsStatus aPkgs ePkgs nePkgs ok cs (pkg:pkgs) =
        let (aPkgs', ePkgs', mnePkg, ok', mc) = updatePkgStatus aPkgs ePkgs pkg
            nePkgs' = maybeCons mnePkg nePkgs
            cs'     = maybeCons mc cs
         in updatePkgsStatus aPkgs' ePkgs' nePkgs' (ok' || ok) cs' pkgs

    maybeCons Nothing  xs = xs
    maybeCons (Just x) xs = x:xs
Andres Löh's avatar
Andres Löh committed
405

406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426

    -- For the info about an available or excluded version of the package in
    -- question, update the info given the current constraint.
    --
    updatePkgStatus aPkgs ePkgs pkg =
      case viewPackageStatus pkg of
        AllAvailable (InstalledOnly (aiPkg, False)) ->
          removeAvailable False
            (InstalledOnly aiPkg)
            (PackageIndex.deletePackageId pkgid)
            (ExcludedPkg (InstalledOnly aiPkg) [] [reason] [])
            Nothing

        AllAvailable (SourceOnly (asPkg, False)) ->
          removeAvailable False
            (SourceOnly asPkg)
            (PackageIndex.deletePackageId pkgid)
            (ExcludedPkg (SourceOnly asPkg) [] [] [reason])
            Nothing

        AllAvailable (InstalledAndSource (aiPkg, False) (asPkg, False)) ->
Andres Löh's avatar
Andres Löh committed
427
          removeAvailable False
428 429 430 431 432 433
            (InstalledAndSource aiPkg asPkg)
            (PackageIndex.deletePackageId pkgid)
            (ExcludedPkg (InstalledAndSource aiPkg asPkg) [reason] [] [])
            Nothing

        AllAvailable (InstalledAndSource (aiPkg, True) (asPkg, False)) ->
Andres Löh's avatar
Andres Löh committed
434
          removeAvailable True
435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591
            (SourceOnly asPkg)
            (PackageIndex.insert (InstalledOnly aiPkg))
            (ExcludedPkg (SourceOnly asPkg) [] [] [reason])
            Nothing

        AllAvailable (InstalledAndSource (aiPkg, False) (asPkg, True)) ->
          removeAvailable True
            (InstalledOnly aiPkg)
            (PackageIndex.insert (SourceOnly asPkg))
            (ExcludedPkg (InstalledOnly aiPkg) [] [reason] [])
            Nothing

        AllAvailable _ -> noChange True Nothing

        AvailableExcluded (aiPkg, False) (ExcludedPkg (esPkg, False) _ _ srs) ->
          removeAvailable False
            (InstalledOnly aiPkg)
            (PackageIndex.deletePackageId pkgid)
            (ExcludedPkg (InstalledAndSource aiPkg esPkg) [reason] [] srs)
            Nothing

        AvailableExcluded (_aiPkg, True) (ExcludedPkg (esPkg, False) _ _ srs) ->
          addExtraExclusion True
            (ExcludedPkg (SourceOnly esPkg) [] [] (reason:srs))
            Nothing

        AvailableExcluded (aiPkg, False) (ExcludedPkg (esPkg, True) _ _ srs) ->
          removeAvailable  True
            (InstalledOnly aiPkg)
            (PackageIndex.deletePackageId pkgid)
            (ExcludedPkg (InstalledAndSource aiPkg esPkg) [] [reason] srs)
            (Just (pkgid, srs))

        AvailableExcluded (_aiPkg, True) (ExcludedPkg (_esPkg, True) _ _ srs) ->
          noChange True
            (Just (pkgid, srs))

        ExcludedAvailable (ExcludedPkg (eiPkg, False) _ irs _) (asPkg, False) ->
          removeAvailable  False
            (SourceOnly asPkg)
            (PackageIndex.deletePackageId pkgid)
            (ExcludedPkg (InstalledAndSource eiPkg asPkg) [reason] irs [])
            Nothing

        ExcludedAvailable (ExcludedPkg (eiPkg, True) _ irs _) (asPkg, False) ->
          removeAvailable False
            (SourceOnly asPkg)
            (PackageIndex.deletePackageId pkgid)
            (ExcludedPkg (InstalledAndSource eiPkg asPkg) [] irs [reason])
            (Just (pkgid, irs))

        ExcludedAvailable (ExcludedPkg (eiPkg, False) _ irs _) (_asPkg, True) ->
          addExtraExclusion True
            (ExcludedPkg (InstalledOnly eiPkg) [] (reason:irs) [])
            Nothing

        ExcludedAvailable (ExcludedPkg (_eiPkg, True) _ irs _) (_asPkg, True) ->
          noChange True
            (Just (pkgid, irs))

        AllExcluded (ExcludedPkg (InstalledOnly (eiPkg, False)) _ irs _) ->
          addExtraExclusion False
            (ExcludedPkg (InstalledOnly eiPkg) [] (reason:irs) [])
            Nothing

        AllExcluded (ExcludedPkg (InstalledOnly (_eiPkg, True)) _ irs _) ->
          noChange False
            (Just (pkgid, irs))

        AllExcluded (ExcludedPkg (SourceOnly (esPkg, False)) _ _ srs) ->
          addExtraExclusion False
            (ExcludedPkg (SourceOnly esPkg) [] [] (reason:srs))
            Nothing

        AllExcluded (ExcludedPkg (SourceOnly (_esPkg, True)) _ _ srs) ->
          noChange False
            (Just (pkgid, srs))

        AllExcluded (ExcludedPkg (InstalledAndSource (eiPkg, False) (esPkg, False)) isrs irs srs) ->
          addExtraExclusion False
            (ExcludedPkg (InstalledAndSource eiPkg esPkg) (reason:isrs) irs srs)
            Nothing

        AllExcluded (ExcludedPkg (InstalledAndSource (eiPkg, True) (esPkg, False)) isrs irs srs) ->
          addExtraExclusion False
            (ExcludedPkg (InstalledAndSource eiPkg esPkg) isrs irs (reason:srs))
            (Just (pkgid, irs))

        AllExcluded (ExcludedPkg (InstalledAndSource (eiPkg, False) (esPkg, True)) isrs irs srs) ->
          addExtraExclusion False
            (ExcludedPkg (InstalledAndSource eiPkg esPkg) isrs (reason:irs) srs)
            (Just (pkgid, srs))

        AllExcluded (ExcludedPkg (InstalledAndSource (_eiPkg, True) (_esPkg, True)) isrs irs srs) ->
          noChange False
            (Just (pkgid, isrs ++ irs ++ srs))

      where
        removeAvailable ok nePkg adjustAvailable ePkg c =
          let aPkgs' = adjustAvailable aPkgs
              ePkgs' = PackageIndex.insert ePkg ePkgs
           in aPkgs' `seq` ePkgs' `seq`
              (aPkgs', ePkgs', Just nePkg, ok, c)

        addExtraExclusion ok ePkg c =
          let ePkgs' = PackageIndex.insert ePkg ePkgs
           in ePkgs' `seq`
              (aPkgs, ePkgs', Nothing, ok, c)

        noChange ok c =
          (aPkgs, ePkgs, Nothing, ok, c)

        pkgid = case pkg of OnlyInLeft  p   -> packageId p
                            OnlyInRight p   -> packageId p
                            InBoth      p _ -> packageId p


    viewPackageStatus
      :: (Package installed, Package source)
      => MergeResult (InstalledOrSource installed source)
                     (ExcludedPkg (InstalledOrSource installed source) reason)
      -> PackageStatus (installed, Bool) (source, Bool) reason
    viewPackageStatus merged =
        case merged of
          OnlyInLeft aPkg ->
            AllAvailable (testConstraint aPkg)

          OnlyInRight (ExcludedPkg ePkg isrs irs srs) ->
            AllExcluded (ExcludedPkg (testConstraint ePkg) isrs irs srs)

          InBoth (InstalledOnly aiPkg)
                 (ExcludedPkg (SourceOnly esPkg) [] [] srs) ->
            case testConstraint (InstalledAndSource aiPkg esPkg) of
              InstalledAndSource (aiPkg', iOk) (esPkg', sOk) ->
                AvailableExcluded (aiPkg', iOk) (ExcludedPkg (esPkg', sOk) [] [] srs)
              _ -> impossible

          InBoth (SourceOnly asPkg)
                 (ExcludedPkg (InstalledOnly eiPkg) [] irs []) ->
            case testConstraint (InstalledAndSource eiPkg asPkg) of
              InstalledAndSource (eiPkg', iOk) (asPkg', sOk) ->
                ExcludedAvailable (ExcludedPkg (eiPkg', iOk) [] irs []) (asPkg', sOk)
              _ -> impossible
          _ -> impossible
      where
        impossible = error "impossible: viewPackageStatus invariant violation"

-- A intermediate structure that enumerates all the possible cases given the
-- invariant. This helps us to get simpler and complete pattern matching in
-- updatePkg above
--
data PackageStatus installed source reason
   = AllAvailable (InstalledOrSource installed source)
   | AllExcluded  (ExcludedPkg (InstalledOrSource installed source) reason)
   | AvailableExcluded installed (ExcludedPkg source reason)
   | ExcludedAvailable (ExcludedPkg installed reason) source

592

593 594
conflicting :: (Package installed, Package source)
            => Constraints installed source reason
595
            -> Dependency
596 597 598 599
            -> [(PackageId, [reason])]
conflicting (Constraints _ _ excluded _ _) dep =
  [ (packageId pkg, reasonsAll ++ reasonsAvail ++ reasonsInstalled) --TODO
  | ExcludedPkg pkg reasonsAll reasonsAvail reasonsInstalled <-
600
      PackageIndex.lookupDependency excluded dep ]