{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.PackageIndex
-- Copyright   :  (c) David Himmelstrup 2005,
--                    Bjorn Bringert 2007,
--                    Duncan Coutts 2008-2009
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- An index of packages whose primary key is 'UnitId'.  Public libraries
-- are additionally indexed by 'PackageName' and 'Version'.
-- Technically, these are an index of *units* (so we should eventually
-- rename it to 'UnitIndex'); but in the absence of internal libraries
-- or Backpack each unit is equivalent to a package.
--
-- While 'PackageIndex' is parametric over what it actually records,
-- it is in fact only ever instantiated with a single element:
-- The 'InstalledPackageIndex' (defined here) contains a graph of
-- 'InstalledPackageInfo's representing the packages in a
-- package database stack.  It is used in a variety of ways:
--
--   * The primary use to let Cabal access the same installed
--     package database which is used by GHC during compilation.
--     For example, this data structure is used by 'ghc-pkg'
--     and 'Cabal' to do consistency checks on the database
--     (are the references closed).
--
--   * Given a set of dependencies, we can compute the transitive
--     closure of dependencies.  This is to check if the versions
--     of packages are consistent, and also needed by multiple
--     tools (Haddock must be explicitly told about the every
--     transitive package to do cross-package linking;
--     preprocessors must know about the include paths of all
--     transitive dependencies.)
--
-- This 'PackageIndex' is NOT to be confused with
-- 'Distribution.Client.PackageIndex', which indexes packages only by
-- 'PackageName' (this makes it suitable for indexing source packages,
-- for which we don't know 'UnitId's.)
--
module Distribution.Simple.PackageIndex (
  -- * Package index data type
  InstalledPackageIndex,
  PackageIndex,

  -- * Creating an index
  fromList,

  -- * Updates
  merge,

  insert,

  deleteUnitId,
  deleteSourcePackageId,
  deletePackageName,
--  deleteDependency,

  -- * Queries

  -- ** Precise lookups
  lookupUnitId,
  lookupComponentId,
  lookupSourcePackageId,
  lookupPackageId,
  lookupPackageName,
  lookupDependency,
  lookupInternalDependency,

  -- ** Case-insensitive searches
  searchByName,
  SearchResult(..),
  searchByNameSubstring,
  searchWithPredicate,

  -- ** Bulk queries
  allPackages,
  allPackagesByName,
  allPackagesBySourcePackageId,
  allPackagesBySourcePackageIdAndLibName,

  -- ** Special queries
  brokenPackages,
  dependencyClosure,
  reverseDependencyClosure,
  topologicalOrder,
  reverseTopologicalOrder,
  dependencyInconsistencies,
  dependencyCycles,
  dependencyGraph,
  moduleNameIndex
  ) where

import Prelude ()
import Distribution.Compat.Prelude hiding (lookup)
import qualified Data.Map.Strict as Map

import Distribution.Package
import Distribution.Backpack
import Distribution.ModuleName
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Version
import Distribution.Simple.Utils
import Distribution.Types.LibraryName

import Control.Exception (assert)
import Data.Array ((!))
import qualified Data.Array as Array
import qualified Data.Graph as Graph
import Data.List as List ( groupBy,  deleteBy, deleteFirstsBy )
import qualified Data.List.NonEmpty as NE
import qualified Data.Tree  as Tree
import Control.Monad
import Distribution.Compat.Stack

import qualified Prelude (foldr1)

-- | The collection of information about packages from one or more 'PackageDB's.
-- These packages generally should have an instance of 'PackageInstalled'
--
-- Packages are uniquely identified in by their 'UnitId', they can
-- also be efficiently looked up by package name or by name and version.
--
data PackageIndex a = PackageIndex {
  -- The primary index. Each InstalledPackageInfo record is uniquely identified
  -- by its UnitId.
  --
  forall a. PackageIndex a -> Map UnitId a
unitIdIndex :: !(Map UnitId a),

  -- This auxiliary index maps package names (case-sensitively) to all the
  -- versions and instances of that package. This allows us to find all
  -- versions satisfying a dependency.
  --
  -- It is a three-level index. The first level is the package name,
  -- the second is the package version and the final level is instances
  -- of the same package version. These are unique by UnitId
  -- and are kept in preference order.
  --
  -- FIXME: Clarify what "preference order" means. Check that this invariant is
  -- preserved. See #1463 for discussion.
  forall a.
PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
packageIdIndex :: !(Map (PackageName, LibraryName) (Map Version [a]))

  } deriving (PackageIndex a -> PackageIndex a -> Bool
(PackageIndex a -> PackageIndex a -> Bool)
-> (PackageIndex a -> PackageIndex a -> Bool)
-> Eq (PackageIndex a)
forall a. Eq a => PackageIndex a -> PackageIndex a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => PackageIndex a -> PackageIndex a -> Bool
== :: PackageIndex a -> PackageIndex a -> Bool
$c/= :: forall a. Eq a => PackageIndex a -> PackageIndex a -> Bool
/= :: PackageIndex a -> PackageIndex a -> Bool
Eq, (forall x. PackageIndex a -> Rep (PackageIndex a) x)
-> (forall x. Rep (PackageIndex a) x -> PackageIndex a)
-> Generic (PackageIndex a)
forall x. Rep (PackageIndex a) x -> PackageIndex a
forall x. PackageIndex a -> Rep (PackageIndex a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PackageIndex a) x -> PackageIndex a
forall a x. PackageIndex a -> Rep (PackageIndex a) x
$cfrom :: forall a x. PackageIndex a -> Rep (PackageIndex a) x
from :: forall x. PackageIndex a -> Rep (PackageIndex a) x
$cto :: forall a x. Rep (PackageIndex a) x -> PackageIndex a
to :: forall x. Rep (PackageIndex a) x -> PackageIndex a
Generic, Int -> PackageIndex a -> ShowS
[PackageIndex a] -> ShowS
PackageIndex a -> String
(Int -> PackageIndex a -> ShowS)
-> (PackageIndex a -> String)
-> ([PackageIndex a] -> ShowS)
-> Show (PackageIndex a)
forall a. Show a => Int -> PackageIndex a -> ShowS
forall a. Show a => [PackageIndex a] -> ShowS
forall a. Show a => PackageIndex a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> PackageIndex a -> ShowS
showsPrec :: Int -> PackageIndex a -> ShowS
$cshow :: forall a. Show a => PackageIndex a -> String
show :: PackageIndex a -> String
$cshowList :: forall a. Show a => [PackageIndex a] -> ShowS
showList :: [PackageIndex a] -> ShowS
Show, ReadPrec [PackageIndex a]
ReadPrec (PackageIndex a)
Int -> ReadS (PackageIndex a)
ReadS [PackageIndex a]
(Int -> ReadS (PackageIndex a))
-> ReadS [PackageIndex a]
-> ReadPrec (PackageIndex a)
-> ReadPrec [PackageIndex a]
-> Read (PackageIndex a)
forall a. Read a => ReadPrec [PackageIndex a]
forall a. Read a => ReadPrec (PackageIndex a)
forall a. Read a => Int -> ReadS (PackageIndex a)
forall a. Read a => ReadS [PackageIndex a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (PackageIndex a)
readsPrec :: Int -> ReadS (PackageIndex a)
$creadList :: forall a. Read a => ReadS [PackageIndex a]
readList :: ReadS [PackageIndex a]
$creadPrec :: forall a. Read a => ReadPrec (PackageIndex a)
readPrec :: ReadPrec (PackageIndex a)
$creadListPrec :: forall a. Read a => ReadPrec [PackageIndex a]
readListPrec :: ReadPrec [PackageIndex a]
Read, Typeable)

instance Binary a => Binary (PackageIndex a)
instance Structured a => Structured (PackageIndex a)

-- | The default package index which contains 'InstalledPackageInfo'.  Normally
-- use this.
type InstalledPackageIndex = PackageIndex IPI.InstalledPackageInfo

instance Monoid (PackageIndex IPI.InstalledPackageInfo) where
  mempty :: PackageIndex InstalledPackageInfo
mempty  = Map UnitId InstalledPackageInfo
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> PackageIndex InstalledPackageInfo
forall a.
Map UnitId a
-> Map (PackageName, LibraryName) (Map Version [a])
-> PackageIndex a
PackageIndex Map UnitId InstalledPackageInfo
forall k a. Map k a
Map.empty Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
forall k a. Map k a
Map.empty
  mappend :: PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
mappend = PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
forall a. Semigroup a => a -> a -> a
(<>)
  --save one mappend with empty in the common case:
  mconcat :: [PackageIndex InstalledPackageInfo]
-> PackageIndex InstalledPackageInfo
mconcat [] = PackageIndex InstalledPackageInfo
forall a. Monoid a => a
mempty
  mconcat [PackageIndex InstalledPackageInfo]
xs = (PackageIndex InstalledPackageInfo
 -> PackageIndex InstalledPackageInfo
 -> PackageIndex InstalledPackageInfo)
-> [PackageIndex InstalledPackageInfo]
-> PackageIndex InstalledPackageInfo
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Prelude.foldr1 PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
forall a. Monoid a => a -> a -> a
mappend [PackageIndex InstalledPackageInfo]
xs

instance Semigroup (PackageIndex IPI.InstalledPackageInfo) where
  <> :: PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
(<>) = PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
merge

{-# NOINLINE invariant #-}
invariant :: WithCallStack (InstalledPackageIndex -> Bool)
invariant :: WithCallStack (PackageIndex InstalledPackageInfo -> Bool)
invariant (PackageIndex Map UnitId InstalledPackageInfo
pids Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames) =
  -- trace (show pids' ++ "\n" ++ show pnames') $
  [UnitId]
pids' [UnitId] -> [UnitId] -> Bool
forall a. Eq a => a -> a -> Bool
== [UnitId]
pnames'
 where
  pids' :: [UnitId]
pids' = (InstalledPackageInfo -> UnitId)
-> [InstalledPackageInfo] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId (Map UnitId InstalledPackageInfo -> [InstalledPackageInfo]
forall k a. Map k a -> [a]
Map.elems Map UnitId InstalledPackageInfo
pids)
  pnames' :: [UnitId]
pnames' = [UnitId] -> [UnitId]
forall a. Ord a => [a] -> [a]
sort
     [ Bool -> UnitId -> UnitId
forall a. HasCallStack => Bool -> a -> a
assert Bool
pinstOk (InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstalledPackageInfo
pinst)
     | ((PackageName
pname, LibraryName
plib), Map Version [InstalledPackageInfo]
pvers)  <- Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> [((PackageName, LibraryName),
     Map Version [InstalledPackageInfo])]
forall k a. Map k a -> [(k, a)]
Map.toList Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames
     , let pversOk :: Bool
pversOk = Bool -> Bool
not (Map Version [InstalledPackageInfo] -> Bool
forall k a. Map k a -> Bool
Map.null Map Version [InstalledPackageInfo]
pvers)
     , (Version
pver,  [InstalledPackageInfo]
pinsts) <- Bool
-> [(Version, [InstalledPackageInfo])]
-> [(Version, [InstalledPackageInfo])]
forall a. HasCallStack => Bool -> a -> a
assert Bool
pversOk ([(Version, [InstalledPackageInfo])]
 -> [(Version, [InstalledPackageInfo])])
-> [(Version, [InstalledPackageInfo])]
-> [(Version, [InstalledPackageInfo])]
forall a b. (a -> b) -> a -> b
$ Map Version [InstalledPackageInfo]
-> [(Version, [InstalledPackageInfo])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Version [InstalledPackageInfo]
pvers
     , let pinsts' :: [InstalledPackageInfo]
pinsts'  = (InstalledPackageInfo -> InstalledPackageInfo -> Ordering)
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((InstalledPackageInfo -> UnitId)
-> InstalledPackageInfo -> InstalledPackageInfo -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId) [InstalledPackageInfo]
pinsts
           pinstsOk :: Bool
pinstsOk = ([InstalledPackageInfo] -> Bool)
-> [[InstalledPackageInfo]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\[InstalledPackageInfo]
g -> [InstalledPackageInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [InstalledPackageInfo]
g Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)
                          ((InstalledPackageInfo -> InstalledPackageInfo -> Bool)
-> [InstalledPackageInfo] -> [[InstalledPackageInfo]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ((InstalledPackageInfo -> UnitId)
-> InstalledPackageInfo -> InstalledPackageInfo -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId) [InstalledPackageInfo]
pinsts')
     , InstalledPackageInfo
pinst           <- Bool -> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a. HasCallStack => Bool -> a -> a
assert Bool
pinstsOk ([InstalledPackageInfo] -> [InstalledPackageInfo])
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a b. (a -> b) -> a -> b
$ [InstalledPackageInfo]
pinsts'
     , let pinstOk :: Bool
pinstOk = InstalledPackageInfo -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName    InstalledPackageInfo
pinst PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
pname
                  Bool -> Bool -> Bool
&& InstalledPackageInfo -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion InstalledPackageInfo
pinst Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
pver
                  Bool -> Bool -> Bool
&& InstalledPackageInfo -> LibraryName
IPI.sourceLibName  InstalledPackageInfo
pinst LibraryName -> LibraryName -> Bool
forall a. Eq a => a -> a -> Bool
== LibraryName
plib
     ]
  -- If you see this invariant failing (ie the assert in mkPackageIndex below)
  -- then one thing to check is if it is happening in fromList. Check if the
  -- second list above (the sort [...] bit) is ending up with duplicates. This
  -- has been observed in practice once due to a messed up ghc-pkg db. How/why
  -- it became messed up was not discovered.


--
-- * Internal helpers
--

mkPackageIndex :: WithCallStack (Map UnitId IPI.InstalledPackageInfo
               -> Map (PackageName, LibraryName)
                      (Map Version [IPI.InstalledPackageInfo])
               -> InstalledPackageIndex)
mkPackageIndex :: WithCallStack
  (Map UnitId InstalledPackageInfo
   -> Map
        (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
   -> PackageIndex InstalledPackageInfo)
mkPackageIndex Map UnitId InstalledPackageInfo
pids Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames = Bool
-> PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
forall a. HasCallStack => Bool -> a -> a
assert (WithCallStack (PackageIndex InstalledPackageInfo -> Bool)
PackageIndex InstalledPackageInfo -> Bool
invariant PackageIndex InstalledPackageInfo
index) PackageIndex InstalledPackageInfo
index
  where index :: PackageIndex InstalledPackageInfo
index = Map UnitId InstalledPackageInfo
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> PackageIndex InstalledPackageInfo
forall a.
Map UnitId a
-> Map (PackageName, LibraryName) (Map Version [a])
-> PackageIndex a
PackageIndex Map UnitId InstalledPackageInfo
pids Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames


--
-- * Construction
--

-- | Build an index out of a bunch of packages.
--
-- If there are duplicates by 'UnitId' then later ones mask earlier
-- ones.
--
fromList :: [IPI.InstalledPackageInfo] -> InstalledPackageIndex
fromList :: [InstalledPackageInfo] -> PackageIndex InstalledPackageInfo
fromList [InstalledPackageInfo]
pkgs = WithCallStack
  (Map UnitId InstalledPackageInfo
   -> Map
        (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
   -> PackageIndex InstalledPackageInfo)
Map UnitId InstalledPackageInfo
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> PackageIndex InstalledPackageInfo
mkPackageIndex Map UnitId InstalledPackageInfo
pids (((Map Version (NonEmpty InstalledPackageInfo)
 -> Map Version [InstalledPackageInfo])
-> Map
     (PackageName, LibraryName)
     (Map Version (NonEmpty InstalledPackageInfo))
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
forall a b.
(a -> b)
-> Map (PackageName, LibraryName) a
-> Map (PackageName, LibraryName) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Map Version (NonEmpty InstalledPackageInfo)
  -> Map Version [InstalledPackageInfo])
 -> Map
      (PackageName, LibraryName)
      (Map Version (NonEmpty InstalledPackageInfo))
 -> Map
      (PackageName, LibraryName) (Map Version [InstalledPackageInfo]))
-> ((NonEmpty InstalledPackageInfo -> [InstalledPackageInfo])
    -> Map Version (NonEmpty InstalledPackageInfo)
    -> Map Version [InstalledPackageInfo])
-> (NonEmpty InstalledPackageInfo -> [InstalledPackageInfo])
-> Map
     (PackageName, LibraryName)
     (Map Version (NonEmpty InstalledPackageInfo))
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty InstalledPackageInfo -> [InstalledPackageInfo])
-> Map Version (NonEmpty InstalledPackageInfo)
-> Map Version [InstalledPackageInfo]
forall a b. (a -> b) -> Map Version a -> Map Version b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) NonEmpty InstalledPackageInfo -> [InstalledPackageInfo]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map
  (PackageName, LibraryName)
  (Map Version (NonEmpty InstalledPackageInfo))
pnames)
  where
    pids :: Map UnitId InstalledPackageInfo
pids      = [(UnitId, InstalledPackageInfo)] -> Map UnitId InstalledPackageInfo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstalledPackageInfo
pkg, InstalledPackageInfo
pkg) | InstalledPackageInfo
pkg <- [InstalledPackageInfo]
pkgs ]
    pnames :: Map
  (PackageName, LibraryName)
  (Map Version (NonEmpty InstalledPackageInfo))
pnames    =
      [((PackageName, LibraryName),
  Map Version (NonEmpty InstalledPackageInfo))]
-> Map
     (PackageName, LibraryName)
     (Map Version (NonEmpty InstalledPackageInfo))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ ((PackageName -> LibraryName -> (PackageName, LibraryName))
-> (InstalledPackageInfo -> PackageName)
-> (InstalledPackageInfo -> LibraryName)
-> InstalledPackageInfo
-> (PackageName, LibraryName)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) InstalledPackageInfo -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo -> LibraryName
IPI.sourceLibName (NonEmpty InstalledPackageInfo -> InstalledPackageInfo
forall a. NonEmpty a -> a
NE.head NonEmpty InstalledPackageInfo
pkgsN), Map Version (NonEmpty InstalledPackageInfo)
pvers)
        | NonEmpty InstalledPackageInfo
pkgsN <- (InstalledPackageInfo -> InstalledPackageInfo -> Bool)
-> [InstalledPackageInfo] -> [NonEmpty InstalledPackageInfo]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy ((InstalledPackageInfo -> (PackageName, LibraryName))
-> InstalledPackageInfo -> InstalledPackageInfo -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating  ((PackageName -> LibraryName -> (PackageName, LibraryName))
-> (InstalledPackageInfo -> PackageName)
-> (InstalledPackageInfo -> LibraryName)
-> InstalledPackageInfo
-> (PackageName, LibraryName)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) InstalledPackageInfo -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo -> LibraryName
IPI.sourceLibName))
                 ([InstalledPackageInfo] -> [NonEmpty InstalledPackageInfo])
-> ([InstalledPackageInfo] -> [InstalledPackageInfo])
-> [InstalledPackageInfo]
-> [NonEmpty InstalledPackageInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstalledPackageInfo -> InstalledPackageInfo -> Ordering)
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy  ((InstalledPackageInfo -> (PackageName, LibraryName, Version))
-> InstalledPackageInfo -> InstalledPackageInfo -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((PackageName
 -> LibraryName -> Version -> (PackageName, LibraryName, Version))
-> (InstalledPackageInfo -> PackageName)
-> (InstalledPackageInfo -> LibraryName)
-> (InstalledPackageInfo -> Version)
-> InstalledPackageInfo
-> (PackageName, LibraryName, Version)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) InstalledPackageInfo -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo -> LibraryName
IPI.sourceLibName InstalledPackageInfo -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion))
                 ([InstalledPackageInfo] -> [NonEmpty InstalledPackageInfo])
-> [InstalledPackageInfo] -> [NonEmpty InstalledPackageInfo]
forall a b. (a -> b) -> a -> b
$ [InstalledPackageInfo]
pkgs
        , let pvers :: Map Version (NonEmpty InstalledPackageInfo)
pvers =
                [(Version, NonEmpty InstalledPackageInfo)]
-> Map Version (NonEmpty InstalledPackageInfo)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [ (InstalledPackageInfo -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion (NonEmpty InstalledPackageInfo -> InstalledPackageInfo
forall a. NonEmpty a -> a
NE.head NonEmpty InstalledPackageInfo
pkgsNV),
                   (InstalledPackageInfo -> InstalledPackageInfo -> Bool)
-> NonEmpty InstalledPackageInfo -> NonEmpty InstalledPackageInfo
forall a. (a -> a -> Bool) -> NonEmpty a -> NonEmpty a
NE.nubBy ((InstalledPackageInfo -> UnitId)
-> InstalledPackageInfo -> InstalledPackageInfo -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId) (NonEmpty InstalledPackageInfo -> NonEmpty InstalledPackageInfo
forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty InstalledPackageInfo
pkgsNV))
                | NonEmpty InstalledPackageInfo
pkgsNV <- (InstalledPackageInfo -> InstalledPackageInfo -> Bool)
-> NonEmpty InstalledPackageInfo -> [NonEmpty InstalledPackageInfo]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy ((InstalledPackageInfo -> Version)
-> InstalledPackageInfo -> InstalledPackageInfo -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating InstalledPackageInfo -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion) NonEmpty InstalledPackageInfo
pkgsN
                ]
        ]

--
-- * Updates
--

-- | Merge two indexes.
--
-- Packages from the second mask packages from the first if they have the exact
-- same 'UnitId'.
--
-- For packages with the same source 'PackageId', packages from the second are
-- \"preferred\" over those from the first. Being preferred means they are top
-- result when we do a lookup by source 'PackageId'. This is the mechanism we
-- use to prefer user packages over global packages.
--
merge :: InstalledPackageIndex -> InstalledPackageIndex
      -> InstalledPackageIndex
merge :: PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
merge (PackageIndex Map UnitId InstalledPackageInfo
pids1 Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames1) (PackageIndex Map UnitId InstalledPackageInfo
pids2 Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames2) =
  WithCallStack
  (Map UnitId InstalledPackageInfo
   -> Map
        (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
   -> PackageIndex InstalledPackageInfo)
Map UnitId InstalledPackageInfo
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> PackageIndex InstalledPackageInfo
mkPackageIndex ((InstalledPackageInfo
 -> InstalledPackageInfo -> InstalledPackageInfo)
-> Map UnitId InstalledPackageInfo
-> Map UnitId InstalledPackageInfo
-> Map UnitId InstalledPackageInfo
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (\InstalledPackageInfo
_ InstalledPackageInfo
y -> InstalledPackageInfo
y) Map UnitId InstalledPackageInfo
pids1 Map UnitId InstalledPackageInfo
pids2)
                 ((Map Version [InstalledPackageInfo]
 -> Map Version [InstalledPackageInfo]
 -> Map Version [InstalledPackageInfo])
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (([InstalledPackageInfo]
 -> [InstalledPackageInfo] -> [InstalledPackageInfo])
-> Map Version [InstalledPackageInfo]
-> Map Version [InstalledPackageInfo]
-> Map Version [InstalledPackageInfo]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [InstalledPackageInfo]
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
mergeBuckets) Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames1 Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames2)
  where
    -- Packages in the second list mask those in the first, however preferred
    -- packages go first in the list.
    mergeBuckets :: [InstalledPackageInfo]
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
mergeBuckets [InstalledPackageInfo]
xs [InstalledPackageInfo]
ys = [InstalledPackageInfo]
ys [InstalledPackageInfo]
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a. [a] -> [a] -> [a]
++ ([InstalledPackageInfo]
xs [InstalledPackageInfo]
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
\\ [InstalledPackageInfo]
ys)
    \\ :: [InstalledPackageInfo]
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
(\\) = (InstalledPackageInfo -> InstalledPackageInfo -> Bool)
-> [InstalledPackageInfo]
-> [InstalledPackageInfo]
-> [InstalledPackageInfo]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
deleteFirstsBy ((InstalledPackageInfo -> UnitId)
-> InstalledPackageInfo -> InstalledPackageInfo -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId)


-- | Inserts a single package into the index.
--
-- This is equivalent to (but slightly quicker than) using 'mappend' or
-- 'merge' with a singleton index.
--
insert :: IPI.InstalledPackageInfo -> InstalledPackageIndex -> InstalledPackageIndex
insert :: InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
insert InstalledPackageInfo
pkg (PackageIndex Map UnitId InstalledPackageInfo
pids Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames) =
    WithCallStack
  (Map UnitId InstalledPackageInfo
   -> Map
        (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
   -> PackageIndex InstalledPackageInfo)
Map UnitId InstalledPackageInfo
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> PackageIndex InstalledPackageInfo
mkPackageIndex Map UnitId InstalledPackageInfo
pids' Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames'

  where
    pids' :: Map UnitId InstalledPackageInfo
pids'   = UnitId
-> InstalledPackageInfo
-> Map UnitId InstalledPackageInfo
-> Map UnitId InstalledPackageInfo
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstalledPackageInfo
pkg) InstalledPackageInfo
pkg Map UnitId InstalledPackageInfo
pids
    pnames' :: Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames' = Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
insertPackageName Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames
    insertPackageName :: Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
insertPackageName =
      (Map Version [InstalledPackageInfo]
 -> Map Version [InstalledPackageInfo]
 -> Map Version [InstalledPackageInfo])
-> (PackageName, LibraryName)
-> Map Version [InstalledPackageInfo]
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\Map Version [InstalledPackageInfo]
_ -> Map Version [InstalledPackageInfo]
-> Map Version [InstalledPackageInfo]
insertPackageVersion)
                     (InstalledPackageInfo -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo
pkg, InstalledPackageInfo -> LibraryName
IPI.sourceLibName InstalledPackageInfo
pkg)
                     (Version
-> [InstalledPackageInfo] -> Map Version [InstalledPackageInfo]
forall k a. k -> a -> Map k a
Map.singleton (InstalledPackageInfo -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion InstalledPackageInfo
pkg) [InstalledPackageInfo
pkg])

    insertPackageVersion :: Map Version [InstalledPackageInfo]
-> Map Version [InstalledPackageInfo]
insertPackageVersion =
      ([InstalledPackageInfo]
 -> [InstalledPackageInfo] -> [InstalledPackageInfo])
-> Version
-> [InstalledPackageInfo]
-> Map Version [InstalledPackageInfo]
-> Map Version [InstalledPackageInfo]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\[InstalledPackageInfo]
_ -> [InstalledPackageInfo] -> [InstalledPackageInfo]
insertPackageInstance)
                     (InstalledPackageInfo -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion InstalledPackageInfo
pkg) [InstalledPackageInfo
pkg]

    insertPackageInstance :: [InstalledPackageInfo] -> [InstalledPackageInfo]
insertPackageInstance [InstalledPackageInfo]
pkgs =
      InstalledPackageInfo
pkg InstalledPackageInfo
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a. a -> [a] -> [a]
: (InstalledPackageInfo -> InstalledPackageInfo -> Bool)
-> InstalledPackageInfo
-> [InstalledPackageInfo]
-> [InstalledPackageInfo]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy ((InstalledPackageInfo -> UnitId)
-> InstalledPackageInfo -> InstalledPackageInfo -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId) InstalledPackageInfo
pkg [InstalledPackageInfo]
pkgs


-- | Removes a single installed package from the index.
--
deleteUnitId :: UnitId -> InstalledPackageIndex
             -> InstalledPackageIndex
deleteUnitId :: UnitId
-> PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
deleteUnitId UnitId
ipkgid original :: PackageIndex InstalledPackageInfo
original@(PackageIndex Map UnitId InstalledPackageInfo
pids Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames) =
  case (UnitId -> InstalledPackageInfo -> Maybe InstalledPackageInfo)
-> UnitId
-> Map UnitId InstalledPackageInfo
-> (Maybe InstalledPackageInfo, Map UnitId InstalledPackageInfo)
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey (\UnitId
_ InstalledPackageInfo
_ -> Maybe InstalledPackageInfo
forall a. Maybe a
Nothing) UnitId
ipkgid Map UnitId InstalledPackageInfo
pids of
    (Maybe InstalledPackageInfo
Nothing,     Map UnitId InstalledPackageInfo
_)     -> PackageIndex InstalledPackageInfo
original
    (Just InstalledPackageInfo
spkgid, Map UnitId InstalledPackageInfo
pids') -> WithCallStack
  (Map UnitId InstalledPackageInfo
   -> Map
        (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
   -> PackageIndex InstalledPackageInfo)
Map UnitId InstalledPackageInfo
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> PackageIndex InstalledPackageInfo
mkPackageIndex Map UnitId InstalledPackageInfo
pids'
                                          (InstalledPackageInfo
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
deletePkgName InstalledPackageInfo
spkgid Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames)

  where
    deletePkgName :: InstalledPackageInfo
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
deletePkgName InstalledPackageInfo
spkgid =
      (Map Version [InstalledPackageInfo]
 -> Maybe (Map Version [InstalledPackageInfo]))
-> (PackageName, LibraryName)
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update (InstalledPackageInfo
-> Map Version [InstalledPackageInfo]
-> Maybe (Map Version [InstalledPackageInfo])
forall {pkg}.
Package pkg =>
pkg
-> Map Version [InstalledPackageInfo]
-> Maybe (Map Version [InstalledPackageInfo])
deletePkgVersion InstalledPackageInfo
spkgid) (InstalledPackageInfo -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo
spkgid, InstalledPackageInfo -> LibraryName
IPI.sourceLibName InstalledPackageInfo
spkgid)

    deletePkgVersion :: pkg
-> Map Version [InstalledPackageInfo]
-> Maybe (Map Version [InstalledPackageInfo])
deletePkgVersion pkg
spkgid =
        (\Map Version [InstalledPackageInfo]
m -> if Map Version [InstalledPackageInfo] -> Bool
forall k a. Map k a -> Bool
Map.null Map Version [InstalledPackageInfo]
m then Maybe (Map Version [InstalledPackageInfo])
forall a. Maybe a
Nothing else Map Version [InstalledPackageInfo]
-> Maybe (Map Version [InstalledPackageInfo])
forall a. a -> Maybe a
Just Map Version [InstalledPackageInfo]
m)
      (Map Version [InstalledPackageInfo]
 -> Maybe (Map Version [InstalledPackageInfo]))
-> (Map Version [InstalledPackageInfo]
    -> Map Version [InstalledPackageInfo])
-> Map Version [InstalledPackageInfo]
-> Maybe (Map Version [InstalledPackageInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([InstalledPackageInfo] -> Maybe [InstalledPackageInfo])
-> Version
-> Map Version [InstalledPackageInfo]
-> Map Version [InstalledPackageInfo]
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update [InstalledPackageInfo] -> Maybe [InstalledPackageInfo]
deletePkgInstance (pkg -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion pkg
spkgid)

    deletePkgInstance :: [InstalledPackageInfo] -> Maybe [InstalledPackageInfo]
deletePkgInstance =
        (\[InstalledPackageInfo]
xs -> if [InstalledPackageInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InstalledPackageInfo]
xs then Maybe [InstalledPackageInfo]
forall a. Maybe a
Nothing else [InstalledPackageInfo] -> Maybe [InstalledPackageInfo]
forall a. a -> Maybe a
Just [InstalledPackageInfo]
xs)
      ([InstalledPackageInfo] -> Maybe [InstalledPackageInfo])
-> ([InstalledPackageInfo] -> [InstalledPackageInfo])
-> [InstalledPackageInfo]
-> Maybe [InstalledPackageInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstalledPackageInfo -> InstalledPackageInfo -> Bool)
-> InstalledPackageInfo
-> [InstalledPackageInfo]
-> [InstalledPackageInfo]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
List.deleteBy (\InstalledPackageInfo
_ InstalledPackageInfo
pkg -> InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstalledPackageInfo
pkg UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
ipkgid) InstalledPackageInfo
forall a. HasCallStack => a
undefined

-- | Removes all packages with this source 'PackageId' from the index.
--
deleteSourcePackageId :: PackageId -> InstalledPackageIndex
                      -> InstalledPackageIndex
deleteSourcePackageId :: PackageId
-> PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
deleteSourcePackageId PackageId
pkgid original :: PackageIndex InstalledPackageInfo
original@(PackageIndex Map UnitId InstalledPackageInfo
pids Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames) =
  -- NB: Doesn't delete internal packages
  case (PackageName, LibraryName)
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> Maybe (Map Version [InstalledPackageInfo])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgid, LibraryName
LMainLibName) Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames of
    Maybe (Map Version [InstalledPackageInfo])
Nothing     -> PackageIndex InstalledPackageInfo
original
    Just Map Version [InstalledPackageInfo]
pvers  -> case Version
-> Map Version [InstalledPackageInfo]
-> Maybe [InstalledPackageInfo]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageId -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageId
pkgid) Map Version [InstalledPackageInfo]
pvers of
      Maybe [InstalledPackageInfo]
Nothing   -> PackageIndex InstalledPackageInfo
original
      Just [InstalledPackageInfo]
pkgs -> WithCallStack
  (Map UnitId InstalledPackageInfo
   -> Map
        (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
   -> PackageIndex InstalledPackageInfo)
Map UnitId InstalledPackageInfo
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> PackageIndex InstalledPackageInfo
mkPackageIndex
                     ((Map UnitId InstalledPackageInfo
 -> InstalledPackageInfo -> Map UnitId InstalledPackageInfo)
-> Map UnitId InstalledPackageInfo
-> [InstalledPackageInfo]
-> Map UnitId InstalledPackageInfo
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((InstalledPackageInfo
 -> Map UnitId InstalledPackageInfo
 -> Map UnitId InstalledPackageInfo)
-> Map UnitId InstalledPackageInfo
-> InstalledPackageInfo
-> Map UnitId InstalledPackageInfo
forall a b c. (a -> b -> c) -> b -> a -> c
flip (UnitId
-> Map UnitId InstalledPackageInfo
-> Map UnitId InstalledPackageInfo
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (UnitId
 -> Map UnitId InstalledPackageInfo
 -> Map UnitId InstalledPackageInfo)
-> (InstalledPackageInfo -> UnitId)
-> InstalledPackageInfo
-> Map UnitId InstalledPackageInfo
-> Map UnitId InstalledPackageInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId)) Map UnitId InstalledPackageInfo
pids [InstalledPackageInfo]
pkgs)
                     (Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
forall {a}.
Map (PackageName, LibraryName) (Map Version a)
-> Map (PackageName, LibraryName) (Map Version a)
deletePkgName Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames)
  where
    deletePkgName :: Map (PackageName, LibraryName) (Map Version a)
-> Map (PackageName, LibraryName) (Map Version a)
deletePkgName =
      (Map Version a -> Maybe (Map Version a))
-> (PackageName, LibraryName)
-> Map (PackageName, LibraryName) (Map Version a)
-> Map (PackageName, LibraryName) (Map Version a)
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update Map Version a -> Maybe (Map Version a)
forall {a}. Map Version a -> Maybe (Map Version a)
deletePkgVersion (PackageId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgid, LibraryName
LMainLibName)

    deletePkgVersion :: Map Version a -> Maybe (Map Version a)
deletePkgVersion =
        (\Map Version a
m -> if Map Version a -> Bool
forall k a. Map k a -> Bool
Map.null Map Version a
m then Maybe (Map Version a)
forall a. Maybe a
Nothing else Map Version a -> Maybe (Map Version a)
forall a. a -> Maybe a
Just Map Version a
m)
      (Map Version a -> Maybe (Map Version a))
-> (Map Version a -> Map Version a)
-> Map Version a
-> Maybe (Map Version a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Map Version a -> Map Version a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (PackageId -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageId
pkgid)


-- | Removes all packages with this (case-sensitive) name from the index.
--
-- NB: Does NOT delete internal libraries from this package.
--
deletePackageName :: PackageName -> InstalledPackageIndex
                  -> InstalledPackageIndex
deletePackageName :: PackageName
-> PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
deletePackageName PackageName
name original :: PackageIndex InstalledPackageInfo
original@(PackageIndex Map UnitId InstalledPackageInfo
pids Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames) =
  case (PackageName, LibraryName)
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> Maybe (Map Version [InstalledPackageInfo])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName
name, LibraryName
LMainLibName) Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames of
    Maybe (Map Version [InstalledPackageInfo])
Nothing     -> PackageIndex InstalledPackageInfo
original
    Just Map Version [InstalledPackageInfo]
pvers  -> WithCallStack
  (Map UnitId InstalledPackageInfo
   -> Map
        (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
   -> PackageIndex InstalledPackageInfo)
Map UnitId InstalledPackageInfo
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> PackageIndex InstalledPackageInfo
mkPackageIndex
                     ((Map UnitId InstalledPackageInfo
 -> InstalledPackageInfo -> Map UnitId InstalledPackageInfo)
-> Map UnitId InstalledPackageInfo
-> [InstalledPackageInfo]
-> Map UnitId InstalledPackageInfo
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((InstalledPackageInfo
 -> Map UnitId InstalledPackageInfo
 -> Map UnitId InstalledPackageInfo)
-> Map UnitId InstalledPackageInfo
-> InstalledPackageInfo
-> Map UnitId InstalledPackageInfo
forall a b c. (a -> b -> c) -> b -> a -> c
flip (UnitId
-> Map UnitId InstalledPackageInfo
-> Map UnitId InstalledPackageInfo
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (UnitId
 -> Map UnitId InstalledPackageInfo
 -> Map UnitId InstalledPackageInfo)
-> (InstalledPackageInfo -> UnitId)
-> InstalledPackageInfo
-> Map UnitId InstalledPackageInfo
-> Map UnitId InstalledPackageInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId)) Map UnitId InstalledPackageInfo
pids
                             ([[InstalledPackageInfo]] -> [InstalledPackageInfo]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Map Version [InstalledPackageInfo] -> [[InstalledPackageInfo]]
forall k a. Map k a -> [a]
Map.elems Map Version [InstalledPackageInfo]
pvers)))
                     ((PackageName, LibraryName)
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (PackageName
name, LibraryName
LMainLibName) Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames)

{-
-- | Removes all packages satisfying this dependency from the index.
--
deleteDependency :: Dependency -> PackageIndex -> PackageIndex
deleteDependency (Dependency name verstionRange) =
  delete' name (\pkg -> packageVersion pkg `withinRange` verstionRange)
-}

--
-- * Bulk queries
--

-- | Get all the packages from the index.
--
allPackages :: PackageIndex a -> [a]
allPackages :: forall a. PackageIndex a -> [a]
allPackages = Map UnitId a -> [a]
forall k a. Map k a -> [a]
Map.elems (Map UnitId a -> [a])
-> (PackageIndex a -> Map UnitId a) -> PackageIndex a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIndex a -> Map UnitId a
forall a. PackageIndex a -> Map UnitId a
unitIdIndex

-- | Get all the packages from the index.
--
-- They are grouped by package name (case-sensitively).
--
-- (Doesn't include private libraries.)
--
allPackagesByName :: PackageIndex a -> [(PackageName, [a])]
allPackagesByName :: forall a. PackageIndex a -> [(PackageName, [a])]
allPackagesByName PackageIndex a
index =
  [ (PackageName
pkgname, [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Map Version [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems Map Version [a]
pvers))
  | ((PackageName
pkgname, LibraryName
LMainLibName), Map Version [a]
pvers) <- Map (PackageName, LibraryName) (Map Version [a])
-> [((PackageName, LibraryName), Map Version [a])]
forall k a. Map k a -> [(k, a)]
Map.toList (PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
forall a.
PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
packageIdIndex PackageIndex a
index) ]

-- | Get all the packages from the index.
--
-- They are grouped by source package id (package name and version).
--
-- (Doesn't include private libraries)
--
allPackagesBySourcePackageId :: HasUnitId a => PackageIndex a
                             -> [(PackageId, [a])]
allPackagesBySourcePackageId :: forall a. HasUnitId a => PackageIndex a -> [(PackageId, [a])]
allPackagesBySourcePackageId PackageIndex a
index =
  [ (a -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId a
ipkg, [a]
ipkgs)
  | ((PackageName
_, LibraryName
LMainLibName), Map Version [a]
pvers) <- Map (PackageName, LibraryName) (Map Version [a])
-> [((PackageName, LibraryName), Map Version [a])]
forall k a. Map k a -> [(k, a)]
Map.toList (PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
forall a.
PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
packageIdIndex PackageIndex a
index)
  , ipkgs :: [a]
ipkgs@(a
ipkg:[a]
_) <- Map Version [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems Map Version [a]
pvers ]

-- | Get all the packages from the index.
--
-- They are grouped by source package id and library name.
--
-- This DOES include internal libraries.
allPackagesBySourcePackageIdAndLibName :: HasUnitId a => PackageIndex a
                             -> [((PackageId, LibraryName), [a])]
allPackagesBySourcePackageIdAndLibName :: forall a.
HasUnitId a =>
PackageIndex a -> [((PackageId, LibraryName), [a])]
allPackagesBySourcePackageIdAndLibName PackageIndex a
index =
  [ ((a -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId a
ipkg, LibraryName
ln), [a]
ipkgs)
  | ((PackageName
_, LibraryName
ln), Map Version [a]
pvers) <- Map (PackageName, LibraryName) (Map Version [a])
-> [((PackageName, LibraryName), Map Version [a])]
forall k a. Map k a -> [(k, a)]
Map.toList (PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
forall a.
PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
packageIdIndex PackageIndex a
index)
  , ipkgs :: [a]
ipkgs@(a
ipkg:[a]
_) <- Map Version [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems Map Version [a]
pvers ]

--
-- * Lookups
--

-- | Does a lookup by unit identifier.
--
-- Since multiple package DBs mask each other by 'UnitId',
-- then we get back at most one package.
--
lookupUnitId :: PackageIndex a -> UnitId
             -> Maybe a
lookupUnitId :: forall a. PackageIndex a -> UnitId -> Maybe a
lookupUnitId PackageIndex a
index UnitId
uid = UnitId -> Map UnitId a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UnitId
uid (PackageIndex a -> Map UnitId a
forall a. PackageIndex a -> Map UnitId a
unitIdIndex PackageIndex a
index)

-- | Does a lookup by component identifier.  In the absence
-- of Backpack, this is just a 'lookupUnitId'.
--
lookupComponentId :: PackageIndex a -> ComponentId
                  -> Maybe a
lookupComponentId :: forall a. PackageIndex a -> ComponentId -> Maybe a
lookupComponentId PackageIndex a
index ComponentId
cid =
    UnitId -> Map UnitId a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ComponentId -> UnitId
newSimpleUnitId ComponentId
cid) (PackageIndex a -> Map UnitId a
forall a. PackageIndex a -> Map UnitId a
unitIdIndex PackageIndex a
index)

-- | Does a lookup by source package id (name & version).
--
-- There can be multiple installed packages with the same source 'PackageId'
-- but different 'UnitId'. They are returned in order of
-- preference, with the most preferred first.
--
lookupSourcePackageId :: PackageIndex a -> PackageId -> [a]
lookupSourcePackageId :: forall a. PackageIndex a -> PackageId -> [a]
lookupSourcePackageId PackageIndex a
index PackageId
pkgid =
  -- Do not lookup internal libraries
  case (PackageName, LibraryName)
-> Map (PackageName, LibraryName) (Map Version [a])
-> Maybe (Map Version [a])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgid, LibraryName
LMainLibName) (PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
forall a.
PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
packageIdIndex PackageIndex a
index) of
    Maybe (Map Version [a])
Nothing     -> []
    Just Map Version [a]
pvers  -> case Version -> Map Version [a] -> Maybe [a]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageId -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageId
pkgid) Map Version [a]
pvers of
      Maybe [a]
Nothing   -> []
      Just [a]
pkgs -> [a]
pkgs -- in preference order

-- | Convenient alias of 'lookupSourcePackageId', but assuming only
-- one package per package ID.
lookupPackageId :: PackageIndex a -> PackageId -> Maybe a
lookupPackageId :: forall a. PackageIndex a -> PackageId -> Maybe a
lookupPackageId PackageIndex a
index PackageId
pkgid = case PackageIndex a -> PackageId -> [a]
forall a. PackageIndex a -> PackageId -> [a]
lookupSourcePackageId PackageIndex a
index PackageId
pkgid  of
    []    -> Maybe a
forall a. Maybe a
Nothing
    [a
pkg] -> a -> Maybe a
forall a. a -> Maybe a
Just a
pkg
    [a]
_     -> String -> Maybe a
forall a. HasCallStack => String -> a
error String
"Distribution.Simple.PackageIndex: multiple matches found"

-- | Does a lookup by source package name.
--
lookupPackageName :: PackageIndex a -> PackageName
                  -> [(Version, [a])]
lookupPackageName :: forall a. PackageIndex a -> PackageName -> [(Version, [a])]
lookupPackageName PackageIndex a
index PackageName
name =
  -- Do not match internal libraries
  case (PackageName, LibraryName)
-> Map (PackageName, LibraryName) (Map Version [a])
-> Maybe (Map Version [a])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName
name, LibraryName
LMainLibName) (PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
forall a.
PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
packageIdIndex PackageIndex a
index) of
    Maybe (Map Version [a])
Nothing     -> []
    Just Map Version [a]
pvers  -> Map Version [a] -> [(Version, [a])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Version [a]
pvers


-- | Does a lookup by source package name and a range of versions.
--
-- We get back any number of versions of the specified package name, all
-- satisfying the version range constraint.
--
-- This does NOT work for internal dependencies, DO NOT use this
-- function on those; use 'lookupInternalDependency' instead.
--
-- INVARIANT: List of eligible 'IPI.InstalledPackageInfo' is non-empty.
--
lookupDependency :: InstalledPackageIndex -> PackageName -> VersionRange
                 -> [(Version, [IPI.InstalledPackageInfo])]
lookupDependency :: PackageIndex InstalledPackageInfo
-> PackageName
-> VersionRange
-> [(Version, [InstalledPackageInfo])]
lookupDependency PackageIndex InstalledPackageInfo
index PackageName
pn VersionRange
vr =
    -- Yes, a little bit of a misnomer here!
    PackageIndex InstalledPackageInfo
-> PackageName
-> VersionRange
-> LibraryName
-> [(Version, [InstalledPackageInfo])]
lookupInternalDependency PackageIndex InstalledPackageInfo
index PackageName
pn VersionRange
vr LibraryName
LMainLibName

-- | Does a lookup by source package name and a range of versions.
--
-- We get back any number of versions of the specified package name, all
-- satisfying the version range constraint.
--
-- INVARIANT: List of eligible 'IPI.InstalledPackageInfo' is non-empty.
--
lookupInternalDependency :: InstalledPackageIndex -> PackageName -> VersionRange
                 -> LibraryName
                 -> [(Version, [IPI.InstalledPackageInfo])]
lookupInternalDependency :: PackageIndex InstalledPackageInfo
-> PackageName
-> VersionRange
-> LibraryName
-> [(Version, [InstalledPackageInfo])]
lookupInternalDependency PackageIndex InstalledPackageInfo
index PackageName
name VersionRange
versionRange LibraryName
libn =
  case (PackageName, LibraryName)
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
-> Maybe (Map Version [InstalledPackageInfo])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName
name, LibraryName
libn) (PackageIndex InstalledPackageInfo
-> Map
     (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
forall a.
PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
packageIdIndex PackageIndex InstalledPackageInfo
index) of
    Maybe (Map Version [InstalledPackageInfo])
Nothing    -> []
    Just Map Version [InstalledPackageInfo]
pvers -> [ (Version
ver, [InstalledPackageInfo]
pkgs')
                  | (Version
ver, [InstalledPackageInfo]
pkgs) <- Map Version [InstalledPackageInfo]
-> [(Version, [InstalledPackageInfo])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Version [InstalledPackageInfo]
pvers
                  , Version
ver Version -> VersionRange -> Bool
`withinRange` VersionRange
versionRange
                  , let pkgs' :: [InstalledPackageInfo]
pkgs' = (InstalledPackageInfo -> Bool)
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter InstalledPackageInfo -> Bool
eligible [InstalledPackageInfo]
pkgs
                  -- Enforce the invariant
                  , Bool -> Bool
not ([InstalledPackageInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InstalledPackageInfo]
pkgs')
                  ]
 where
  -- When we select for dependencies, we ONLY want to pick up indefinite
  -- packages, or packages with no instantiations.  We'll do mix-in
  -- linking to improve any such package into an instantiated one
  -- later.
  eligible :: InstalledPackageInfo -> Bool
eligible InstalledPackageInfo
pkg = InstalledPackageInfo -> Bool
IPI.indefinite InstalledPackageInfo
pkg Bool -> Bool -> Bool
|| [(ModuleName, OpenModule)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (InstalledPackageInfo -> [(ModuleName, OpenModule)]
IPI.instantiatedWith InstalledPackageInfo
pkg)


--
-- * Case insensitive name lookups
--

-- | Does a case-insensitive search by package name.
--
-- If there is only one package that compares case-insensitively to this name
-- then the search is unambiguous and we get back all versions of that package.
-- If several match case-insensitively but one matches exactly then it is also
-- unambiguous.
--
-- If however several match case-insensitively and none match exactly then we
-- have an ambiguous result, and we get back all the versions of all the
-- packages. The list of ambiguous results is split by exact package name. So
-- it is a non-empty list of non-empty lists.
--
searchByName :: PackageIndex a -> String -> SearchResult [a]
searchByName :: forall a. PackageIndex a -> String -> SearchResult [a]
searchByName PackageIndex a
index String
name =
  -- Don't match internal packages
  case [ ((PackageName, LibraryName), Map Version [a])
pkgs | pkgs :: ((PackageName, LibraryName), Map Version [a])
pkgs@((PackageName
pname, LibraryName
LMainLibName),Map Version [a]
_) <- Map (PackageName, LibraryName) (Map Version [a])
-> [((PackageName, LibraryName), Map Version [a])]
forall k a. Map k a -> [(k, a)]
Map.toList (PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
forall a.
PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
packageIdIndex PackageIndex a
index)
              , ShowS
lowercase (PackageName -> String
unPackageName PackageName
pname) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
lname ] of
    []               -> SearchResult [a]
forall a. SearchResult a
None
    [((PackageName, LibraryName)
_,Map Version [a]
pvers)]      -> [a] -> SearchResult [a]
forall a. a -> SearchResult a
Unambiguous ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Map Version [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems Map Version [a]
pvers))
    [((PackageName, LibraryName), Map Version [a])]
pkgss            -> case (((PackageName, LibraryName), Map Version [a]) -> Bool)
-> [((PackageName, LibraryName), Map Version [a])]
-> Maybe ((PackageName, LibraryName), Map Version [a])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> PackageName
mkPackageName String
name PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
==) (PackageName -> Bool)
-> (((PackageName, LibraryName), Map Version [a]) -> PackageName)
-> ((PackageName, LibraryName), Map Version [a])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageName, LibraryName) -> PackageName
forall a b. (a, b) -> a
fst ((PackageName, LibraryName) -> PackageName)
-> (((PackageName, LibraryName), Map Version [a])
    -> (PackageName, LibraryName))
-> ((PackageName, LibraryName), Map Version [a])
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PackageName, LibraryName), Map Version [a])
-> (PackageName, LibraryName)
forall a b. (a, b) -> a
fst) [((PackageName, LibraryName), Map Version [a])]
pkgss of
      Just ((PackageName, LibraryName)
_,Map Version [a]
pvers) -> [a] -> SearchResult [a]
forall a. a -> SearchResult a
Unambiguous ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Map Version [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems Map Version [a]
pvers))
      Maybe ((PackageName, LibraryName), Map Version [a])
Nothing        -> [[a]] -> SearchResult [a]
forall a. [a] -> SearchResult a
Ambiguous ((((PackageName, LibraryName), Map Version [a]) -> [a])
-> [((PackageName, LibraryName), Map Version [a])] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a])
-> (((PackageName, LibraryName), Map Version [a]) -> [[a]])
-> ((PackageName, LibraryName), Map Version [a])
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Version [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems (Map Version [a] -> [[a]])
-> (((PackageName, LibraryName), Map Version [a])
    -> Map Version [a])
-> ((PackageName, LibraryName), Map Version [a])
-> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PackageName, LibraryName), Map Version [a]) -> Map Version [a]
forall a b. (a, b) -> b
snd) [((PackageName, LibraryName), Map Version [a])]
pkgss)
  where lname :: String
lname = ShowS
lowercase String
name

data SearchResult a = None | Unambiguous a | Ambiguous [a]

-- | Does a case-insensitive substring search by package name.
--
-- That is, all packages that contain the given string in their name.
--
searchByNameSubstring :: PackageIndex a -> String -> [a]
searchByNameSubstring :: forall a. PackageIndex a -> String -> [a]
searchByNameSubstring PackageIndex a
index String
searchterm =
  PackageIndex a -> (String -> Bool) -> [a]
forall a. PackageIndex a -> (String -> Bool) -> [a]
searchWithPredicate PackageIndex a
index (\String
n -> String
lsearchterm String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` ShowS
lowercase String
n)
  where lsearchterm :: String
lsearchterm = ShowS
lowercase String
searchterm

-- | @since 3.4.0.0
searchWithPredicate :: PackageIndex a -> (String -> Bool) -> [a]
searchWithPredicate :: forall a. PackageIndex a -> (String -> Bool) -> [a]
searchWithPredicate PackageIndex a
index String -> Bool
predicate =
  [ a
pkg
  -- Don't match internal packages
  | ((PackageName
pname, LibraryName
LMainLibName), Map Version [a]
pvers) <- Map (PackageName, LibraryName) (Map Version [a])
-> [((PackageName, LibraryName), Map Version [a])]
forall k a. Map k a -> [(k, a)]
Map.toList (PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
forall a.
PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
packageIdIndex PackageIndex a
index)
  , String -> Bool
predicate (PackageName -> String
unPackageName PackageName
pname)
  , [a]
pkgs <- Map Version [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems Map Version [a]
pvers
  , a
pkg <- [a]
pkgs ]

--
-- * Special queries
--

-- None of the stuff below depends on the internal representation of the index.
--

-- | Find if there are any cycles in the dependency graph. If there are no
-- cycles the result is @[]@.
--
-- This actually computes the strongly connected components. So it gives us a
-- list of groups of packages where within each group they all depend on each
-- other, directly or indirectly.
--
dependencyCycles :: PackageInstalled a => PackageIndex a -> [[a]]
dependencyCycles :: forall a. PackageInstalled a => PackageIndex a -> [[a]]
dependencyCycles PackageIndex a
index =
  [ [a]
vs | Graph.CyclicSCC [a]
vs <- [(a, UnitId, [UnitId])] -> [SCC a]
forall key node. Ord key => [(node, key, [key])] -> [SCC node]
Graph.stronglyConnComp [(a, UnitId, [UnitId])]
adjacencyList ]
  where
    adjacencyList :: [(a, UnitId, [UnitId])]
adjacencyList = [ (a
pkg, a -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId a
pkg, a -> [UnitId]
forall pkg. PackageInstalled pkg => pkg -> [UnitId]
installedDepends a
pkg)
                    | a
pkg <- PackageIndex a -> [a]
forall a. PackageIndex a -> [a]
allPackages PackageIndex a
index ]


-- | All packages that have immediate dependencies that are not in the index.
--
-- Returns such packages along with the dependencies that they're missing.
--
brokenPackages :: PackageInstalled a => PackageIndex a
               -> [(a, [UnitId])]
brokenPackages :: forall a. PackageInstalled a => PackageIndex a -> [(a, [UnitId])]
brokenPackages PackageIndex a
index =
  [ (a
pkg, [UnitId]
missing)
  | a
pkg  <- PackageIndex a -> [a]
forall a. PackageIndex a -> [a]
allPackages PackageIndex a
index
  , let missing :: [UnitId]
missing = [ UnitId
pkg' | UnitId
pkg' <- a -> [UnitId]
forall pkg. PackageInstalled pkg => pkg -> [UnitId]
installedDepends a
pkg
                         , Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (PackageIndex a -> UnitId -> Maybe a
forall a. PackageIndex a -> UnitId -> Maybe a
lookupUnitId PackageIndex a
index UnitId
pkg') ]
  , Bool -> Bool
not ([UnitId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnitId]
missing) ]

-- | Tries to take the transitive closure of the package dependencies.
--
-- If the transitive closure is complete then it returns that subset of the
-- index. Otherwise it returns the broken packages as in 'brokenPackages'.
--
-- * Note that if the result is @Right []@ it is because at least one of
-- the original given 'PackageId's do not occur in the index.
--
dependencyClosure :: InstalledPackageIndex
                  -> [UnitId]
                  -> Either (InstalledPackageIndex)
                            [(IPI.InstalledPackageInfo, [UnitId])]
dependencyClosure :: PackageIndex InstalledPackageInfo
-> [UnitId]
-> Either
     (PackageIndex InstalledPackageInfo)
     [(InstalledPackageInfo, [UnitId])]
dependencyClosure PackageIndex InstalledPackageInfo
index [UnitId]
pkgids0 = case PackageIndex InstalledPackageInfo
-> [UnitId]
-> [UnitId]
-> (PackageIndex InstalledPackageInfo, [UnitId])
closure PackageIndex InstalledPackageInfo
forall a. Monoid a => a
mempty [] [UnitId]
pkgids0 of
  (PackageIndex InstalledPackageInfo
completed, []) -> PackageIndex InstalledPackageInfo
-> Either
     (PackageIndex InstalledPackageInfo)
     [(InstalledPackageInfo, [UnitId])]
forall a b. a -> Either a b
Left PackageIndex InstalledPackageInfo
completed
  (PackageIndex InstalledPackageInfo
completed, [UnitId]
_)  -> [(InstalledPackageInfo, [UnitId])]
-> Either
     (PackageIndex InstalledPackageInfo)
     [(InstalledPackageInfo, [UnitId])]
forall a b. b -> Either a b
Right (PackageIndex InstalledPackageInfo
-> [(InstalledPackageInfo, [UnitId])]
forall a. PackageInstalled a => PackageIndex a -> [(a, [UnitId])]
brokenPackages PackageIndex InstalledPackageInfo
completed)
 where
    closure :: PackageIndex InstalledPackageInfo
-> [UnitId]
-> [UnitId]
-> (PackageIndex InstalledPackageInfo, [UnitId])
closure PackageIndex InstalledPackageInfo
completed [UnitId]
failed []             = (PackageIndex InstalledPackageInfo
completed, [UnitId]
failed)
    closure PackageIndex InstalledPackageInfo
completed [UnitId]
failed (UnitId
pkgid:[UnitId]
pkgids) = case PackageIndex InstalledPackageInfo
-> UnitId -> Maybe InstalledPackageInfo
forall a. PackageIndex a -> UnitId -> Maybe a
lookupUnitId PackageIndex InstalledPackageInfo
index UnitId
pkgid of
      Maybe InstalledPackageInfo
Nothing   -> PackageIndex InstalledPackageInfo
-> [UnitId]
-> [UnitId]
-> (PackageIndex InstalledPackageInfo, [UnitId])
closure PackageIndex InstalledPackageInfo
completed (UnitId
pkgidUnitId -> [UnitId] -> [UnitId]
forall a. a -> [a] -> [a]
:[UnitId]
failed) [UnitId]
pkgids
      Just InstalledPackageInfo
pkg  -> case PackageIndex InstalledPackageInfo
-> UnitId -> Maybe InstalledPackageInfo
forall a. PackageIndex a -> UnitId -> Maybe a
lookupUnitId PackageIndex InstalledPackageInfo
completed (InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstalledPackageInfo
pkg) of
        Just InstalledPackageInfo
_  -> PackageIndex InstalledPackageInfo
-> [UnitId]
-> [UnitId]
-> (PackageIndex InstalledPackageInfo, [UnitId])
closure PackageIndex InstalledPackageInfo
completed  [UnitId]
failed [UnitId]
pkgids
        Maybe InstalledPackageInfo
Nothing -> PackageIndex InstalledPackageInfo
-> [UnitId]
-> [UnitId]
-> (PackageIndex InstalledPackageInfo, [UnitId])
closure PackageIndex InstalledPackageInfo
completed' [UnitId]
failed [UnitId]
pkgids'
          where completed' :: PackageIndex InstalledPackageInfo
completed' = InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
insert InstalledPackageInfo
pkg PackageIndex InstalledPackageInfo
completed
                pkgids' :: [UnitId]
pkgids'    = InstalledPackageInfo -> [UnitId]
forall pkg. PackageInstalled pkg => pkg -> [UnitId]
installedDepends InstalledPackageInfo
pkg [UnitId] -> [UnitId] -> [UnitId]
forall a. [a] -> [a] -> [a]
++ [UnitId]
pkgids

-- | Takes the transitive closure of the packages reverse dependencies.
--
-- * The given 'PackageId's must be in the index.
--
reverseDependencyClosure :: PackageInstalled a => PackageIndex a
                         -> [UnitId]
                         -> [a]
reverseDependencyClosure :: forall a. PackageInstalled a => PackageIndex a -> [UnitId] -> [a]
reverseDependencyClosure PackageIndex a
index =
    (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
vertexToPkg
  ([Int] -> [a]) -> ([UnitId] -> [Int]) -> [UnitId] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree Int -> [Int]) -> [Tree Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree Int -> [Int]
forall a. Tree a -> [a]
Tree.flatten
  ([Tree Int] -> [Int])
-> ([UnitId] -> [Tree Int]) -> [UnitId] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> [Int] -> [Tree Int]
Graph.dfs Graph
reverseDepGraph
  ([Int] -> [Tree Int])
-> ([UnitId] -> [Int]) -> [UnitId] -> [Tree Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitId -> Int) -> [UnitId] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
forall {a}. a
noSuchPkgId (Maybe Int -> Int) -> (UnitId -> Maybe Int) -> UnitId -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> Maybe Int
pkgIdToVertex)

  where
    (Graph
depGraph, Int -> a
vertexToPkg, UnitId -> Maybe Int
pkgIdToVertex) = PackageIndex a -> (Graph, Int -> a, UnitId -> Maybe Int)
forall a.
PackageInstalled a =>
PackageIndex a -> (Graph, Int -> a, UnitId -> Maybe Int)
dependencyGraph PackageIndex a
index
    reverseDepGraph :: Graph
reverseDepGraph = Graph -> Graph
Graph.transposeG Graph
depGraph
    noSuchPkgId :: a
noSuchPkgId = String -> a
forall a. HasCallStack => String -> a
error String
"reverseDependencyClosure: package is not in the graph"

topologicalOrder :: PackageInstalled a => PackageIndex a -> [a]
topologicalOrder :: forall a. PackageInstalled a => PackageIndex a -> [a]
topologicalOrder PackageIndex a
index = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
toPkgId
                       ([Int] -> [a]) -> (Graph -> [Int]) -> Graph -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> [Int]
Graph.topSort
                       (Graph -> [a]) -> Graph -> [a]
forall a b. (a -> b) -> a -> b
$ Graph
graph
  where (Graph
graph, Int -> a
toPkgId, UnitId -> Maybe Int
_) = PackageIndex a -> (Graph, Int -> a, UnitId -> Maybe Int)
forall a.
PackageInstalled a =>
PackageIndex a -> (Graph, Int -> a, UnitId -> Maybe Int)
dependencyGraph PackageIndex a
index

reverseTopologicalOrder :: PackageInstalled a => PackageIndex a -> [a]
reverseTopologicalOrder :: forall a. PackageInstalled a => PackageIndex a -> [a]
reverseTopologicalOrder PackageIndex a
index = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
toPkgId
                              ([Int] -> [a]) -> (Graph -> [Int]) -> Graph -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> [Int]
Graph.topSort
                              (Graph -> [Int]) -> (Graph -> Graph) -> Graph -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> Graph
Graph.transposeG
                              (Graph -> [a]) -> Graph -> [a]
forall a b. (a -> b) -> a -> b
$ Graph
graph
  where (Graph
graph, Int -> a
toPkgId, UnitId -> Maybe Int
_) = PackageIndex a -> (Graph, Int -> a, UnitId -> Maybe Int)
forall a.
PackageInstalled a =>
PackageIndex a -> (Graph, Int -> a, UnitId -> Maybe Int)
dependencyGraph PackageIndex a
index

-- | Builds a graph of the package dependencies.
--
-- Dependencies on other packages that are not in the index are discarded.
-- You can check if there are any such dependencies with 'brokenPackages'.
--
dependencyGraph :: PackageInstalled a => PackageIndex a
                -> (Graph.Graph,
                    Graph.Vertex -> a,
                    UnitId -> Maybe Graph.Vertex)
dependencyGraph :: forall a.
PackageInstalled a =>
PackageIndex a -> (Graph, Int -> a, UnitId -> Maybe Int)
dependencyGraph PackageIndex a
index = (Graph
graph, Int -> a
vertex_to_pkg, UnitId -> Maybe Int
id_to_vertex)
  where
    graph :: Graph
graph = (Int, Int) -> [[Int]] -> Graph
forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (Int, Int)
bounds
              [ [ Int
v | Just Int
v <- (UnitId -> Maybe Int) -> [UnitId] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> Maybe Int
id_to_vertex (a -> [UnitId]
forall pkg. PackageInstalled pkg => pkg -> [UnitId]
installedDepends a
pkg) ]
              | a
pkg <- [a]
pkgs ]

    pkgs :: [a]
pkgs             = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((a -> PackageId) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId) (PackageIndex a -> [a]
forall a. PackageIndex a -> [a]
allPackages PackageIndex a
index)
    vertices :: [(UnitId, Int)]
vertices         = [UnitId] -> [Int] -> [(UnitId, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((a -> UnitId) -> [a] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map a -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId [a]
pkgs) [Int
0..]
    vertex_map :: Map UnitId Int
vertex_map       = [(UnitId, Int)] -> Map UnitId Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(UnitId, Int)]
vertices
    id_to_vertex :: UnitId -> Maybe Int
id_to_vertex UnitId
pid = UnitId -> Map UnitId Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UnitId
pid Map UnitId Int
vertex_map

    vertex_to_pkg :: Int -> a
vertex_to_pkg Int
vertex = Array Int a
pkgTable Array Int a -> Int -> a
forall i e. Ix i => Array i e -> i -> e
! Int
vertex

    pkgTable :: Array Int a
pkgTable   = (Int, Int) -> [a] -> Array Int a
forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (Int, Int)
bounds [a]
pkgs
    topBound :: Int
topBound = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
pkgs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    bounds :: (Int, Int)
bounds = (Int
0, Int
topBound)

-- | We maintain the invariant that, for any 'DepUniqueKey', there
-- is only one instance of the package in our database.
type DepUniqueKey = (PackageName, LibraryName, Map ModuleName OpenModule)

-- | Given a package index where we assume we want to use all the packages
-- (use 'dependencyClosure' if you need to get such a index subset) find out
-- if the dependencies within it use consistent versions of each package.
-- Return all cases where multiple packages depend on different versions of
-- some other package.
--
-- Each element in the result is a package name along with the packages that
-- depend on it and the versions they require. These are guaranteed to be
-- distinct.
--
dependencyInconsistencies :: InstalledPackageIndex
                             -- At DepUniqueKey...
                          -> [(DepUniqueKey,
                               -- There were multiple packages (BAD!)
                               [(UnitId,
                                 -- And here are the packages which
                                 -- immediately depended on it
                                 [IPI.InstalledPackageInfo])])]
dependencyInconsistencies :: PackageIndex InstalledPackageInfo
-> [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
dependencyInconsistencies PackageIndex InstalledPackageInfo
index = do
    (DepUniqueKey
dep_key, Map UnitId [InstalledPackageInfo]
insts_map) <- Map DepUniqueKey (Map UnitId [InstalledPackageInfo])
-> [(DepUniqueKey, Map UnitId [InstalledPackageInfo])]
forall k a. Map k a -> [(k, a)]
Map.toList Map DepUniqueKey (Map UnitId [InstalledPackageInfo])
inverseIndex
    let insts :: [(UnitId, [InstalledPackageInfo])]
insts = Map UnitId [InstalledPackageInfo]
-> [(UnitId, [InstalledPackageInfo])]
forall k a. Map k a -> [(k, a)]
Map.toList Map UnitId [InstalledPackageInfo]
insts_map
    Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([(UnitId, [InstalledPackageInfo])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(UnitId, [InstalledPackageInfo])]
insts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2)
    (DepUniqueKey, [(UnitId, [InstalledPackageInfo])])
-> [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (DepUniqueKey
dep_key, [(UnitId, [InstalledPackageInfo])]
insts)
  where
    inverseIndex :: Map DepUniqueKey (Map UnitId [IPI.InstalledPackageInfo])
    inverseIndex :: Map DepUniqueKey (Map UnitId [InstalledPackageInfo])
inverseIndex = (Map UnitId [InstalledPackageInfo]
 -> Map UnitId [InstalledPackageInfo]
 -> Map UnitId [InstalledPackageInfo])
-> [(DepUniqueKey, Map UnitId [InstalledPackageInfo])]
-> Map DepUniqueKey (Map UnitId [InstalledPackageInfo])
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (([InstalledPackageInfo]
 -> [InstalledPackageInfo] -> [InstalledPackageInfo])
-> Map UnitId [InstalledPackageInfo]
-> Map UnitId [InstalledPackageInfo]
-> Map UnitId [InstalledPackageInfo]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [InstalledPackageInfo]
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a. [a] -> [a] -> [a]
(++)) ([(DepUniqueKey, Map UnitId [InstalledPackageInfo])]
 -> Map DepUniqueKey (Map UnitId [InstalledPackageInfo]))
-> [(DepUniqueKey, Map UnitId [InstalledPackageInfo])]
-> Map DepUniqueKey (Map UnitId [InstalledPackageInfo])
forall a b. (a -> b) -> a -> b
$ do
        InstalledPackageInfo
pkg <- PackageIndex InstalledPackageInfo -> [InstalledPackageInfo]
forall a. PackageIndex a -> [a]
allPackages PackageIndex InstalledPackageInfo
index
        UnitId
dep_ipid <- InstalledPackageInfo -> [UnitId]
forall pkg. PackageInstalled pkg => pkg -> [UnitId]
installedDepends InstalledPackageInfo
pkg
        Just InstalledPackageInfo
dep <- [PackageIndex InstalledPackageInfo
-> UnitId -> Maybe InstalledPackageInfo
forall a. PackageIndex a -> UnitId -> Maybe a
lookupUnitId PackageIndex InstalledPackageInfo
index UnitId
dep_ipid]
        let dep_key :: DepUniqueKey
dep_key = (InstalledPackageInfo -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo
dep, InstalledPackageInfo -> LibraryName
IPI.sourceLibName InstalledPackageInfo
dep,
                       [(ModuleName, OpenModule)] -> Map ModuleName OpenModule
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (InstalledPackageInfo -> [(ModuleName, OpenModule)]
IPI.instantiatedWith InstalledPackageInfo
dep))
        (DepUniqueKey, Map UnitId [InstalledPackageInfo])
-> [(DepUniqueKey, Map UnitId [InstalledPackageInfo])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (DepUniqueKey
dep_key, UnitId
-> [InstalledPackageInfo] -> Map UnitId [InstalledPackageInfo]
forall k a. k -> a -> Map k a
Map.singleton UnitId
dep_ipid [InstalledPackageInfo
pkg])

-- | A rough approximation of GHC's module finder, takes a
-- 'InstalledPackageIndex' and turns it into a map from module names to their
-- source packages.  It's used to initialize the @build-deps@ field in @cabal
-- init@.
moduleNameIndex :: InstalledPackageIndex -> Map ModuleName [IPI.InstalledPackageInfo]
moduleNameIndex :: PackageIndex InstalledPackageInfo
-> Map ModuleName [InstalledPackageInfo]
moduleNameIndex PackageIndex InstalledPackageInfo
index =
  ([InstalledPackageInfo]
 -> [InstalledPackageInfo] -> [InstalledPackageInfo])
-> [(ModuleName, [InstalledPackageInfo])]
-> Map ModuleName [InstalledPackageInfo]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [InstalledPackageInfo]
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a. [a] -> [a] -> [a]
(++) ([(ModuleName, [InstalledPackageInfo])]
 -> Map ModuleName [InstalledPackageInfo])
-> [(ModuleName, [InstalledPackageInfo])]
-> Map ModuleName [InstalledPackageInfo]
forall a b. (a -> b) -> a -> b
$ do
    InstalledPackageInfo
pkg <- PackageIndex InstalledPackageInfo -> [InstalledPackageInfo]
forall a. PackageIndex a -> [a]
allPackages PackageIndex InstalledPackageInfo
index
    IPI.ExposedModule ModuleName
m Maybe OpenModule
reexport <- InstalledPackageInfo -> [ExposedModule]
IPI.exposedModules InstalledPackageInfo
pkg
    case Maybe OpenModule
reexport of
        Maybe OpenModule
Nothing -> (ModuleName, [InstalledPackageInfo])
-> [(ModuleName, [InstalledPackageInfo])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName
m, [InstalledPackageInfo
pkg])
        Just (OpenModuleVar ModuleName
_) -> []
        Just (OpenModule OpenUnitId
_ ModuleName
m') | ModuleName
m ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
m'   -> []
                                | Bool
otherwise -> (ModuleName, [InstalledPackageInfo])
-> [(ModuleName, [InstalledPackageInfo])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName
m', [InstalledPackageInfo
pkg])
        -- The heuristic is this: we want to prefer the original package
        -- which originally exported a module.  However, if a reexport
        -- also *renamed* the module (m /= m'), then we have to use the
        -- downstream package, since the upstream package has the wrong
        -- module name!