{-# 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
forall a. Eq a => PackageIndex a -> PackageIndex a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageIndex a -> PackageIndex a -> Bool
$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
Eq, 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
$cto :: forall a x. Rep (PackageIndex a) x -> PackageIndex a
$cfrom :: forall a x. PackageIndex a -> Rep (PackageIndex a) x
Generic, Int -> PackageIndex a -> ShowS
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
showList :: [PackageIndex a] -> ShowS
$cshowList :: forall a. Show a => [PackageIndex a] -> ShowS
show :: PackageIndex a -> String
$cshow :: forall a. Show a => PackageIndex a -> String
showsPrec :: Int -> PackageIndex a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PackageIndex a -> ShowS
Show, ReadPrec [PackageIndex a]
ReadPrec (PackageIndex a)
ReadS [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
readListPrec :: ReadPrec [PackageIndex a]
$creadListPrec :: forall a. Read a => ReadPrec [PackageIndex a]
readPrec :: ReadPrec (PackageIndex a)
$creadPrec :: forall a. Read a => ReadPrec (PackageIndex a)
readList :: ReadS [PackageIndex a]
$creadList :: forall a. Read a => ReadS [PackageIndex a]
readsPrec :: Int -> ReadS (PackageIndex a)
$creadsPrec :: forall a. Read a => Int -> ReadS (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  = forall a.
Map UnitId a
-> Map (PackageName, LibraryName) (Map Version [a])
-> PackageIndex a
PackageIndex forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty
  mappend :: PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
-> PackageIndex InstalledPackageInfo
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  --save one mappend with empty in the common case:
  mconcat :: [PackageIndex InstalledPackageInfo]
-> PackageIndex InstalledPackageInfo
mconcat [] = forall a. Monoid a => a
mempty
  mconcat [PackageIndex InstalledPackageInfo]
xs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Prelude.foldr1 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' forall a. Eq a => a -> a -> Bool
== [UnitId]
pnames'
 where
  pids' :: [UnitId]
pids' = forall a b. (a -> b) -> [a] -> [b]
map forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId (forall k a. Map k a -> [a]
Map.elems Map UnitId InstalledPackageInfo
pids)
  pnames' :: [UnitId]
pnames' = forall a. Ord a => [a] -> [a]
sort
     [ forall a. HasCallStack => Bool -> a -> a
assert Bool
pinstOk (forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstalledPackageInfo
pinst)
     | ((PackageName
pname, LibraryName
plib), Map Version [InstalledPackageInfo]
pvers)  <- forall k a. Map k a -> [(k, a)]
Map.toList Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames
     , let pversOk :: Bool
pversOk = Bool -> Bool
not (forall k a. Map k a -> Bool
Map.null Map Version [InstalledPackageInfo]
pvers)
     , (Version
pver,  [InstalledPackageInfo]
pinsts) <- forall a. HasCallStack => Bool -> a -> a
assert Bool
pversOk forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map Version [InstalledPackageInfo]
pvers
     , let pinsts' :: [InstalledPackageInfo]
pinsts'  = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId) [InstalledPackageInfo]
pinsts
           pinstsOk :: Bool
pinstsOk = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\[InstalledPackageInfo]
g -> forall (t :: * -> *) a. Foldable t => t a -> Int
length [InstalledPackageInfo]
g forall a. Eq a => a -> a -> Bool
== Int
1)
                          (forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId) [InstalledPackageInfo]
pinsts')
     , InstalledPackageInfo
pinst           <- forall a. HasCallStack => Bool -> a -> a
assert Bool
pinstsOk forall a b. (a -> b) -> a -> b
$ [InstalledPackageInfo]
pinsts'
     , let pinstOk :: Bool
pinstOk = forall pkg. Package pkg => pkg -> PackageName
packageName    InstalledPackageInfo
pinst forall a. Eq a => a -> a -> Bool
== PackageName
pname
                  Bool -> Bool -> Bool
&& forall pkg. Package pkg => pkg -> Version
packageVersion InstalledPackageInfo
pinst forall a. Eq a => a -> a -> Bool
== Version
pver
                  Bool -> Bool -> Bool
&& InstalledPackageInfo -> LibraryName
IPI.sourceLibName  InstalledPackageInfo
pinst 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 = forall a. HasCallStack => Bool -> a -> a
assert (WithCallStack (PackageIndex InstalledPackageInfo -> Bool)
invariant PackageIndex InstalledPackageInfo
index) PackageIndex InstalledPackageInfo
index
  where index :: PackageIndex InstalledPackageInfo
index = 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)
mkPackageIndex Map UnitId InstalledPackageInfo
pids ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map
  (PackageName, LibraryName)
  (Map Version (NonEmpty InstalledPackageInfo))
pnames)
  where
    pids :: Map UnitId InstalledPackageInfo
pids      = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstalledPackageInfo
pkg, InstalledPackageInfo
pkg) | InstalledPackageInfo
pkg <- [InstalledPackageInfo]
pkgs ]
    pnames :: Map
  (PackageName, LibraryName)
  (Map Version (NonEmpty InstalledPackageInfo))
pnames    =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo -> LibraryName
IPI.sourceLibName (forall a. NonEmpty a -> a
NE.head NonEmpty InstalledPackageInfo
pkgsN), Map Version (NonEmpty InstalledPackageInfo)
pvers)
        | NonEmpty InstalledPackageInfo
pkgsN <- forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating  (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo -> LibraryName
IPI.sourceLibName))
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy  (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo -> LibraryName
IPI.sourceLibName forall pkg. Package pkg => pkg -> Version
packageVersion))
                 forall a b. (a -> b) -> a -> b
$ [InstalledPackageInfo]
pkgs
        , let pvers :: Map Version (NonEmpty InstalledPackageInfo)
pvers =
                forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [ (forall pkg. Package pkg => pkg -> Version
packageVersion (forall a. NonEmpty a -> a
NE.head NonEmpty InstalledPackageInfo
pkgsNV),
                   forall a. (a -> a -> Bool) -> NonEmpty a -> NonEmpty a
NE.nubBy (forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId) (forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty InstalledPackageInfo
pkgsNV))
                | NonEmpty InstalledPackageInfo
pkgsNV <- forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating 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)
mkPackageIndex (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)
                 (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (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 forall a. [a] -> [a] -> [a]
++ ([InstalledPackageInfo]
xs [InstalledPackageInfo]
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
\\ [InstalledPackageInfo]
ys)
    \\ :: [InstalledPackageInfo]
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
(\\) = forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
deleteFirstsBy (forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating 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)
mkPackageIndex Map UnitId InstalledPackageInfo
pids' Map (PackageName, LibraryName) (Map Version [InstalledPackageInfo])
pnames'

  where
    pids' :: Map UnitId InstalledPackageInfo
pids'   = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (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 =
      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)
                     (forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo
pkg, InstalledPackageInfo -> LibraryName
IPI.sourceLibName InstalledPackageInfo
pkg)
                     (forall k a. k -> a -> Map k a
Map.singleton (forall pkg. Package pkg => pkg -> Version
packageVersion InstalledPackageInfo
pkg) [InstalledPackageInfo
pkg])

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

    insertPackageInstance :: [InstalledPackageInfo] -> [InstalledPackageInfo]
insertPackageInstance [InstalledPackageInfo]
pkgs =
      InstalledPackageInfo
pkg forall a. a -> [a] -> [a]
: forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy (forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating 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 forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey (\UnitId
_ 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)
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 =
      forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update (forall {pkg}.
Package pkg =>
pkg
-> Map Version [InstalledPackageInfo]
-> Maybe (Map Version [InstalledPackageInfo])
deletePkgVersion InstalledPackageInfo
spkgid) (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 forall k a. Map k a -> Bool
Map.null Map Version [InstalledPackageInfo]
m then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Map Version [InstalledPackageInfo]
m)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update [InstalledPackageInfo] -> Maybe [InstalledPackageInfo]
deletePkgInstance (forall pkg. Package pkg => pkg -> Version
packageVersion pkg
spkgid)

    deletePkgInstance :: [InstalledPackageInfo] -> Maybe [InstalledPackageInfo]
deletePkgInstance =
        (\[InstalledPackageInfo]
xs -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InstalledPackageInfo]
xs then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just [InstalledPackageInfo]
xs)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> a -> [a] -> [a]
List.deleteBy (\InstalledPackageInfo
_ InstalledPackageInfo
pkg -> forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstalledPackageInfo
pkg forall a. Eq a => a -> a -> Bool
== UnitId
ipkgid) 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 forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (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 forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (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)
mkPackageIndex
                     (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId)) Map UnitId InstalledPackageInfo
pids [InstalledPackageInfo]
pkgs)
                     (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 =
      forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update forall {a}. Map Version a -> Maybe (Map Version a)
deletePkgVersion (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 forall k a. Map k a -> Bool
Map.null Map Version a
m then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Map Version a
m)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (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 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)
mkPackageIndex
                     (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId)) Map UnitId InstalledPackageInfo
pids
                             (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall k a. Map k a -> [a]
Map.elems Map Version [InstalledPackageInfo]
pvers)))
                     (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 = forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall k a. Map k a -> [a]
Map.elems Map Version [a]
pvers))
  | ((PackageName
pkgname, LibraryName
LMainLibName), Map Version [a]
pvers) <- forall k a. Map k a -> [(k, a)]
Map.toList (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 =
  [ (forall pkg. Package pkg => pkg -> PackageId
packageId a
ipkg, [a]
ipkgs)
  | ((PackageName
_, LibraryName
LMainLibName), Map Version [a]
pvers) <- forall k a. Map k a -> [(k, a)]
Map.toList (forall a.
PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
packageIdIndex PackageIndex a
index)
  , ipkgs :: [a]
ipkgs@(a
ipkg:[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 =
  [ ((forall pkg. Package pkg => pkg -> PackageId
packageId a
ipkg, LibraryName
ln), [a]
ipkgs)
  | ((PackageName
_, LibraryName
ln), Map Version [a]
pvers) <- forall k a. Map k a -> [(k, a)]
Map.toList (forall a.
PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
packageIdIndex PackageIndex a
index)
  , ipkgs :: [a]
ipkgs@(a
ipkg:[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 = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UnitId
uid (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 =
    forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ComponentId -> UnitId
newSimpleUnitId ComponentId
cid) (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 forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgid, LibraryName
LMainLibName) (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 forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (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 forall a. PackageIndex a -> PackageId -> [a]
lookupSourcePackageId PackageIndex a
index PackageId
pkgid  of
    []    -> forall a. Maybe a
Nothing
    [a
pkg] -> forall a. a -> Maybe a
Just a
pkg
    [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 forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName
name, LibraryName
LMainLibName) (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  -> 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 forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName
name, LibraryName
libn) (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) <- 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' = forall a. (a -> Bool) -> [a] -> [a]
filter InstalledPackageInfo -> Bool
eligible [InstalledPackageInfo]
pkgs
                  -- Enforce the invariant
                  , Bool -> Bool
not (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
|| 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]
_) <- forall k a. Map k a -> [(k, a)]
Map.toList (forall a.
PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
packageIdIndex PackageIndex a
index)
              , ShowS
lowercase (PackageName -> String
unPackageName PackageName
pname) forall a. Eq a => a -> a -> Bool
== String
lname ] of
    []               -> forall a. SearchResult a
None
    [((PackageName, LibraryName)
_,Map Version [a]
pvers)]      -> forall a. a -> SearchResult a
Unambiguous (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall k a. Map k a -> [a]
Map.elems Map Version [a]
pvers))
    [((PackageName, LibraryName), Map Version [a])]
pkgss            -> case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> PackageName
mkPackageName String
name forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [((PackageName, LibraryName), Map Version [a])]
pkgss of
      Just ((PackageName, LibraryName)
_,Map Version [a]
pvers) -> forall a. a -> SearchResult a
Unambiguous (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall k a. Map k a -> [a]
Map.elems Map Version [a]
pvers))
      Maybe ((PackageName, LibraryName), Map Version [a])
Nothing        -> forall a. [a] -> SearchResult a
Ambiguous (forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
  forall a. PackageIndex a -> (String -> Bool) -> [a]
searchWithPredicate PackageIndex a
index (\String
n -> String
lsearchterm 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) <- forall k a. Map k a -> [(k, a)]
Map.toList (forall a.
PackageIndex a -> Map (PackageName, LibraryName) (Map Version [a])
packageIdIndex PackageIndex a
index)
  , String -> Bool
predicate (PackageName -> String
unPackageName PackageName
pname)
  , [a]
pkgs <- 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 <- forall key node. Ord key => [(node, key, [key])] -> [SCC node]
Graph.stronglyConnComp [(a, UnitId, [UnitId])]
adjacencyList ]
  where
    adjacencyList :: [(a, UnitId, [UnitId])]
adjacencyList = [ (a
pkg, forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId a
pkg, forall pkg. PackageInstalled pkg => pkg -> [UnitId]
installedDepends a
pkg)
                    | a
pkg <- 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  <- forall a. PackageIndex a -> [a]
allPackages PackageIndex a
index
  , let missing :: [UnitId]
missing = [ UnitId
pkg' | UnitId
pkg' <- forall pkg. PackageInstalled pkg => pkg -> [UnitId]
installedDepends a
pkg
                         , forall a. Maybe a -> Bool
isNothing (forall a. PackageIndex a -> UnitId -> Maybe a
lookupUnitId PackageIndex a
index UnitId
pkg') ]
  , Bool -> Bool
not (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 forall a. Monoid a => a
mempty [] [UnitId]
pkgids0 of
  (PackageIndex InstalledPackageInfo
completed, []) -> forall a b. a -> Either a b
Left PackageIndex InstalledPackageInfo
completed
  (PackageIndex InstalledPackageInfo
completed, [UnitId]
_)  -> forall a b. b -> Either a b
Right (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 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
pkgidforall a. a -> [a] -> [a]
:[UnitId]
failed) [UnitId]
pkgids
      Just InstalledPackageInfo
pkg  -> case forall a. PackageIndex a -> UnitId -> Maybe a
lookupUnitId PackageIndex InstalledPackageInfo
completed (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'    = forall pkg. PackageInstalled pkg => pkg -> [UnitId]
installedDepends InstalledPackageInfo
pkg 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 =
    forall a b. (a -> b) -> [a] -> [b]
map Int -> a
vertexToPkg
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [a]
Tree.flatten
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> [Int] -> [Tree Int]
Graph.dfs Graph
reverseDepGraph
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
noSuchPkgId forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> Maybe Int
pkgIdToVertex)

  where
    (Graph
depGraph, Int -> a
vertexToPkg, UnitId -> Maybe Int
pkgIdToVertex) = 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 = 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 = forall a b. (a -> b) -> [a] -> [b]
map Int -> a
toPkgId
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> [Int]
Graph.topSort
                       forall a b. (a -> b) -> a -> b
$ Graph
graph
  where (Graph
graph, Int -> a
toPkgId, 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 = forall a b. (a -> b) -> [a] -> [b]
map Int -> a
toPkgId
                              forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> [Int]
Graph.topSort
                              forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> Graph
Graph.transposeG
                              forall a b. (a -> b) -> a -> b
$ Graph
graph
  where (Graph
graph, Int -> a
toPkgId, 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 = forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (Int, Int)
bounds
              [ [ Int
v | Just Int
v <- forall a b. (a -> b) -> [a] -> [b]
map UnitId -> Maybe Int
id_to_vertex (forall pkg. PackageInstalled pkg => pkg -> [UnitId]
installedDepends a
pkg) ]
              | a
pkg <- [a]
pkgs ]

    pkgs :: [a]
pkgs             = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall pkg. Package pkg => pkg -> PackageId
packageId) (forall a. PackageIndex a -> [a]
allPackages PackageIndex a
index)
    vertices :: [(UnitId, Int)]
vertices         = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId [a]
pkgs) [Int
0..]
    vertex_map :: Map UnitId Int
vertex_map       = 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 = 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 forall i e. Ix i => Array i e -> i -> e
! Int
vertex

    pkgTable :: Array Int a
pkgTable   = forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (Int, Int)
bounds [a]
pkgs
    topBound :: Int
topBound = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
pkgs 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) <- forall k a. Map k a -> [(k, a)]
Map.toList Map DepUniqueKey (Map UnitId [InstalledPackageInfo])
inverseIndex
    let insts :: [(UnitId, [InstalledPackageInfo])]
insts = forall k a. Map k a -> [(k, a)]
Map.toList Map UnitId [InstalledPackageInfo]
insts_map
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(UnitId, [InstalledPackageInfo])]
insts forall a. Ord a => a -> a -> Bool
>= Int
2)
    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 = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. [a] -> [a] -> [a]
(++)) forall a b. (a -> b) -> a -> b
$ do
        InstalledPackageInfo
pkg <- forall a. PackageIndex a -> [a]
allPackages PackageIndex InstalledPackageInfo
index
        UnitId
dep_ipid <- forall pkg. PackageInstalled pkg => pkg -> [UnitId]
installedDepends InstalledPackageInfo
pkg
        Just InstalledPackageInfo
dep <- [forall a. PackageIndex a -> UnitId -> Maybe a
lookupUnitId PackageIndex InstalledPackageInfo
index UnitId
dep_ipid]
        let dep_key :: DepUniqueKey
dep_key = (forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo
dep, InstalledPackageInfo -> LibraryName
IPI.sourceLibName InstalledPackageInfo
dep,
                       forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (InstalledPackageInfo -> [(ModuleName, OpenModule)]
IPI.instantiatedWith InstalledPackageInfo
dep))
        forall (m :: * -> *) a. Monad m => a -> m a
return (DepUniqueKey
dep_key, 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 =
  forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++) forall a b. (a -> b) -> a -> b
$ do
    InstalledPackageInfo
pkg <- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName
m, [InstalledPackageInfo
pkg])
        Just (OpenModuleVar ModuleName
_) -> []
        Just (OpenModule OpenUnitId
_ ModuleName
m') | ModuleName
m forall a. Eq a => a -> a -> Bool
== ModuleName
m'   -> []
                                | Bool
otherwise -> 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!