Tree.hs 8.05 KB
Newer Older
1
{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
2
module Distribution.Solver.Modular.Tree
3
    ( POption(..)
4 5
    , Tree(..)
    , TreeF(..)
6
    , Weight
7 8
    , FailReason(..)
    , ConflictingDep(..)
9 10 11 12 13 14
    , ana
    , cata
    , inn
    , innM
    , para
    , trav
Andres Löh's avatar
Andres Löh committed
15
    , zeroOrOneChoices
16
    , active
17
    ) where
18

Edsko de Vries's avatar
Edsko de Vries committed
19
import Control.Monad hiding (mapM, sequence)
20 21
import Data.Foldable
import Data.Traversable
Edsko de Vries's avatar
Edsko de Vries committed
22
import Prelude hiding (foldr, mapM, sequence)
23

24 25 26 27 28
import Distribution.Solver.Modular.Dependency
import Distribution.Solver.Modular.Flag
import Distribution.Solver.Modular.Package
import Distribution.Solver.Modular.PSQ (PSQ)
import Distribution.Solver.Modular.Version
29 30
import Distribution.Solver.Modular.WeightedPSQ (WeightedPSQ)
import qualified Distribution.Solver.Modular.WeightedPSQ as W
31
import Distribution.Solver.Types.ConstraintSource
32
import Distribution.Solver.Types.Flag
33
import Distribution.Solver.Types.PackagePath
34
import Language.Haskell.Extension (Extension, Language)
35

36 37
type Weight = Double

kristenk's avatar
kristenk committed
38 39
-- | Type of the search tree. Inlining the choice nodes for now. Weights on
-- package, flag, and stanza choices control the traversal order.
40 41 42 43 44 45
--
-- The tree can hold additional data on 'Done' nodes (type 'd') and choice nodes
-- (type 'c'). For example, during the final traversal, choice nodes contain the
-- variables that introduced the choices, and 'Done' nodes contain the
-- assignments for all variables.
--
kristenk's avatar
kristenk committed
46 47
-- TODO: The weight type should be changed from [Double] to Double to avoid
-- giving too much weight to preferences that are applied later.
48
data Tree d c =
49
    -- | Choose a version for a package (or choose to link)
50
    PChoice QPN RevDepMap c (WeightedPSQ [Weight] POption (Tree d c))
51 52 53

    -- | Choose a value for a flag
    --
54 55
    -- The Bool is the default value.
  | FChoice QFN RevDepMap c WeakOrTrivial FlagType Bool (WeightedPSQ [Weight] Bool (Tree d c))
56 57

    -- | Choose whether or not to enable a stanza
58
  | SChoice QSN RevDepMap c WeakOrTrivial (WeightedPSQ [Weight] Bool (Tree d c))
59 60 61 62 63 64 65 66 67 68 69 70

    -- | Choose which choice to make next
    --
    -- Invariants:
    --
    -- * PSQ should never be empty
    -- * For each choice we additionally record the 'QGoalReason' why we are
    --   introducing that goal into tree. Note that most of the time we are
    --   working with @Tree QGoalReason@; in that case, we must have the
    --   invariant that the 'QGoalReason' cached in the 'PChoice', 'FChoice'
    --   or 'SChoice' directly below a 'GoalChoice' node must equal the reason
    --   recorded on that 'GoalChoice' node.
71
  | GoalChoice RevDepMap (PSQ (Goal QPN) (Tree d c))
72 73

    -- | We're done -- we found a solution!
74
  | Done RevDepMap d
75 76

    -- | We failed to find a solution in this path through the tree
77
  | Fail ConflictSet FailReason
78

Edsko de Vries's avatar
Edsko de Vries committed
79 80 81 82 83 84 85 86 87 88 89
-- | A package option is a package instance with an optional linking annotation
--
-- The modular solver has a number of package goals to solve for, and can only
-- pick a single package version for a single goal. In order to allow to
-- install multiple versions of the same package as part of a single solution
-- the solver uses qualified goals. For example, @0.P@ and @1.P@ might both
-- be qualified goals for @P@, allowing to pick a difference version of package
-- @P@ for @0.P@ and @1.P@.
--
-- Linking is an essential part of this story. In addition to picking a specific
-- version for @1.P@, the solver can also decide to link @1.P@ to @0.P@ (or
Edward Z. Yang's avatar
Edward Z. Yang committed
90
-- vice versa). It means that @1.P@ and @0.P@ really must be the very same package
Edsko de Vries's avatar
Edsko de Vries committed
91 92 93 94
-- (and hence must have the same build time configuration, and their
-- dependencies must also be the exact same).
--
-- See <http://www.well-typed.com/blog/2015/03/qualified-goals/> for details.
95
data POption = POption I (Maybe PackagePath)
Edsko de Vries's avatar
Edsko de Vries committed
96 97
  deriving (Eq, Show)

98 99 100 101 102
data FailReason = UnsupportedExtension Extension
                | UnsupportedLanguage Language
                | MissingPkgconfigPackage PkgconfigName VR
                | NewPackageDoesNotMatchExistingConstraint ConflictingDep
                | ConflictingConstraints ConflictingDep ConflictingDep
103 104
                | NewPackageIsMissingRequiredComponent ExposedComponent (DependencyReason QPN)
                | PackageRequiresMissingComponent QPN ExposedComponent
105 106
                | CannotInstall
                | CannotReinstall
107 108
                | Shadowed
                | Broken
109 110 111 112
                | GlobalConstraintVersion VR ConstraintSource
                | GlobalConstraintInstalled ConstraintSource
                | GlobalConstraintSource ConstraintSource
                | GlobalConstraintFlag ConstraintSource
113
                | ManualFlag
Andres Löh's avatar
Andres Löh committed
114
                | MalformedFlagChoice QFN
Andres Löh's avatar
Andres Löh committed
115
                | MalformedStanzaChoice QSN
116
                | EmptyGoalChoice
Andres Löh's avatar
Andres Löh committed
117
                | Backjump
118
                | MultipleInstances
Edsko de Vries's avatar
Edsko de Vries committed
119
                | DependenciesNotLinked String
120
                | CyclicDependencies
121
                | UnsupportedSpecVer Ver
122 123
  deriving (Eq, Show)

124
-- | Information about a dependency involved in a conflict, for error messages.
125
data ConflictingDep = ConflictingDep (DependencyReason QPN) (PkgComponent QPN) CI
126 127
  deriving (Eq, Show)

128 129 130
-- | Functor for the tree type. 'a' is the type of nodes' children. 'd' and 'c'
-- have the same meaning as in 'Tree'.
data TreeF d c a =
131 132 133 134
    PChoiceF    QPN RevDepMap c                             (WeightedPSQ [Weight] POption a)
  | FChoiceF    QFN RevDepMap c WeakOrTrivial FlagType Bool (WeightedPSQ [Weight] Bool    a)
  | SChoiceF    QSN RevDepMap c WeakOrTrivial               (WeightedPSQ [Weight] Bool    a)
  | GoalChoiceF     RevDepMap                               (PSQ (Goal QPN) a)
135
  | DoneF           RevDepMap d
136
  | FailF       ConflictSet FailReason
137
  deriving (Functor, Foldable, Traversable)
138

139
out :: Tree d c -> TreeF d c (Tree d c)
140 141 142 143 144 145
out (PChoice    p s i       ts) = PChoiceF    p s i       ts
out (FChoice    p s i b m d ts) = FChoiceF    p s i b m d ts
out (SChoice    p s i b     ts) = SChoiceF    p s i b     ts
out (GoalChoice   s         ts) = GoalChoiceF   s         ts
out (Done       x s           ) = DoneF       x s
out (Fail       c x           ) = FailF       c x
146

147
inn :: TreeF d c (Tree d c) -> Tree d c
148 149 150 151 152 153
inn (PChoiceF    p s i       ts) = PChoice    p s i       ts
inn (FChoiceF    p s i b m d ts) = FChoice    p s i b m d ts
inn (SChoiceF    p s i b     ts) = SChoice    p s i b     ts
inn (GoalChoiceF   s         ts) = GoalChoice   s         ts
inn (DoneF       x s           ) = Done       x s
inn (FailF       c x           ) = Fail       c x
154

155
innM :: Monad m => TreeF d c (m (Tree d c)) -> m (Tree d c)
156 157 158 159 160 161
innM (PChoiceF    p s i       ts) = liftM (PChoice    p s i      ) (sequence ts)
innM (FChoiceF    p s i b m d ts) = liftM (FChoice    p s i b m d) (sequence ts)
innM (SChoiceF    p s i b     ts) = liftM (SChoice    p s i b    ) (sequence ts)
innM (GoalChoiceF   s         ts) = liftM (GoalChoice   s        ) (sequence ts)
innM (DoneF       x s           ) = return $ Done     x s
innM (FailF       c x           ) = return $ Fail     c x
Edsko de Vries's avatar
Edsko de Vries committed
162

163
-- | Determines whether a tree is active, i.e., isn't a failure node.
164
active :: Tree d c -> Bool
Andres Löh's avatar
Andres Löh committed
165 166
active (Fail _ _) = False
active _          = True
167

kristenk's avatar
kristenk committed
168 169
-- | Approximates the number of active choices that are available in a node.
-- Note that we count goal choices as having one choice, always.
170
zeroOrOneChoices :: Tree d c -> Bool
171 172 173 174 175 176
zeroOrOneChoices (PChoice    _ _ _       ts) = W.isZeroOrOne (W.filter active ts)
zeroOrOneChoices (FChoice    _ _ _ _ _ _ ts) = W.isZeroOrOne (W.filter active ts)
zeroOrOneChoices (SChoice    _ _ _ _     ts) = W.isZeroOrOne (W.filter active ts)
zeroOrOneChoices (GoalChoice _           _ ) = True
zeroOrOneChoices (Done       _ _           ) = True
zeroOrOneChoices (Fail       _ _           ) = True
177 178

-- | Catamorphism on trees.
179
cata :: (TreeF d c a -> a) -> Tree d c -> a
180 181
cata phi x = (phi . fmap (cata phi) . out) x

182
trav :: (TreeF d c (Tree d a) -> TreeF d a (Tree d a)) -> Tree d c -> Tree d a
183
trav psi x = cata (inn . psi) x
184 185

-- | Paramorphism on trees.
186
para :: (TreeF d c (a, Tree d c) -> a) -> Tree d c -> a
187 188 189
para phi = phi . fmap (\ x -> (para phi x, x)) . out

-- | Anamorphism on trees.
190
ana :: (a -> TreeF d c a) -> a -> Tree d c
191
ana psi = inn . fmap (ana psi) . psi