cabal-install-solver/src/Distribution/Solver/Modular/Tree.hs

   1 {-# LANGUAGE DeriveTraversable #-}
   2 module Distribution.Solver.Modular.Tree
   3     ( POption(..)
   4     , Tree(..)
   5     , TreeF(..)
   6     , Weight
   7     , FailReason(..)
   8     , ConflictingDep(..)
   9     , ana
  10     , cata
  11     , inn
  12     , innM
  13     , para
  14     , trav
  15     , zeroOrOneChoices
  16     , active
  17     , TreeTrav
  18     , EndoTreeTrav
  19     ) where
  20
  21 import Control.Monad hiding (mapM, sequence)
  22 import Data.Foldable
  23 import Data.Traversable
  24 import Prelude hiding (foldr, mapM, sequence)
  25
  26 import Distribution.Solver.Modular.Dependency
  27 import Distribution.Solver.Modular.Flag
  28 import Distribution.Solver.Modular.Package
  29 import Distribution.Solver.Modular.PSQ (PSQ)
  30 import Distribution.Solver.Modular.Version
  31 import Distribution.Solver.Modular.WeightedPSQ (WeightedPSQ)
  32 import qualified Distribution.Solver.Modular.WeightedPSQ as W
  33 import Distribution.Solver.Types.ConstraintSource
  34 import Distribution.Solver.Types.Flag
  35 import Distribution.Solver.Types.PackagePath
  36 import Distribution.Types.PkgconfigVersionRange
  37 import Distribution.Types.UnitId (UnitId)
  38 import Language.Haskell.Extension (Extension, Language)
  39
  40 type Weight = Double
  41
  42 -- | Type of the search tree. Inlining the choice nodes for now. Weights on
  43 -- package, flag, and stanza choices control the traversal order.
  44 --
  45 -- The tree can hold additional data on 'Done' nodes (type 'd') and choice nodes
  46 -- (type 'c'). For example, during the final traversal, choice nodes contain the
  47 -- variables that introduced the choices, and 'Done' nodes contain the
  48 -- assignments for all variables.
  49 --
  50 -- TODO: The weight type should be changed from [Double] to Double to avoid
  51 -- giving too much weight to preferences that are applied later.
  52 data Tree d c =
  53     -- | Choose a version for a package (or choose to link)
  54     PChoice QPN RevDepMap c (WeightedPSQ [Weight] POption (Tree d c))
  55
  56     -- | Choose a value for a flag
  57     --
  58     -- The Bool is the default value.
  59   | FChoice QFN RevDepMap c WeakOrTrivial FlagType Bool (WeightedPSQ [Weight] Bool (Tree d c))
  60
  61     -- | Choose whether or not to enable a stanza
  62   | SChoice QSN RevDepMap c WeakOrTrivial (WeightedPSQ [Weight] Bool (Tree d c))
  63
  64     -- | Choose which choice to make next
  65     --
  66     -- Invariants:
  67     --
  68     -- * PSQ should never be empty
  69     -- * For each choice we additionally record the 'QGoalReason' why we are
  70     --   introducing that goal into tree. Note that most of the time we are
  71     --   working with @Tree QGoalReason@; in that case, we must have the
  72     --   invariant that the 'QGoalReason' cached in the 'PChoice', 'FChoice'
  73     --   or 'SChoice' directly below a 'GoalChoice' node must equal the reason
  74     --   recorded on that 'GoalChoice' node.
  75   | GoalChoice RevDepMap (PSQ (Goal QPN) (Tree d c))
  76
  77     -- | We're done -- we found a solution!
  78   | Done RevDepMap d
  79
  80     -- | We failed to find a solution in this path through the tree
  81   | Fail ConflictSet FailReason
  82
  83 -- | A package option is a package instance with an optional linking annotation
  84 --
  85 -- The modular solver has a number of package goals to solve for, and can only
  86 -- pick a single package version for a single goal. In order to allow to
  87 -- install multiple versions of the same package as part of a single solution
  88 -- the solver uses qualified goals. For example, @0.P@ and @1.P@ might both
  89 -- be qualified goals for @P@, allowing to pick a difference version of package
  90 -- @P@ for @0.P@ and @1.P@.
  91 --
  92 -- Linking is an essential part of this story. In addition to picking a specific
  93 -- version for @1.P@, the solver can also decide to link @1.P@ to @0.P@ (or
  94 -- vice versa). It means that @1.P@ and @0.P@ really must be the very same package
  95 -- (and hence must have the same build time configuration, and their
  96 -- dependencies must also be the exact same).
  97 --
  98 -- See <http://www.well-typed.com/blog/2015/03/qualified-goals/> for details.
  99 data POption = POption I (Maybe PackagePath)
 100   deriving (Eq, Show)
 101
 102 data FailReason = UnsupportedExtension Extension
 103                 | UnsupportedLanguage Language
 104                 | MissingPkgconfigPackage PkgconfigName PkgconfigVersionRange
 105                 | MissingPkgconfigProgram PkgconfigName PkgconfigVersionRange
 106                 | NewPackageDoesNotMatchExistingConstraint ConflictingDep
 107                 | ConflictingConstraints ConflictingDep ConflictingDep
 108                 | NewPackageIsMissingRequiredComponent ExposedComponent (DependencyReason QPN)
 109                 | NewPackageHasPrivateRequiredComponent ExposedComponent (DependencyReason QPN)
 110                 | NewPackageHasUnbuildableRequiredComponent ExposedComponent (DependencyReason QPN)
 111                 | PackageRequiresMissingComponent QPN ExposedComponent
 112                 | PackageRequiresPrivateComponent QPN ExposedComponent
 113                 | PackageRequiresUnbuildableComponent QPN ExposedComponent
 114                 | CannotReinstall
 115                 | NotExplicit
 116                 | Shadowed
 117                 | Broken UnitId
 118                 | UnknownPackage
 119                 | GlobalConstraintVersion VR ConstraintSource
 120                 | GlobalConstraintInstalled ConstraintSource
 121                 | GlobalConstraintSource ConstraintSource
 122                 | GlobalConstraintFlag ConstraintSource
 123                 | ManualFlag
 124                 | MalformedFlagChoice QFN
 125                 | MalformedStanzaChoice QSN
 126                 | EmptyGoalChoice
 127                 | Backjump
 128                 | MultipleInstances
 129                 | DependenciesNotLinked String
 130                 | CyclicDependencies
 131                 | UnsupportedSpecVer Ver
 132   deriving (Eq, Show)
 133
 134 -- | Information about a dependency involved in a conflict, for error messages.
 135 data ConflictingDep = ConflictingDep (DependencyReason QPN) (PkgComponent QPN) CI
 136   deriving (Eq, Show)
 137
 138 -- | Functor for the tree type. 'a' is the type of nodes' children. 'd' and 'c'
 139 -- have the same meaning as in 'Tree'.
 140 data TreeF d c a =
 141     PChoiceF    QPN RevDepMap c                             (WeightedPSQ [Weight] POption a)
 142   | FChoiceF    QFN RevDepMap c WeakOrTrivial FlagType Bool (WeightedPSQ [Weight] Bool    a)
 143   | SChoiceF    QSN RevDepMap c WeakOrTrivial               (WeightedPSQ [Weight] Bool    a)
 144   | GoalChoiceF     RevDepMap                               (PSQ (Goal QPN) a)
 145   | DoneF           RevDepMap d
 146   | FailF       ConflictSet FailReason
 147   deriving (Functor, Foldable, Traversable)
 148
 149 out :: Tree d c -> TreeF d c (Tree d c)
 150 out (PChoice    p s i       ts) = PChoiceF    p s i       ts
 151 out (FChoice    p s i b m d ts) = FChoiceF    p s i b m d ts
 152 out (SChoice    p s i b     ts) = SChoiceF    p s i b     ts
 153 out (GoalChoice   s         ts) = GoalChoiceF   s         ts
 154 out (Done       x s           ) = DoneF       x s
 155 out (Fail       c x           ) = FailF       c x
 156
 157 inn :: TreeF d c (Tree d c) -> Tree d c
 158 inn (PChoiceF    p s i       ts) = PChoice    p s i       ts
 159 inn (FChoiceF    p s i b m d ts) = FChoice    p s i b m d ts
 160 inn (SChoiceF    p s i b     ts) = SChoice    p s i b     ts
 161 inn (GoalChoiceF   s         ts) = GoalChoice   s         ts
 162 inn (DoneF       x s           ) = Done       x s
 163 inn (FailF       c x           ) = Fail       c x
 164
 165 innM :: Monad m => TreeF d c (m (Tree d c)) -> m (Tree d c)
 166 innM (PChoiceF    p s i       ts) = liftM (PChoice    p s i      ) (sequence ts)
 167 innM (FChoiceF    p s i b m d ts) = liftM (FChoice    p s i b m d) (sequence ts)
 168 innM (SChoiceF    p s i b     ts) = liftM (SChoice    p s i b    ) (sequence ts)
 169 innM (GoalChoiceF   s         ts) = liftM (GoalChoice   s        ) (sequence ts)
 170 innM (DoneF       x s           ) = return $ Done     x s
 171 innM (FailF       c x           ) = return $ Fail     c x
 172
 173 -- | Determines whether a tree is active, i.e., isn't a failure node.
 174 active :: Tree d c -> Bool
 175 active (Fail _ _) = False
 176 active _          = True
 177
 178 -- | Approximates the number of active choices that are available in a node.
 179 -- Note that we count goal choices as having one choice, always.
 180 zeroOrOneChoices :: Tree d c -> Bool
 181 zeroOrOneChoices (PChoice    _ _ _       ts) = W.isZeroOrOne (W.filter active ts)
 182 zeroOrOneChoices (FChoice    _ _ _ _ _ _ ts) = W.isZeroOrOne (W.filter active ts)
 183 zeroOrOneChoices (SChoice    _ _ _ _     ts) = W.isZeroOrOne (W.filter active ts)
 184 zeroOrOneChoices (GoalChoice _           _ ) = True
 185 zeroOrOneChoices (Done       _ _           ) = True
 186 zeroOrOneChoices (Fail       _ _           ) = True
 187
 188 -- | Catamorphism on trees.
 189 cata :: (TreeF d c a -> a) -> Tree d c -> a
 190 cata phi x = (phi . fmap (cata phi) . out) x
 191
 192 type TreeTrav d c a = TreeF d c (Tree d a) -> TreeF d a (Tree d a)
 193 type EndoTreeTrav d c = TreeTrav d c c
 194
 195 trav :: TreeTrav d c a -> Tree d c -> Tree d a
 196 trav psi x = cata (inn . psi) x
 197
 198 -- | Paramorphism on trees.
 199 para :: (TreeF d c (a, Tree d c) -> a) -> Tree d c -> a
 200 para phi = phi . fmap (\ x -> (para phi x, x)) . out
 201
 202 -- | Anamorphism on trees.
 203 ana :: (a -> TreeF d c a) -> a -> Tree d c
 204 ana psi = inn . fmap (ana psi) . psi