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

   1 {-# LANGUAGE DeriveFunctor, DeriveFoldable, 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                 | NewPackageDoesNotMatchExistingConstraint ConflictingDep
 106                 | ConflictingConstraints ConflictingDep ConflictingDep
 107                 | NewPackageIsMissingRequiredComponent ExposedComponent (DependencyReason QPN)
 108                 | NewPackageHasPrivateRequiredComponent ExposedComponent (DependencyReason QPN)
 109                 | NewPackageHasUnbuildableRequiredComponent ExposedComponent (DependencyReason QPN)
 110                 | PackageRequiresMissingComponent QPN ExposedComponent
 111                 | PackageRequiresPrivateComponent QPN ExposedComponent
 112                 | PackageRequiresUnbuildableComponent QPN ExposedComponent
 113                 | CannotReinstall
 114                 | NotExplicit
 115                 | Shadowed
 116                 | Broken UnitId
 117                 | UnknownPackage
 118                 | GlobalConstraintVersion VR ConstraintSource
 119                 | GlobalConstraintInstalled ConstraintSource
 120                 | GlobalConstraintSource ConstraintSource
 121                 | GlobalConstraintFlag ConstraintSource
 122                 | ManualFlag
 123                 | MalformedFlagChoice QFN
 124                 | MalformedStanzaChoice QSN
 125                 | EmptyGoalChoice
 126                 | Backjump
 127                 | MultipleInstances
 128                 | DependenciesNotLinked String
 129                 | CyclicDependencies
 130                 | UnsupportedSpecVer Ver
 131   deriving (Eq, Show)
 132
 133 -- | Information about a dependency involved in a conflict, for error messages.
 134 data ConflictingDep = ConflictingDep (DependencyReason QPN) (PkgComponent QPN) CI
 135   deriving (Eq, Show)
 136
 137 -- | Functor for the tree type. 'a' is the type of nodes' children. 'd' and 'c'
 138 -- have the same meaning as in 'Tree'.
 139 data TreeF d c a =
 140     PChoiceF    QPN RevDepMap c                             (WeightedPSQ [Weight] POption a)
 141   | FChoiceF    QFN RevDepMap c WeakOrTrivial FlagType Bool (WeightedPSQ [Weight] Bool    a)
 142   | SChoiceF    QSN RevDepMap c WeakOrTrivial               (WeightedPSQ [Weight] Bool    a)
 143   | GoalChoiceF     RevDepMap                               (PSQ (Goal QPN) a)
 144   | DoneF           RevDepMap d
 145   | FailF       ConflictSet FailReason
 146   deriving (Functor, Foldable, Traversable)
 147
 148 out :: Tree d c -> TreeF d c (Tree d c)
 149 out (PChoice    p s i       ts) = PChoiceF    p s i       ts
 150 out (FChoice    p s i b m d ts) = FChoiceF    p s i b m d ts
 151 out (SChoice    p s i b     ts) = SChoiceF    p s i b     ts
 152 out (GoalChoice   s         ts) = GoalChoiceF   s         ts
 153 out (Done       x s           ) = DoneF       x s
 154 out (Fail       c x           ) = FailF       c x
 155
 156 inn :: TreeF d c (Tree d c) -> Tree d c
 157 inn (PChoiceF    p s i       ts) = PChoice    p s i       ts
 158 inn (FChoiceF    p s i b m d ts) = FChoice    p s i b m d ts
 159 inn (SChoiceF    p s i b     ts) = SChoice    p s i b     ts
 160 inn (GoalChoiceF   s         ts) = GoalChoice   s         ts
 161 inn (DoneF       x s           ) = Done       x s
 162 inn (FailF       c x           ) = Fail       c x
 163
 164 innM :: Monad m => TreeF d c (m (Tree d c)) -> m (Tree d c)
 165 innM (PChoiceF    p s i       ts) = liftM (PChoice    p s i      ) (sequence ts)
 166 innM (FChoiceF    p s i b m d ts) = liftM (FChoice    p s i b m d) (sequence ts)
 167 innM (SChoiceF    p s i b     ts) = liftM (SChoice    p s i b    ) (sequence ts)
 168 innM (GoalChoiceF   s         ts) = liftM (GoalChoice   s        ) (sequence ts)
 169 innM (DoneF       x s           ) = return $ Done     x s
 170 innM (FailF       c x           ) = return $ Fail     c x
 171
 172 -- | Determines whether a tree is active, i.e., isn't a failure node.
 173 active :: Tree d c -> Bool
 174 active (Fail _ _) = False
 175 active _          = True
 176
 177 -- | Approximates the number of active choices that are available in a node.
 178 -- Note that we count goal choices as having one choice, always.
 179 zeroOrOneChoices :: Tree d c -> Bool
 180 zeroOrOneChoices (PChoice    _ _ _       ts) = W.isZeroOrOne (W.filter active ts)
 181 zeroOrOneChoices (FChoice    _ _ _ _ _ _ ts) = W.isZeroOrOne (W.filter active ts)
 182 zeroOrOneChoices (SChoice    _ _ _ _     ts) = W.isZeroOrOne (W.filter active ts)
 183 zeroOrOneChoices (GoalChoice _           _ ) = True
 184 zeroOrOneChoices (Done       _ _           ) = True
 185 zeroOrOneChoices (Fail       _ _           ) = True
 186
 187 -- | Catamorphism on trees.
 188 cata :: (TreeF d c a -> a) -> Tree d c -> a
 189 cata phi x = (phi . fmap (cata phi) . out) x
 190
 191 type TreeTrav d c a = TreeF d c (Tree d a) -> TreeF d a (Tree d a)
 192 type EndoTreeTrav d c = TreeTrav d c c
 193
 194 trav :: TreeTrav d c a -> Tree d c -> Tree d a
 195 trav psi x = cata (inn . psi) x
 196
 197 -- | Paramorphism on trees.
 198 para :: (TreeF d c (a, Tree d c) -> a) -> Tree d c -> a
 199 para phi = phi . fmap (\ x -> (para phi x, x)) . out
 200
 201 -- | Anamorphism on trees.
 202 ana :: (a -> TreeF d c a) -> a -> Tree d c
 203 ana psi = inn . fmap (ana psi) . psi