{-# LANGUAGE ScopedTypeVariables #-}
-- | Reordering or pruning the tree in order to prefer or make certain choices.
module Distribution.Solver.Modular.Preference
    ( avoidReinstalls
    , deferSetupExeChoices
    , deferWeakFlagChoices
    , enforceManualFlags
    , enforcePackageConstraints
    , enforceSingleInstanceRestriction
    , firstGoal
    , preferBaseGoalChoice
    , preferLinked
    , preferPackagePreferences
    , preferReallyEasyGoalChoices
    , onlyConstrained
    , sortGoals
    , pruneAfterFirstSuccess
    ) where

import Prelude ()
import Distribution.Solver.Compat.Prelude

import qualified Data.List as L
import qualified Data.Map as M
import Control.Monad.Trans.Reader (Reader, runReader, ask, local)

import Distribution.PackageDescription (lookupFlagAssignment, unFlagAssignment) -- from Cabal

import Distribution.Solver.Types.Flag
import Distribution.Solver.Types.InstalledPreference
import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PackageConstraint
import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Types.PackagePreferences
import Distribution.Solver.Types.Variable

import Distribution.Solver.Modular.Dependency
import Distribution.Solver.Modular.Flag
import Distribution.Solver.Modular.Package
import qualified Distribution.Solver.Modular.PSQ as P
import Distribution.Solver.Modular.Tree
import Distribution.Solver.Modular.Version
import qualified Distribution.Solver.Modular.ConflictSet as CS
import qualified Distribution.Solver.Modular.WeightedPSQ as W

-- | Update the weights of children under 'PChoice' nodes. 'addWeights' takes a
-- list of weight-calculating functions in order to avoid sorting the package
-- choices multiple times. Each function takes the package name, sorted list of
-- children's versions, and package option. 'addWeights' prepends the new
-- weights to the existing weights, which gives precedence to preferences that
-- are applied later.
addWeights :: [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
addWeights :: forall d c. [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
addWeights [PN -> [Ver] -> POption -> Weight]
fs = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go
  where
    go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
    go :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go (PChoiceF qpn :: QPN
qpn@(Q PackagePath
_ PN
pn) RevDepMap
rdm c
x WeightedPSQ [Weight] POption (Tree d c)
cs) =
      let sortedVersions :: [Ver]
sortedVersions = (Ver -> Ver -> Ordering) -> [Ver] -> [Ver]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy ((Ver -> Ver -> Ordering) -> Ver -> Ver -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ver -> Ver -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) ([Ver] -> [Ver]) -> [Ver] -> [Ver]
forall a b. (a -> b) -> a -> b
$ (POption -> Ver) -> [POption] -> [Ver]
forall a b. (a -> b) -> [a] -> [b]
L.map POption -> Ver
version (WeightedPSQ [Weight] POption (Tree d c) -> [POption]
forall w k v. WeightedPSQ w k v -> [k]
W.keys WeightedPSQ [Weight] POption (Tree d c)
cs)
          weights :: POption -> [Weight]
weights POption
k = [PN -> [Ver] -> POption -> Weight
f PN
pn [Ver]
sortedVersions POption
k | PN -> [Ver] -> POption -> Weight
f <- [PN -> [Ver] -> POption -> Weight]
fs]

          elemsToWhnf :: [a] -> ()
          elemsToWhnf :: forall a. [a] -> ()
elemsToWhnf = (a -> () -> ()) -> () -> [a] -> ()
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> () -> ()
forall a b. a -> b -> b
seq ()
      in  QPN
-> RevDepMap
-> c
-> WeightedPSQ [Weight] POption (Tree d c)
-> TreeF d c (Tree d c)
forall d c a.
QPN
-> RevDepMap -> c -> WeightedPSQ [Weight] POption a -> TreeF d c a
PChoiceF QPN
qpn RevDepMap
rdm c
x
          -- Evaluate the children's versions before evaluating any of the
          -- subtrees, so that 'sortedVersions' doesn't hold onto all of the
          -- subtrees (referenced by cs) and cause a space leak.
          ([Ver] -> ()
forall a. [a] -> ()
elemsToWhnf [Ver]
sortedVersions ()
-> WeightedPSQ [Weight] POption (Tree d c)
-> WeightedPSQ [Weight] POption (Tree d c)
forall a b. a -> b -> b
`seq`
             (POption -> [Weight] -> [Weight])
-> WeightedPSQ [Weight] POption (Tree d c)
-> WeightedPSQ [Weight] POption (Tree d c)
forall w2 k w1 v.
Ord w2 =>
(k -> w1 -> w2) -> WeightedPSQ w1 k v -> WeightedPSQ w2 k v
W.mapWeightsWithKey (\POption
k [Weight]
w -> POption -> [Weight]
weights POption
k [Weight] -> [Weight] -> [Weight]
forall a. [a] -> [a] -> [a]
++ [Weight]
w) WeightedPSQ [Weight] POption (Tree d c)
cs)
    go TreeF d c (Tree d c)
x                            = TreeF d c (Tree d c)
x

addWeight :: (PN -> [Ver] -> POption -> Weight) -> EndoTreeTrav d c
addWeight :: forall d c. (PN -> [Ver] -> POption -> Weight) -> EndoTreeTrav d c
addWeight PN -> [Ver] -> POption -> Weight
f = [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
forall d c. [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
addWeights [PN -> [Ver] -> POption -> Weight
f]

version :: POption -> Ver
version :: POption -> Ver
version (POption (I Ver
v Loc
_) Maybe PackagePath
_) = Ver
v

-- | Prefer to link packages whenever possible.
preferLinked :: EndoTreeTrav d c
preferLinked :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
preferLinked = (PN -> [Ver] -> POption -> Weight) -> EndoTreeTrav d c
forall d c. (PN -> [Ver] -> POption -> Weight) -> EndoTreeTrav d c
addWeight (([Ver] -> POption -> Weight) -> PN -> [Ver] -> POption -> Weight
forall a b. a -> b -> a
const ((POption -> Weight) -> [Ver] -> POption -> Weight
forall a b. a -> b -> a
const POption -> Weight
forall {a}. Num a => POption -> a
linked))
  where
    linked :: POption -> a
linked (POption I
_ Maybe PackagePath
Nothing)  = a
1
    linked (POption I
_ (Just PackagePath
_)) = a
0

-- Works by setting weights on choice nodes. Also applies stanza preferences.
preferPackagePreferences :: (PN -> PackagePreferences) -> EndoTreeTrav d c
preferPackagePreferences :: forall d c. (PN -> PackagePreferences) -> EndoTreeTrav d c
preferPackagePreferences PN -> PackagePreferences
pcs =
    (PN -> PackagePreferences) -> EndoTreeTrav d c
forall d c. (PN -> PackagePreferences) -> EndoTreeTrav d c
preferPackageStanzaPreferences PN -> PackagePreferences
pcs EndoTreeTrav d c -> EndoTreeTrav d c -> EndoTreeTrav d c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    -- Each package is assigned a list of weights (currently three of them),
    -- and options are ordered by comparison of these lists.
    --
    -- The head of the list (and thus the top priority for ordering)
    -- is whether the package version is "preferred"
    -- (https://hackage.haskell.org/packages/preferred-versions).
    --
    -- The next two elements depend on 'PackagePreferences'.
    -- For 'PreferInstalled' they are whether the version is installed (0 or 1)
    -- and how close is the version to the latest one (between 0.0 and 1.0).
    -- For 'PreferLatest' the weights are the same, but swapped, so that
    -- ordering considers how new is the package first.
    -- For 'PreferOldest' one weight measures how close is the version to the
    -- the oldest one possible (between 0.0 and 1.0) and another checks whether
    -- the version is installed (0 or 1).
    [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
forall d c. [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
addWeights [
          \PN
pn [Ver]
_  POption
opt -> PN -> POption -> Weight
preferred PN
pn POption
opt
        , \PN
pn [Ver]
vs POption
opt -> case PN -> InstalledPreference
preference PN
pn of
                          InstalledPreference
PreferInstalled -> POption -> Weight
installed POption
opt
                          InstalledPreference
PreferLatest    -> [Ver] -> POption -> Weight
latest [Ver]
vs POption
opt
                          InstalledPreference
PreferOldest    -> [Ver] -> POption -> Weight
oldest [Ver]
vs POption
opt
        , \PN
pn