PackageIndex.hs 10.3 KB
Newer Older
1 2
-----------------------------------------------------------------------------
-- |
3
-- Module      :  Distribution.Simple.PackageIndex
4 5 6 7 8 9 10 11 12
-- Copyright   :  (c) David Himmelstrup 2005,
--                    Bjorn Bringert 2007,
--                    Duncan Coutts 2008
-- License     :  BSD-like
--
-- Maintainer  :  Duncan Coutts <duncan@haskell.org>
-- Stability   :  provisional
-- Portability :  portable
--
13
-- An index of packages.
14
-----------------------------------------------------------------------------
15 16 17
module Distribution.Simple.PackageIndex (
  -- * Package index data type
  PackageIndex,
18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38

  -- * Creating the index
  fromList,

  -- * Merging indexes
  merge,

  -- * Queries

  -- ** Precise lookups
  lookupPackageId,
  lookupDependency,

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

  -- ** Bulk queries
  allPackages,
  allPackagesByName,
39 40 41 42 43

  -- ** Special queries
  brokenPackages,
  dependencyClosure,
  dependencyInconsistencies
44 45 46 47 48 49 50 51
  ) where

import Prelude hiding (lookup)
import Control.Exception (assert)
import qualified Data.Map as Map
import Data.Map (Map)
import Data.List (nubBy, group, sort, groupBy, sortBy, find)
import Data.Monoid (Monoid(..))
52
import Data.Maybe (isNothing)
53

54
import Distribution.Package
55
         ( PackageIdentifier, Package(..), packageName, packageVersion
56 57 58
         , Dependency(Dependency), PackageFixedDeps(..) )
import Distribution.Version
         ( Version, withinRange )
59 60 61 62 63 64
import Distribution.Simple.Utils (lowercase, equating, comparing, isInfixOf)

-- | The collection of information about packages from one or more 'PackageDB's.
--
-- It can be searched effeciently by package name and version.
--
65
data Package pkg => PackageIndex pkg = PackageIndex
Duncan Coutts's avatar
Duncan Coutts committed
66
  -- This index maps lower case package names to all the
67 68 69 70 71 72 73
  -- 'InstalledPackageInfo' records matching that package name
  -- case-insensitively. It includes all versions.
  --
  -- This allows us to do case sensitive or insensitive lookups, and to find
  -- all versions satisfying a dependency, all by varying how we filter. So
  -- most queries will do a map lookup followed by a linear scan of the bucket.
  --
74
  (Map String [pkg])
75 76 77

  deriving (Show, Read)

78 79
instance Package pkg => Monoid (PackageIndex pkg) where
  mempty  = PackageIndex (Map.empty)
80 81 82 83 84
  mappend = merge
  --save one mappend with empty in the common case:
  mconcat [] = mempty
  mconcat xs = foldr1 mappend xs

85 86
invariant :: Package pkg => PackageIndex pkg -> Bool
invariant (PackageIndex m) = all (uncurry goodBucket) (Map.toList m)
87 88 89
  where goodBucket name pkgs =
             lowercase name == name
          && not (null pkgs)
90
          && all ((lowercase name==) . lowercase . packageName) pkgs
91
--          && all (\pkg -> pkgInfoId pkg
92 93
--                       == (packageId . packageDescription . pkgDesc) pkg) pkgs
          && distinct (map packageId pkgs)
94 95 96 97

        distinct = all ((==1). length) . group . sort

internalError :: String -> a
98
internalError name = error ("PackageIndex." ++ name ++ ": internal error")
99 100 101 102

-- | When building or merging we have to eliminate duplicates of the exact
-- same package name and version (case-sensitively) to preserve the invariant.
--
103 104
stripDups :: Package pkg => [pkg] -> [pkg]
stripDups = nubBy (equating packageId)
105 106 107 108

-- | Lookup a name in the index to get all packages that match that name
-- case-insensitively.
--
109 110
lookup :: Package pkg => PackageIndex pkg -> String -> [pkg]
lookup index@(PackageIndex m) name =
111 112 113 114 115
  assert (invariant index) $
  case Map.lookup (lowercase name) m of
    Nothing   -> []
    Just pkgs -> pkgs

116
-- | Build an index out of a bunch of 'Package's.
117 118 119
--
-- If there are duplicates, earlier ones mask later one.
--
120
fromList :: Package pkg => [pkg] -> PackageIndex pkg
121
fromList pkgs =
122
  let index = (PackageIndex . Map.map stripDups . Map.fromListWith (++))
123
                [ let key = (lowercase . packageName) pkg
124 125 126 127 128 129 130 131 132
                   in (key, [pkg])
                | pkg <- pkgs ]
   in assert (invariant index) index

-- | Merge two indexes.
--
-- Packages from the first mask packages of the same exact name
-- (case-sensitively) from the second.
--
133 134
merge :: Package pkg => PackageIndex pkg -> PackageIndex pkg -> PackageIndex pkg
merge i1@(PackageIndex m1) i2@(PackageIndex m2) =
135
  assert (invariant i1 && invariant i2) $
136
  let index = PackageIndex (Map.unionWith mergeBuckets m1 m2)
137 138 139 140 141 142
   in assert (invariant index) index

  where mergeBuckets pkgs1 pkgs2 = stripDups (pkgs1 ++ pkgs2)

-- | Get all the packages from the index.
--
143 144
allPackages :: Package pkg => PackageIndex pkg -> [pkg]
allPackages (PackageIndex m) = concat (Map.elems m)
145 146 147 148 149

-- | Get all the packages from the index.
--
-- They are grouped by package name, case-sensitively.
--
150 151 152
allPackagesByName :: Package pkg => PackageIndex pkg -> [[pkg]]
allPackagesByName (PackageIndex m) = concatMap groupByName (Map.elems m)
  where groupByName :: Package pkg => [pkg] -> [[pkg]]
153 154
        groupByName = groupBy (equating packageName)
                    . sortBy (comparing packageName)
155 156 157 158 159 160 161 162 163 164 165 166 167

-- | Does a case-insensitive search by package name.
--
-- If there is only one package that compares case-insentiviely to this name
-- then the search is unambiguous and we get back all versions of that package.
-- If several match case-insentiviely but one matches exactly then it is also
-- unambiguous.
--
-- If however several match case-insentiviely 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.
--
168
searchByName :: Package pkg => PackageIndex pkg -> String -> SearchResult [pkg]
169
searchByName index name =
170 171
  case groupBy (equating  packageName)
     . sortBy  (comparing packageName)
172 173 174
     $ lookup index name of
    []     -> None
    [pkgs] -> Unambiguous pkgs
175
    pkgss  -> case find ((name==) . packageName . head) pkgss of
176 177 178 179 180 181 182 183 184
                Just pkgs -> Unambiguous pkgs
                Nothing   -> Ambiguous   pkgss

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.
--
185 186
searchByNameSubstring :: Package pkg => PackageIndex pkg -> String -> [pkg]
searchByNameSubstring (PackageIndex m) searchterm =
187 188 189 190 191 192 193 194 195 196 197
  [ pkg
  | (name, pkgs) <- Map.toList m
  , searchterm' `isInfixOf` name
  , pkg <- pkgs ]
  where searchterm' = lowercase searchterm

-- | 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.
--
198
lookupPackageId :: Package pkg => PackageIndex pkg -> PackageIdentifier -> Maybe pkg
199
lookupPackageId index pkgid =
200
  case [ pkg | pkg <- lookup index (packageName pkgid)
201
             , packageId pkg == pkgid ] of
202 203 204 205 206 207 208 209 210
    []    -> Nothing
    [pkg] -> Just pkg
    _     -> internalError "lookupPackageIdentifier"

-- | 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.
--
211
lookupDependency :: Package pkg => PackageIndex pkg -> Dependency -> [pkg]
212
lookupDependency index (Dependency name versionRange) =
213
  [ pkg | pkg <- lookup index name
214 215
        , packageName pkg == name
        , packageVersion pkg `withinRange` versionRange ]
216 217 218 219 220

-- | All packages that have depends that are not in the index.
--
-- Returns such packages along with the depends that they're missing.
--
221 222 223
brokenPackages :: PackageFixedDeps pkg
               => PackageIndex pkg
               -> [(pkg, [PackageIdentifier])]
224 225 226
brokenPackages index =
  [ (pkg, missing)
  | pkg  <- allPackages index
227
  , let missing = [ pkg' | pkg' <- depends pkg
228 229 230 231 232 233 234 235 236 237 238
                         , isNothing (lookupPackageId index pkg') ]
  , not (null missing) ]

-- | Tries to take the transative closure of the package dependencies.
--
-- If the transative closure is complete then it returns that subset of the
-- index. Otherwise it returns the broken packages as in 'brokenPackages'.
--
-- * Note that if any of the result is @Right []@ it is because at least one of
-- the original given 'PackageIdentifier's do not occur in the index.
--
239 240
dependencyClosure :: PackageFixedDeps pkg
                  => PackageIndex pkg
241
                  -> [PackageIdentifier]
242 243
                  -> Either (PackageIndex pkg)
                            [(pkg, [PackageIdentifier])]
244 245 246 247 248 249 250 251 252
dependencyClosure index pkgids0 = case closure [] [] pkgids0 of
  (completed, []) -> Left  $ fromList completed
  (completed, _)  -> Right $ brokenPackages (fromList completed)

  where
    closure completed failed [] = (completed, failed)
    closure completed failed (pkgid:pkgids) = case lookupPackageId index pkgid of
      Nothing  -> closure completed (pkgid:failed) pkgids
               -- TODO: use more effecient test here:
253
      Just pkg | packageId pkg `elem` map packageId completed
254 255
               -> closure      completed   failed  pkgids
               | otherwise
256
               -> closure (pkg:completed)  failed  pkgids'
257
               where pkgids' = depends pkg ++ pkgids
258 259 260 261 262 263 264 265 266 267 268

-- | 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.
--
269 270 271
dependencyInconsistencies :: PackageFixedDeps pkg
                          => PackageIndex pkg
                          -> pkg
272
                          -> [(String, [(PackageIdentifier, Version)])]
273
dependencyInconsistencies index topPkg =
274 275 276 277 278
  [ (name, inconsistencies)
  | (name, uses) <- Map.toList inverseIndex
  , let inconsistencies = duplicatesBy uses
  , not (null inconsistencies) ]

279
  where inverseIndex = Map.fromListWith (++)
280
          [ (packageName dep, [(packageId pkg, packageVersion dep)])
281 282
          | pkg <- topPkg : allPackages index
          , dep <- depends pkg ]
283 284 285 286 287 288

        duplicatesBy = (\groups -> if length groups == 1
                                     then []
                                     else concat groups)
                     . groupBy (equating snd)
                     . sortBy (comparing snd)