<commit_before>module Distribution.Client.Dependency.Modular.Preference where

-- Reordering or pruning the tree in order to prefer or make certain choices.

import Control.Applicative
import qualified Data.List as L
import qualified Data.Map as M
import Data.Monoid
import Data.Ord

import Distribution.Client.Dependency.Types
  ( PackageConstraint(..), PackagePreferences(..), InstalledPreference(..) )

import Distribution.Client.Dependency.Modular.Flag
import Distribution.Client.Dependency.Modular.Index
import Distribution.Client.Dependency.Modular.Package
import Distribution.Client.Dependency.Modular.PSQ as P
import Distribution.Client.Dependency.Modular.Tree
import Distribution.Client.Dependency.Modular.Version

-- | Generic abstraction for strategies that just rearrange the package order.
-- Only packages that match the given predicate are reordered.
packageOrderFor :: (PN -> Bool) -> (PN -> I -> I -> Ordering) -> Tree a -> Tree a
packageOrderFor p cmp = cata go
  where
    go (PChoiceF v@(Q _ pn) r cs)
      | p pn                        = PChoice v r (P.sortByKeys (flip (cmp pn)) cs)
      | otherwise                   = PChoice v r                               cs
    go x                            = inn x

-- | Reorder according to global preferences.
preferPreferences :: Preferences -> Tree a -> Tree a
preferPreferences prefs = packageOrderFor (`M.member` prefs) preference
  where
    preference pn (I v1 _) (I v2 _) = preferredVersionsOrdering preferred v1 v2
      where preferred   = M.findWithDefault anyVR pn prefs

-- | Ordering that treats preferred versions as greater than non-preferred
-- versions.
preferredVersionsOrdering :: VR -> Ver -> Ver -> Ordering
preferredVersionsOrdering vr v1 v2 =
  compare (checkVR vr v1) (checkVR vr v2)

-- | Traversal that tries to establish package preferences (not constraints).
-- Works by reordering choice nodes.
preferPackagePreferences :: (PN -> PackagePreferences) -> Tree a -> Tree a
preferPackagePreferences pcs = packageOrderFor (const True) preference
  where
    preference pn i1@(I v1 _) i2@(I v2 _) =
      let PackagePreferences vr ipref = pcs pn
      in  preferredVersionsOrdering vr v1 v2 `mappend` -- combines lexically
          locationsOrdering ipref i1 i2

    locationsOrdering PreferInstalled = preferInstalledOrdering
    locationsOrdering PreferLatest    = preferLatestOrdering

-- | Ordering that treats installed instances as greater than uninstalled ones.
preferInstalledOrdering :: I -> I -> Ordering
preferInstalledOrdering (I _ (Inst _)) (I _ (Inst _)) = EQ
preferInstalledOrdering (I _ (Inst _)) _              = GT
preferInstalledOrdering _              (I _ (Inst _)) = LT
preferInstalledOrdering _              _              = EQ<commit_msg>fix package ordering bug<commit_after>module Distribution.Client.Dependency.Modular.Preference where

-- Reordering or pruning the tree in order to prefer or make certain choices.

import Control.Applicative
import qualified Data.List as L
import qualified Data.Map as M
import Data.Monoid
import Data.Ord

import Distribution.Client.Dependency.Types
  ( PackageConstraint(..), PackagePreferences(..), InstalledPreference(..) )

import Distribution.Client.Dependency.Modular.Flag
import Distribution.Client.Dependency.Modular.Index
import Distribution.Client.Dependency.Modular.Package
import Distribution.Client.Dependency.Modular.PSQ as P
import Distribution.Client.Dependency.Modular.Tree
import Distribution.Client.Dependency.Modular.Version

-- | Generic abstraction for strategies that just rearrange the package order.
-- Only packages that match the given predicate are reordered.
packageOrderFor :: (PN -> Bool) -> (PN -> I -> I -> Ordering) -> Tree a -> Tree a
packageOrderFor p cmp = cata go
  where
    go (PChoiceF v@(Q _ pn) r cs)
      | p pn                        = PChoice v r (P.sortByKeys (flip (cmp pn)) cs)
      | otherwise                   = PChoice v r                               cs
    go x                            = inn x

-- | Reorder according to global preferences.
preferPreferences :: Preferences -> Tree a -> Tree a
preferPreferences prefs = packageOrderFor (`M.member` prefs) preference
  where
    preference pn (I v1 _) (I v2 _) = preferredVersionsOrdering preferred v1 v2
      where preferred   = M.findWithDefault anyVR pn prefs

-- | Ordering that treats preferred versions as greater than non-preferred
-- versions.
preferredVersionsOrdering :: VR -> Ver -> Ver -> Ordering
preferredVersionsOrdering vr v1 v2 =
  compare (checkVR vr v1) (checkVR vr v2)

-- | Traversal that tries to establish package preferences (not constraints).
-- Works by reordering choice nodes.
preferPackagePreferences :: (PN -> PackagePreferences) -> Tree a -> Tree a
preferPackagePreferences pcs = packageOrderFor (const True) preference
  where
    preference pn i1@(I v1 _) i2@(I v2 _) =
      let PackagePreferences vr ipref = pcs pn
      in  preferredVersionsOrdering vr v1 v2 `mappend` -- combines lexically
          locationsOrdering ipref i1 i2

    -- Note that we always rank installed before uninstalled, and later
    -- versions before earlier, but we can change the priority of the
    -- two orderings.
    locationsOrdering PreferInstalled v1 v2 =
      preferInstalledOrdering v1 v2 `mappend` preferLatestOrdering v1 v2
    locationsOrdering PreferLatest v1 v2 =
      preferLatestOrdering v1 v2 `mappend` preferInstalledOrdering v1 v2

-- | Ordering that treats installed instances as greater than uninstalled ones.
preferInstalledOrdering :: I -> I -> Ordering
preferInstalledOrdering (I _ (Inst _)) (I _ (Inst _)) = EQ
preferInstalledOrdering (I _ (Inst _)) _              = GT
preferInstalledOrdering _              (I _ (Inst _)) = LT
preferInstalledOrdering _              _              = EQ
{'fraction_non_alphanumeric': 0.07538381921683629, 'fraction_numerical': 0.007590132827324478, 'mean_word_length': 3.1296296296296298, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 37, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1372875', 'n_tokens_mistral': 1613, 'n_tokens_neox': 1599, 'n_words': 561}