{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Solver.Types.PackageIndex
-- Copyright   :  (c) David Himmelstrup 2005,
--                    Bjorn Bringert 2007,
--                    Duncan Coutts 2008
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- An index of packages.
--
module Distribution.Solver.Types.PackageIndex (
  -- * Package index data type
  PackageIndex,

  -- * Creating an index
  fromList,

  -- * Updates
  merge,
  override,
  insert,
  deletePackageName,
  deletePackageId,
  deleteDependency,

  -- * Queries

  -- ** Precise lookups
  elemByPackageId,
  elemByPackageName,
  lookupPackageName,
  lookupPackageId,
  lookupDependency,

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

  -- ** Bulk queries
  allPackages,
  allPackagesByName,
  ) where

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

import qualified Data.Map as Map
import Data.List (isInfixOf)
import qualified Data.List.NonEmpty as NE

import Distribution.Client.Utils.Assertion ( expensiveAssert )
import Distribution.Package
         ( PackageName, unPackageName, PackageIdentifier(..)
         , Package(..), packageName, packageVersion )
import Distribution.Version
         ( VersionRange, withinRange )
import Distribution.Simple.Utils
         ( lowercase )

import qualified Prelude (foldr1)

-- | The collection of information about packages from one or more 'PackageDB's.
--
-- It can be searched efficiently by package name and version.
--
newtype PackageIndex pkg = PackageIndex
  -- This index package names to all the package records matching that package
  -- name case-sensitively. It includes all versions.
  --
  -- This allows us to find all versions satisfying a dependency.
  -- Most queries are a map lookup followed by a linear scan of the bucket.
  --
  (Map PackageName [pkg])

  deriving (PackageIndex pkg -> PackageIndex pkg -> Bool
(PackageIndex pkg -> PackageIndex pkg -> Bool)
-> (PackageIndex pkg -> PackageIndex pkg -> Bool)
-> Eq (PackageIndex pkg)
forall pkg. Eq pkg => PackageIndex pkg -> PackageIndex pkg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageIndex pkg -> PackageIndex pkg -> Bool
$c/= :: forall pkg. Eq pkg => PackageIndex pkg -> PackageIndex pkg -> Bool
== :: PackageIndex pkg -> PackageIndex pkg -> Bool
$c== :: forall pkg. Eq pkg => PackageIndex pkg -> PackageIndex pkg -> Bool
Eq, Int -> PackageIndex pkg -> ShowS
[PackageIndex pkg] -> ShowS
PackageIndex pkg -> String
(Int -> PackageIndex pkg -> ShowS)
-> (PackageIndex pkg -> String)
-> ([PackageIndex pkg] -> ShowS)
-> Show (PackageIndex pkg)
forall pkg. Show pkg => Int -> PackageIndex pkg -> ShowS
forall pkg. Show pkg => [PackageIndex pkg] -> ShowS
forall pkg. Show pkg => PackageIndex pkg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageIndex pkg] -> ShowS
$cshowList :: forall pkg. Show pkg => [PackageIndex pkg] -> ShowS
show :: PackageIndex pkg -> String
$cshow :: forall pkg. Show pkg => PackageIndex pkg -> String
showsPrec :: Int -> PackageIndex pkg -> ShowS
$cshowsPrec :: forall pkg. Show pkg => Int -> PackageIndex pkg -> ShowS
Show, ReadPrec [PackageIndex pkg]
ReadPrec (PackageIndex pkg)
Int -> ReadS (PackageIndex pkg)
ReadS [PackageIndex pkg]
(Int -> ReadS (PackageIndex pkg))
-> ReadS [PackageIndex pkg]
-> ReadPrec (PackageIndex pkg)
-> ReadPrec [PackageIndex pkg]
-> Read (PackageIndex pkg)
forall pkg. Read pkg => ReadPrec [PackageIndex pkg]
forall pkg. Read pkg => ReadPrec (PackageIndex pkg)
forall pkg. Read pkg => Int -> ReadS (PackageIndex pkg)
forall pkg. Read pkg => ReadS [PackageIndex pkg]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PackageIndex pkg]
$creadListPrec :: forall pkg. Read pkg => ReadPrec [PackageIndex pkg]
readPrec :: ReadPrec (PackageIndex pkg)
$creadPrec :: forall pkg. Read pkg => ReadPrec (PackageIndex pkg)
readList :: ReadS [PackageIndex pkg]
$creadList :: forall pkg. Read pkg => ReadS [PackageIndex pkg]
readsPrec :: Int -> ReadS (PackageIndex pkg)
$creadsPrec :: forall pkg. Read pkg => Int -> ReadS (PackageIndex pkg)
Read, a -> PackageIndex b -> PackageIndex a
(a -> b) -> PackageIndex a -> PackageIndex b
(forall a b. (a -> b) -> PackageIndex a -> PackageIndex b)
-> (forall a b. a -> PackageIndex b -> PackageIndex a)
-> Functor PackageIndex
forall a b. a -> PackageIndex b -> PackageIndex a
forall a b. (a -> b) -> PackageIndex a -> PackageIndex b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PackageIndex b -> PackageIndex a
$c<$ :: forall a b. a -> PackageIndex b -> PackageIndex a
fmap :: (a -> b) -> PackageIndex a -> PackageIndex b
$cfmap :: forall a b. (a -> b) -> PackageIndex a -> PackageIndex b
Functor, (forall x. PackageIndex pkg -> Rep (PackageIndex pkg) x)
-> (forall x. Rep (PackageIndex pkg) x -> PackageIndex pkg)
-> Generic (PackageIndex pkg)
forall x. Rep (PackageIndex pkg) x -> PackageIndex pkg
forall x. PackageIndex pkg -> Rep (PackageIndex pkg) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall pkg x. Rep (PackageIndex pkg) x -> PackageIndex pkg
forall pkg x. PackageIndex pkg -> Rep (PackageIndex pkg) x
$cto :: forall pkg x. Rep (PackageIndex pkg) x -> PackageIndex pkg
$cfrom :: forall pkg x. PackageIndex pkg -> Rep (PackageIndex pkg) x
Generic)
--FIXME: the Functor instance here relies on no package id changes

instance Package pkg => Semigroup (PackageIndex pkg) where
  <> :: PackageIndex pkg -> PackageIndex pkg -> PackageIndex pkg
(<>) = PackageIndex pkg -> PackageIndex pkg -> PackageIndex pkg
forall pkg.
Package pkg =>
PackageIndex pkg -> PackageIndex pkg -> PackageIndex pkg
merge

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

instance Binary pkg => Binary (PackageIndex pkg)

invariant :: Package pkg => PackageIndex pkg -> Bool
invariant :: PackageIndex pkg -> Bool
invariant (PackageIndex Map PackageName [pkg]
m) = ((PackageName, [pkg]) -> Bool) -> [(PackageName, [pkg])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((PackageName -> [pkg] -> Bool) -> (PackageName, [pkg]) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PackageName -> [pkg] -> Bool
forall a. Package a => PackageName -> [a] -> Bool
goodBucket) (Map PackageName [pkg] -> [(PackageName, [pkg])]
forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName [pkg]
m)
  where
    goodBucket :: PackageName -> [a] -> Bool
goodBucket PackageName
_    [] = Bool
False
    goodBucket PackageName
name (a
pkg0:[a]
pkgs0) = PackageIdentifier -> [a] -> Bool
forall a. Package a => PackageIdentifier -> [a] -> Bool
check (a -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId a
pkg0) [a]
pkgs0
      where
        check :: PackageIdentifier -> [a] -> Bool
check PackageIdentifier
pkgid []          = PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
pkgid PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
name
        check PackageIdentifier
pkgid (a
pkg':[a]
pkgs) = PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
pkgid PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
name
                               Bool -> Bool -> Bool
&& PackageIdentifier
pkgid PackageIdentifier -> PackageIdentifier -> Bool
forall a. Ord a => a -> a -> Bool
< PackageIdentifier
pkgid'
                               Bool -> Bool -> Bool
&& PackageIdentifier -> [a] -> Bool
check PackageIdentifier
pkgid' [a]
pkgs
          where pkgid' :: PackageIdentifier
pkgid' = a -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId a
pkg'

--
-- * Internal helpers
--

mkPackageIndex :: Package pkg => Map PackageName [pkg] -> PackageIndex pkg
mkPackageIndex :: Map PackageName [pkg] -> PackageIndex pkg
mkPackageIndex Map PackageName [pkg]
index = Bool -> PackageIndex pkg -> PackageIndex pkg
forall a. Bool -> a -> a
expensiveAssert (PackageIndex pkg -> Bool
forall pkg. Package pkg => PackageIndex pkg -> Bool
invariant (Map PackageName [pkg] -> PackageIndex pkg
forall pkg. Map PackageName [pkg] -> PackageIndex pkg
PackageIndex Map PackageName [pkg]
index))
                                         (Map PackageName [pkg] -> PackageIndex pkg
forall pkg. Map PackageName [pkg] -> PackageIndex pkg
PackageIndex Map PackageName [pkg]
index)

internalError :: String -> a
internalError :: String -> a
internalError String
name = String -> a
forall a. HasCallStack => String -> a
error (String
"PackageIndex." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": internal error")

-- | Lookup a name in the index to get all packages that match that name
-- case-sensitively.
--
lookup :: PackageIndex pkg -> PackageName -> [pkg]
lookup :: PackageIndex pkg -> PackageName -> [pkg]
lookup (PackageIndex Map PackageName [pkg]
m) PackageName
name = [pkg] -> Maybe [pkg] -> [pkg]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [pkg] -> [pkg]) -> Maybe [pkg] -> [pkg]
forall a b. (a -> b) -> a -> b
$ PackageName -> Map PackageName [pkg] -> Maybe [pkg]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Map PackageName [pkg]
m

--
-- * Construction
--

-- | Build an index out of a bunch of packages.
--
-- If there are duplicates, later ones mask earlier ones.
--
fromList :: Package pkg => [pkg] -> PackageIndex pkg
fromList :: [pkg] -> PackageIndex pkg
fromList [pkg]
pkgs = Map PackageName [pkg] -> PackageIndex pkg
forall pkg.
Package pkg =>
Map PackageName [pkg] -> PackageIndex pkg
mkPackageIndex
              (Map PackageName [pkg] -> PackageIndex pkg)
-> ([(PackageName, [pkg])] -> Map PackageName [pkg])
-> [(PackageName, [pkg])]
-> PackageIndex pkg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([pkg] -> [pkg]) -> Map PackageName [pkg] -> Map PackageName [pkg]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [pkg] -> [pkg]
fixBucket
              (Map PackageName [pkg] -> Map PackageName [pkg])
-> ([(PackageName, [pkg])] -> Map PackageName [pkg])
-> [(PackageName, [pkg])]
-> Map PackageName [pkg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([pkg] -> [pkg] -> [pkg])
-> [(PackageName, [pkg])] -> Map PackageName [pkg]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [pkg] -> [pkg] -> [pkg]
forall a. [a] -> [a] -> [a]
(++)
              ([(PackageName, [pkg])] -> PackageIndex pkg)
-> [(PackageName, [pkg])] -> PackageIndex pkg
forall a b. (a -> b) -> a -> b
$ [ (pkg -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName pkg
pkg, [pkg
pkg])
                | pkg
pkg <- [pkg]
pkgs ]
  where
    fixBucket :: [pkg] -> [pkg]
fixBucket = -- out of groups of duplicates, later ones mask earlier ones
                -- but Map.fromListWith (++) constructs groups in reverse order
                (NonEmpty pkg -> pkg) -> [NonEmpty pkg] -> [pkg]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty pkg -> pkg
forall a. NonEmpty a -> a
NE.head
                -- Eq instance for PackageIdentifier is wrong, so use Ord:
              ([NonEmpty pkg] -> [pkg])
-> ([pkg] -> [NonEmpty pkg]) -> [pkg] -> [pkg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (pkg -> pkg -> Bool) -> [pkg] -> [NonEmpty pkg]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (\pkg
a pkg
b -> Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== (pkg -> PackageIdentifier) -> pkg -> pkg -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing pkg -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId pkg
a pkg
b)
                -- relies on sortBy being a stable sort so we
                -- can pick consistently among duplicates
              ([pkg] -> [NonEmpty pkg])
-> ([pkg] -> [pkg]) -> [pkg] -> [NonEmpty pkg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (pkg -> pkg -> Ordering) -> [pkg] -> [pkg]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((pkg -> PackageIdentifier) -> pkg -> pkg -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing pkg -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId)

--
-- * Updates
--

-- | Merge two indexes.
--
-- Packages from the second mask packages of the same exact name
-- (case-sensitively) from the first.
--
merge :: Package pkg => PackageIndex pkg -> PackageIndex pkg -> PackageIndex pkg
merge :: PackageIndex pkg -> PackageIndex pkg -> PackageIndex pkg
merge i1 :: PackageIndex pkg
i1@(PackageIndex Map PackageName [pkg]
m1) i2 :: PackageIndex pkg
i2@(PackageIndex Map PackageName [pkg]
m2) =
  Bool -> PackageIndex pkg -> PackageIndex pkg
forall a. Bool -> a -> a
expensiveAssert (PackageIndex pkg -> Bool
forall pkg. Package pkg => PackageIndex pkg -> Bool
invariant PackageIndex pkg
i1 Bool -> Bool -> Bool
&& PackageIndex pkg -> Bool
forall pkg. Package pkg => PackageIndex pkg -> Bool
invariant PackageIndex pkg
i2) (PackageIndex pkg -> PackageIndex pkg)
-> PackageIndex pkg -> PackageIndex pkg
forall a b. (a -> b) -> a -> b
$
    Map PackageName [pkg] -> PackageIndex pkg
forall pkg.
Package pkg =>
Map PackageName [pkg] -> PackageIndex pkg
mkPackageIndex (([pkg] -> [pkg] -> [pkg])
-> Map PackageName [pkg]
-> Map PackageName [pkg]
-> Map PackageName [pkg]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [pkg] -> [pkg] -> [pkg]
forall pkg. Package pkg => [pkg] -> [pkg] -> [pkg]
mergeBuckets Map PackageName [pkg]
m1 Map PackageName [pkg]
m2)


-- | Elements in the second list mask those in the first.
mergeBuckets :: Package pkg => [pkg] -> [pkg] -> [pkg]
mergeBuckets :: [pkg] -> [pkg] -> [pkg]
mergeBuckets []     [pkg]
ys     = [pkg]
ys
mergeBuckets [pkg]
xs     []     = [pkg]
xs
mergeBuckets xs :: [pkg]
xs@(pkg
x:[pkg]
xs') ys :: [pkg]
ys@(pkg
y:[pkg]
ys') =
      case pkg -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId pkg
x PackageIdentifier -> PackageIdentifier -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` pkg -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId pkg
y of
        Ordering
GT -> pkg
y pkg -> [pkg] -> [pkg]
forall a. a -> [a] -> [a]
: [pkg] -> [pkg] -> [pkg]
forall pkg. Package pkg => [pkg] -> [pkg] -> [pkg]
mergeBuckets [pkg]
xs  [pkg]
ys'
        Ordering
EQ -> pkg
y pkg -> [pkg] -> [pkg]
forall a. a -> [a] -> [a]
: [pkg] -> [pkg] -> [pkg]
forall pkg. Package pkg => [pkg] -> [pkg] -> [pkg]
mergeBuckets [pkg]
xs' [pkg]
ys'
        Ordering
LT -> pkg
x pkg -> [pkg] -> [pkg]
forall a. a -> [a] -> [a]
: [pkg] -> [pkg] -> [pkg]
forall pkg. Package pkg => [pkg] -> [pkg] -> [pkg]
mergeBuckets [pkg]
xs' [pkg]
ys

-- | Override-merge of two indexes.
--
-- Packages from the second mask packages of the same exact name
-- (case-sensitively) from the first.
--
override :: Package pkg => PackageIndex pkg -> PackageIndex pkg -> PackageIndex pkg
override :: PackageIndex pkg -> PackageIndex pkg -> PackageIndex pkg
override i1 :: PackageIndex pkg
i1@(PackageIndex Map PackageName [pkg]
m1) i2 :: PackageIndex pkg
i2@(PackageIndex Map PackageName [pkg]
m2) =
  Bool -> PackageIndex pkg -> PackageIndex pkg
forall a. Bool -> a -> a
expensiveAssert (PackageIndex pkg -> Bool
forall pkg. Package pkg => PackageIndex pkg -> Bool
invariant PackageIndex pkg
i1 Bool -> Bool -> Bool
&& PackageIndex pkg -> Bool
forall pkg. Package pkg => PackageIndex pkg -> Bool
invariant PackageIndex pkg
i2) (PackageIndex pkg -> PackageIndex pkg)
-> PackageIndex pkg -> PackageIndex pkg
forall a b. (a -> b) -> a -> b
$
    Map PackageName [pkg] -> PackageIndex pkg
forall pkg.
Package pkg =>
Map PackageName [pkg] -> PackageIndex pkg
mkPackageIndex (([pkg] -> [pkg] -> [pkg])
-> Map PackageName [pkg]
-> Map PackageName [pkg]
-> Map PackageName [pkg]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (\[pkg]
_l [pkg]
r -> [pkg]
r) Map PackageName [pkg]
m1 Map PackageName [pkg]
m2)

-- | Inserts a single package into the index.
--
-- This is equivalent to (but slightly quicker than) using 'mappend' or
-- 'merge' with a singleton index.
--
insert :: Package pkg => pkg -> PackageIndex pkg -> PackageIndex pkg
insert :: pkg -> PackageIndex pkg -> PackageIndex pkg
insert pkg
pkg (PackageIndex Map PackageName [pkg]
index) = Map PackageName [pkg] -> PackageIndex pkg
forall pkg.
Package pkg =>
Map PackageName [pkg] -> PackageIndex pkg
mkPackageIndex (Map PackageName [pkg] -> PackageIndex pkg)
-> Map PackageName [pkg] -> PackageIndex pkg
forall a b. (a -> b) -> a -> b
$
  ([pkg] -> [pkg] -> [pkg])
-> PackageName
-> [pkg]
-> Map PackageName [pkg]
-> Map PackageName [pkg]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\[pkg]
_ -> [pkg] -> [pkg]
insertNoDup) (pkg -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName pkg
pkg) [pkg
pkg] Map PackageName [pkg]
index
  where
    pkgid :: PackageIdentifier
pkgid = pkg -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId pkg
pkg
    insertNoDup :: [pkg] -> [pkg]
insertNoDup []                = [pkg
pkg]
    insertNoDup pkgs :: [pkg]
pkgs@(pkg
pkg':[pkg]
pkgs') = case PackageIdentifier -> PackageIdentifier -> Ordering
forall a. Ord a => a -> a -> Ordering
compare PackageIdentifier
pkgid (pkg -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId pkg
pkg') of
      Ordering
LT -> pkg
pkg  pkg -> [pkg] -> [pkg]
forall a. a -> [a] -> [a]
: [pkg]
pkgs
      Ordering
EQ -> pkg
pkg  pkg -> [pkg] -> [pkg]
forall a. a -> [a] -> [a]
: [pkg]
pkgs'
      Ordering
GT -> pkg
pkg' pkg -> [pkg] -> [pkg]
forall a. a -> [a] -> [a]
: [pkg] -> [pkg]
insertNoDup [pkg]
pkgs'

-- | Internal delete helper.
--
delete :: Package pkg => PackageName -> (pkg -> Bool) -> PackageIndex pkg
       -> PackageIndex pkg
delete :: PackageName
-> (pkg -> Bool) -> PackageIndex pkg -> PackageIndex pkg
delete PackageName
name pkg -> Bool
p (PackageIndex Map PackageName [pkg]
index) = Map PackageName [pkg] -> PackageIndex pkg
forall pkg.
Package pkg =>
Map PackageName [pkg] -> PackageIndex pkg
mkPackageIndex (Map PackageName [pkg] -> PackageIndex pkg)
-> Map PackageName [pkg] -> PackageIndex pkg
forall a b. (a -> b) -> a -> b
$
  ([pkg] -> Maybe [pkg])
-> PackageName -> Map PackageName [pkg] -> Map PackageName [pkg]
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update [pkg] -> Maybe [pkg]
filterBucket PackageName
name Map PackageName [pkg]
index
  where
    filterBucket :: [pkg] -> Maybe [pkg]
filterBucket = [pkg] -> Maybe [pkg]
forall a. [a] -> Maybe [a]
deleteEmptyBucket
                 ([pkg] -> Maybe [pkg]) -> ([pkg] -> [pkg]) -> [pkg] -> Maybe [pkg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (pkg -> Bool) -> [pkg] -> [pkg]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (pkg -> Bool) -> pkg -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pkg -> Bool
p)
    deleteEmptyBucket :: [a] -> Maybe [a]
deleteEmptyBucket []        = Maybe [a]
forall a. Maybe a
Nothing
    deleteEmptyBucket [a]
remaining = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
remaining

-- | Removes a single package from the index.
--
deletePackageId :: Package pkg => PackageIdentifier -> PackageIndex pkg
                -> PackageIndex pkg
deletePackageId :: PackageIdentifier -> PackageIndex pkg -> PackageIndex pkg
deletePackageId PackageIdentifier
pkgid =
  PackageName
-> (pkg -> Bool) -> PackageIndex pkg -> PackageIndex pkg
forall pkg.
Package pkg =>
PackageName
-> (pkg -> Bool) -> PackageIndex pkg -> PackageIndex pkg
delete (PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
pkgid) (\pkg
pkg -> pkg -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId pkg
pkg PackageIdentifier -> PackageIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
== PackageIdentifier
pkgid)

-- | Removes all packages with this (case-sensitive) name from the index.
--
deletePackageName :: Package pkg => PackageName -> PackageIndex pkg
                  -> PackageIndex pkg
deletePackageName :: PackageName -> PackageIndex pkg -> PackageIndex pkg
deletePackageName PackageName
name =
  PackageName
-> (pkg -> Bool) -> PackageIndex pkg -> PackageIndex pkg
forall pkg.
Package pkg =>
PackageName
-> (pkg -> Bool) -> PackageIndex pkg -> PackageIndex pkg
delete PackageName
name (\pkg
pkg -> pkg -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName pkg
pkg PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
name)

-- | Removes all packages satisfying this dependency from the index.
deleteDependency :: Package pkg
                 => PackageName -> VersionRange -> PackageIndex pkg
                 -> PackageIndex pkg
deleteDependency :: PackageName -> VersionRange -> PackageIndex pkg -> PackageIndex pkg
deleteDependency PackageName
name VersionRange
verstionRange =
  PackageName
-> (pkg -> Bool) -> PackageIndex pkg -> PackageIndex pkg
forall pkg.
Package pkg =>
PackageName
-> (pkg -> Bool) -> PackageIndex pkg -> PackageIndex pkg
delete PackageName
name (\pkg
pkg -> pkg -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion pkg
pkg Version -> VersionRange -> Bool
`withinRange` VersionRange
verstionRange)

--
-- * Bulk queries
--

-- | Get all the packages from the index.
--
allPackages :: PackageIndex pkg -> [pkg]
allPackages :: PackageIndex pkg -> [pkg]
allPackages (PackageIndex Map PackageName [pkg]
m) = [[pkg]] -> [pkg]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Map PackageName [pkg] -> [[pkg]]
forall k a. Map k a -> [a]
Map.elems Map PackageName [pkg]
m)

-- | Get all the packages from the index.
--
-- They are grouped by package name, case-sensitively.
--
allPackagesByName :: PackageIndex pkg -> [[pkg]]
allPackagesByName :: PackageIndex pkg -> [[pkg]]
allPackagesByName (PackageIndex Map PackageName [pkg]
m) = Map PackageName [pkg] -> [[pkg]]
forall k a. Map k a -> [a]
Map.elems Map PackageName [pkg]
m

--
-- * Lookups
--

elemByPackageId :: Package pkg => PackageIndex pkg -> PackageIdentifier -> Bool
elemByPackageId :: PackageIndex pkg -> PackageIdentifier -> Bool
elemByPackageId PackageIndex pkg
index = Maybe pkg -> Bool
forall a. Maybe a -> Bool
isJust (Maybe pkg -> Bool)
-> (PackageIdentifier -> Maybe pkg) -> PackageIdentifier -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIndex pkg -> PackageIdentifier -> Maybe pkg
forall pkg.
Package pkg =>
PackageIndex pkg -> PackageIdentifier -> Maybe pkg
lookupPackageId PackageIndex pkg
index

elemByPackageName :: Package pkg => PackageIndex pkg -> PackageName -> Bool
elemByPackageName :: PackageIndex pkg -> PackageName -> Bool
elemByPackageName PackageIndex pkg
index = Bool -> Bool
not (Bool -> Bool) -> (PackageName -> Bool) -> PackageName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [pkg] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([pkg] -> Bool) -> (PackageName -> [pkg]) -> PackageName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIndex pkg -> PackageName -> [pkg]
forall pkg. Package pkg => PackageIndex pkg -> PackageName -> [pkg]
lookupPackageName PackageIndex pkg
index


-- | Does a lookup by package id (name & version).
--
-- Since multiple package DBs mask each other case-sensitively by package name,
-- then we get back at most one package.
--
lookupPackageId :: Package pkg => PackageIndex pkg -> PackageIdentifier
                -> Maybe pkg
lookupPackageId :: PackageIndex pkg -> PackageIdentifier -> Maybe pkg
lookupPackageId PackageIndex pkg
index PackageIdentifier
pkgid =
  case [ pkg
pkg | pkg
pkg <- PackageIndex pkg -> PackageName -> [pkg]
forall pkg. PackageIndex pkg -> PackageName -> [pkg]
lookup PackageIndex pkg
index (PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
pkgid)
             , pkg -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId pkg
pkg PackageIdentifier -> PackageIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
== PackageIdentifier
pkgid ] of
    []    -> Maybe pkg
forall a. Maybe a
Nothing
    [pkg
pkg] -> pkg -> Maybe pkg
forall a. a -> Maybe a
Just pkg
pkg
    [pkg]
_     -> String -> Maybe pkg
forall a. String -> a
internalError String
"lookupPackageIdentifier"

-- | Does a case-sensitive search by package name.
--
lookupPackageName :: Package pkg => PackageIndex pkg -> PackageName -> [pkg]
lookupPackageName :: PackageIndex pkg -> PackageName -> [pkg]
lookupPackageName PackageIndex pkg
index PackageName
name =
  [ pkg
pkg | pkg
pkg <- PackageIndex pkg -> PackageName -> [pkg]
forall pkg. PackageIndex pkg -> PackageName -> [pkg]
lookup PackageIndex pkg
index PackageName
name
        , pkg -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName pkg
pkg PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
name ]

-- | Does a case-sensitive search by 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.
--
lookupDependency :: Package pkg
                 => PackageIndex pkg
                 -> PackageName -> VersionRange
                 -> [pkg]
lookupDependency :: PackageIndex pkg -> PackageName -> VersionRange -> [pkg]
lookupDependency PackageIndex pkg
index PackageName
name VersionRange
versionRange =
  [ pkg
pkg | pkg
pkg <- PackageIndex pkg -> PackageName -> [pkg]
forall pkg. PackageIndex pkg -> PackageName -> [pkg]
lookup PackageIndex pkg
index PackageName
name
        , pkg -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName pkg
pkg PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
name
        , pkg -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion pkg
pkg Version -> VersionRange -> Bool
`withinRange` VersionRange
versionRange ]

--
-- * 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 pkg
             -> String -> [(PackageName, [pkg])]
searchByName :: PackageIndex pkg -> String -> [(PackageName, [pkg])]
searchByName (PackageIndex Map PackageName [pkg]
m) String
name =
    [ (PackageName, [pkg])
pkgs
    | pkgs :: (PackageName, [pkg])
pkgs@(PackageName
pname,[pkg]
_) <- Map PackageName [pkg] -> [(PackageName, [pkg])]
forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName [pkg]
m
    , ShowS
lowercase (PackageName -> String
unPackageName PackageName
pname) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
lname ]
  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 pkg
                      -> String -> [(PackageName, [pkg])]
searchByNameSubstring :: PackageIndex pkg -> String -> [(PackageName, [pkg])]
searchByNameSubstring PackageIndex pkg
index String
searchterm =
    PackageIndex pkg -> (String -> Bool) -> [(PackageName, [pkg])]
forall pkg.
PackageIndex pkg -> (String -> Bool) -> [(PackageName, [pkg])]
searchWithPredicate PackageIndex pkg
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

searchWithPredicate :: PackageIndex pkg
                    -> (String -> Bool) -> [(PackageName, [pkg])]
searchWithPredicate :: PackageIndex pkg -> (String -> Bool) -> [(PackageName, [pkg])]
searchWithPredicate (PackageIndex Map PackageName [pkg]
m) String -> Bool
predicate =
    [ (PackageName, [pkg])
pkgs
    | pkgs :: (PackageName, [pkg])
pkgs@(PackageName
pname, [pkg]
_) <- Map PackageName [pkg] -> [(PackageName, [pkg])]
forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName [pkg]
m
    , String -> Bool
predicate (PackageName -> String
unPackageName PackageName
pname)
    ]