IndexUtils.hs 23.1 KB
Newer Older
1
{-# LANGUAGE CPP #-}
2
{-# LANGUAGE RecordWildCards #-}
3
{-# LANGUAGE BangPatterns #-}
4
5
-----------------------------------------------------------------------------
-- |
6
-- Module      :  Distribution.Client.IndexUtils
7
8
9
-- Copyright   :  (c) Duncan Coutts 2008
-- License     :  BSD-like
--
Duncan Coutts's avatar
Duncan Coutts committed
10
-- Maintainer  :  duncan@community.haskell.org
11
12
13
14
15
-- Stability   :  provisional
-- Portability :  portable
--
-- Extra utils related to the package indexes.
-----------------------------------------------------------------------------
16
module Distribution.Client.IndexUtils (
17
  getIndexFileAge,
18
  getInstalledPackages,
19
  getSourcePackages,
20

21
  Index(..),
22
  PackageEntry(..),
23
24
  parsePackageIndex,
  updateRepoIndexCache,
25
  updatePackageIndexCacheFile,
26
  readCacheStrict,
27
28

  BuildTreeRefType(..), refTypeFromTypeCode, typeCodeFromRefType
29
30
  ) where

Duncan Coutts's avatar
Duncan Coutts committed
31
import qualified Distribution.Client.Tar as Tar
32
import Distribution.Client.Types
33

34
import Distribution.Package
35
         ( PackageId, PackageIdentifier(..), PackageName(..)
36
         , Package(..), packageVersion, packageName
37
         , Dependency(Dependency) )
38
import Distribution.Client.PackageIndex (PackageIndex)
refold's avatar
refold committed
39
import qualified Distribution.Client.PackageIndex      as PackageIndex
40
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
41
import qualified Distribution.PackageDescription.Parse as PackageDesc.Parse
42
43
import Distribution.PackageDescription
         ( GenericPackageDescription )
44
import Distribution.PackageDescription.Parse
45
         ( parsePackageDescription )
46
47
48
49
50
51
import Distribution.Simple.Compiler
         ( Compiler, PackageDBStack )
import Distribution.Simple.Program
         ( ProgramConfiguration )
import qualified Distribution.Simple.Configure as Configure
         ( getInstalledPackages )
52
53
import Distribution.ParseUtils
         ( ParseResult(..) )
54
import Distribution.Version
55
         ( Version(Version), intersectVersionRanges )
56
import Distribution.Text
57
         ( display, simpleParse )
58
import Distribution.Verbosity
59
         ( Verbosity, normal, lessVerbose )
60
import Distribution.Simple.Utils
61
         ( die, warn, info, fromUTF8, ignoreBOM )
Edsko de Vries's avatar
Edsko de Vries committed
62
63
import Distribution.Client.Setup
         ( RepoContext(..) )
64

65
import Data.Char   (isAlphaNum)
66
import Data.Maybe  (mapMaybe, catMaybes, maybeToList)
67
import Data.List   (isPrefixOf)
68
#if !MIN_VERSION_base(4,8,0)
69
import Data.Monoid (Monoid(..))
70
#endif
71
import qualified Data.Map as Map
Łukasz Dąbek's avatar
Łukasz Dąbek committed
72
import Control.Monad (when, liftM)
73
import Control.Exception (evaluate)
74
75
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
76
import qualified Data.ByteString.Char8 as BSS
77
import Data.ByteString.Lazy (ByteString)
78
import Distribution.Client.GZipUtils (maybeDecompress)
79
80
import Distribution.Client.Utils ( byteStringToFilePath
                                 , tryFindAddSourcePackageDesc )
81
import Distribution.Compat.Exception (catchIO)
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
82
import Distribution.Client.Compat.Time (getFileAge, getModTime)
83
import System.Directory (doesFileExist, doesDirectoryExist)
Edsko de Vries's avatar
Edsko de Vries committed
84
85
import System.FilePath
         ( (</>), takeExtension, replaceExtension, splitDirectories, normalise )
86
87
import System.FilePath.Posix as FilePath.Posix
         ( takeFileName )
88
import System.IO
89
import System.IO.Unsafe (unsafeInterleaveIO)
90
91
import System.IO.Error (isDoesNotExistError)

92

bardur.arantsson's avatar
bardur.arantsson committed
93
-- | Reduced-verbosity version of 'Configure.getInstalledPackages'
94
95
getInstalledPackages :: Verbosity -> Compiler
                     -> PackageDBStack -> ProgramConfiguration
96
                     -> IO InstalledPackageIndex
97
getInstalledPackages verbosity comp packageDbs conf =
98
    Configure.getInstalledPackages verbosity' comp packageDbs conf
99
  where
100
101
    verbosity'  = lessVerbose verbosity

102
103
104
------------------------------------------------------------------------
-- Reading the source package index
--
105

106
107
108
-- | Read a repository index from disk, from the local files specified by
-- a list of 'Repo's.
--
109
-- All the 'SourcePackage's are marked as having come from the appropriate
110
111
112
-- 'Repo'.
--
-- This is a higher level wrapper used internally in cabal-install.
Edsko de Vries's avatar
Edsko de Vries committed
113
114
getSourcePackages :: Verbosity -> RepoContext -> IO SourcePackageDb
getSourcePackages verbosity repoCtxt | null (repoContextRepos repoCtxt) = do
115
116
  warn verbosity $ "No remote package servers have been specified. Usually "
                ++ "you would have one specified in the config file."
117
  return SourcePackageDb {
118
119
120
    packageIndex       = mempty,
    packagePreferences = mempty
  }
Edsko de Vries's avatar
Edsko de Vries committed
121
getSourcePackages verbosity repoCtxt = do
122
  info verbosity "Reading available packages..."
Edsko de Vries's avatar
Edsko de Vries committed
123
  pkgss <- mapM (\r -> readRepoIndex verbosity repoCtxt r) (repoContextRepos repoCtxt)
124
  let (pkgs, prefs) = mconcat pkgss
Duncan Coutts's avatar
Duncan Coutts committed
125
      prefs' = Map.fromListWith intersectVersionRanges
126
                 [ (name, range) | Dependency name range <- prefs ]
127
128
  _ <- evaluate pkgs
  _ <- evaluate prefs'
129
  return SourcePackageDb {
130
131
132
    packageIndex       = pkgs,
    packagePreferences = prefs'
  }
133

134
135
136
137
138
139
140
readCacheStrict :: Verbosity -> Index -> (PackageEntry -> pkg) -> IO ([pkg], [Dependency])
readCacheStrict verbosity index mkPkg = do
    updateRepoIndexCache verbosity index
    cache <- liftM readIndexCache $ BSS.readFile (cacheFile index)
    withFile (indexFile index) ReadMode $ \indexHnd ->
      packageListFromCache mkPkg indexHnd cache ReadPackageIndexStrict

141
142
143
-- | Read a repository index from disk, from the local file specified by
-- the 'Repo'.
--
144
-- All the 'SourcePackage's are marked as having come from the given 'Repo'.
145
146
147
--
-- This is a higher level wrapper used internally in cabal-install.
--
Edsko de Vries's avatar
Edsko de Vries committed
148
readRepoIndex :: Verbosity -> RepoContext -> Repo
149
              -> IO (PackageIndex SourcePackage, [Dependency])
Edsko de Vries's avatar
Edsko de Vries committed
150
readRepoIndex verbosity repoCtxt repo =
151
  handleNotFound $ do
152
    warnIfIndexIsOld =<< getIndexFileAge repo
Edsko de Vries's avatar
Edsko de Vries committed
153
154
    updateRepoIndexCache verbosity (RepoIndex repoCtxt repo)
    readPackageIndexCacheFile mkAvailablePackage (RepoIndex repoCtxt repo)
Duncan Coutts's avatar
Duncan Coutts committed
155

156
  where
157
    mkAvailablePackage pkgEntry =
158
      SourcePackage {
159
        packageInfoId      = pkgid,
160
161
        packageDescription = packageDesc pkgEntry,
        packageSource      = case pkgEntry of
162
163
          NormalPackage _ _ _ _       -> RepoTarballPackage repo pkgid Nothing
          BuildTreeRef  _  _ _ path _ -> LocalUnpackedPackage path,
164
165
166
        packageDescrOverride = case pkgEntry of
          NormalPackage _ _ pkgtxt _ -> Just pkgtxt
          _                          -> Nothing
167
      }
168
169
      where
        pkgid = packageId pkgEntry
170

refold's avatar
refold committed
171
    handleNotFound action = catchIO action $ \e -> if isDoesNotExistError e
172
      then do
Edsko de Vries's avatar
Edsko de Vries committed
173
174
175
        case repo of
          RepoRemote{..} -> warn verbosity $
               "The package list for '" ++ remoteRepoName repoRemote
176
            ++ "' does not exist. Run 'cabal update' to download it."
Edsko de Vries's avatar
Edsko de Vries committed
177
178
          RepoLocal{..} -> warn verbosity $
               "The package list for the local repo '" ++ repoLocalDir
179
180
181
182
            ++ "' is missing. The repo is invalid."
        return mempty
      else ioError e

183
    isOldThreshold = 15 --days
184
    warnIfIndexIsOld dt = do
Edsko de Vries's avatar
Edsko de Vries committed
185
186
187
      when (dt >= isOldThreshold) $ case repo of
        RepoRemote{..} -> warn verbosity $
             "The package list for '" ++ remoteRepoName repoRemote
188
          ++ "' is " ++ shows (floor dt :: Int) " days old.\nRun "
189
          ++ "'cabal update' to get the latest list of available packages."
Edsko de Vries's avatar
Edsko de Vries committed
190
        RepoLocal{..} -> return ()
191

192
193
194
195
196
197

-- | Return the age of the index file in days (as a Double).
getIndexFileAge :: Repo -> IO Double
getIndexFileAge repo = getFileAge $ repoLocalDir repo </> "00-index.tar"


198
199
200
-- | It is not necessary to call this, as the cache will be updated when the
-- index is read normally. However you can do the work earlier if you like.
--
201
202
203
204
205
206
207
208
updateRepoIndexCache :: Verbosity -> Index -> IO ()
updateRepoIndexCache verbosity index =
    whenCacheOutOfDate index $ do
      updatePackageIndexCacheFile verbosity index

whenCacheOutOfDate :: Index -> IO () -> IO ()
whenCacheOutOfDate index action = do
  exists <- doesFileExist $ cacheFile index
209
210
211
  if not exists
    then action
    else do
212
213
214
      indexTime <- getModTime $ indexFile index
      cacheTime <- getModTime $ cacheFile index
      when (indexTime > cacheTime) action
215
216
217
218

------------------------------------------------------------------------
-- Reading the index file
--
219

220
-- | An index entry is either a normal package, or a local build tree reference.
refold's avatar
refold committed
221
222
data PackageEntry =
  NormalPackage  PackageId GenericPackageDescription ByteString BlockNo
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
  | BuildTreeRef BuildTreeRefType
                 PackageId GenericPackageDescription FilePath   BlockNo

-- | A build tree reference is either a link or a snapshot.
data BuildTreeRefType = SnapshotRef | LinkRef
                      deriving Eq

refTypeFromTypeCode :: Tar.TypeCode -> BuildTreeRefType
refTypeFromTypeCode t
  | t == Tar.buildTreeRefTypeCode      = LinkRef
  | t == Tar.buildTreeSnapshotTypeCode = SnapshotRef
  | otherwise                          =
    error "Distribution.Client.IndexUtils.refTypeFromTypeCode: unknown type code"

typeCodeFromRefType :: BuildTreeRefType -> Tar.TypeCode
typeCodeFromRefType LinkRef     = Tar.buildTreeRefTypeCode
typeCodeFromRefType SnapshotRef = Tar.buildTreeSnapshotTypeCode
240
241

instance Package PackageEntry where
242
243
  packageId (NormalPackage  pkgid _ _ _) = pkgid
  packageId (BuildTreeRef _ pkgid _ _ _) = pkgid
244
245

packageDesc :: PackageEntry -> GenericPackageDescription
246
247
packageDesc (NormalPackage  _ descr _ _) = descr
packageDesc (BuildTreeRef _ _ descr _ _) = descr
248

249
250
251
-- | Parse an uncompressed \"00-index.tar\" repository index file represented
-- as a 'ByteString'.
--
Łukasz Dąbek's avatar
Łukasz Dąbek committed
252
253
254

data PackageOrDep = Pkg PackageEntry | Dep Dependency

255
256
257
258
259
260
261
262
263
264
-- | Read @00-index.tar.gz@ and extract @.cabal@ and @preferred-versions@ files
--
-- We read the index using 'Tar.read', which gives us a lazily constructed
-- 'TarEntries'. We translate it to a list of entries using  'tarEntriesList',
-- which preserves the lazy nature of 'TarEntries', and finally 'concatMap' a
-- function over this to translate it to a list of IO actions returning
-- 'PackageOrDep's. We can use 'lazySequence' to turn this into a list of
-- 'PackageOrDep's, still maintaining the lazy nature of the original tar read.
parsePackageIndex :: ByteString -> [IO (Maybe PackageOrDep)]
parsePackageIndex = concatMap (uncurry extract) . tarEntriesList . Tar.read
265
  where
266
    extract :: BlockNo -> Tar.Entry -> [IO (Maybe PackageOrDep)]
Łukasz Dąbek's avatar
Łukasz Dąbek committed
267
    extract blockNo entry = tryExtractPkg ++ tryExtractPrefs
268
269
      where
        tryExtractPkg = do
Łukasz Dąbek's avatar
Łukasz Dąbek committed
270
          mkPkgEntry <- maybeToList $ extractPkg entry blockNo
271
          return $ fmap (fmap Pkg) mkPkgEntry
272
273

        tryExtractPrefs = do
274
          prefs' <- maybeToList $ extractPrefs entry
275
          fmap (return . Just . Dep) prefs'
276

277
278
279
280
281
282
283
284
-- | Turn the 'Entries' data structure from the @tar@ package into a list,
-- and pair each entry with its block number.
--
-- NOTE: This preserves the lazy nature of 'Entries': the tar file is only read
-- as far as the list is evaluated.
tarEntriesList :: Tar.Entries -> [(BlockNo, Tar.Entry)]
tarEntriesList = go 0
  where
285
286
287
    go !_ Tar.Done         = []
    go !_ (Tar.Fail e)     = error ("tarEntriesList: " ++ e)
    go !n (Tar.Next e es') = (n, e) : go (n + Tar.entrySizeInBlocks e) es'
288
289

extractPkg :: Tar.Entry -> BlockNo -> Maybe (IO (Maybe PackageEntry))
290
extractPkg entry blockNo = case Tar.entryContent entry of
291
292
293
294
  Tar.NormalFile content _
     | takeExtension fileName == ".cabal"
    -> case splitDirectories (normalise fileName) of
        [pkgname,vers,_] -> case simpleParse vers of
295
          Just ver -> Just . return $ Just (NormalPackage pkgid descr content blockNo)
296
297
            where
              pkgid  = PackageIdentifier (PackageName pkgname) ver
298
              parsed = parsePackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack
299
300
301
302
303
304
                                               $ content
              descr  = case parsed of
                ParseOk _ d -> d
                _           -> error $ "Couldn't read cabal file "
                                    ++ show fileName
          _ -> Nothing
305
        _ -> Nothing
306
307

  Tar.OtherEntryType typeCode content _
308
    | Tar.isBuildTreeRefTypeCode typeCode ->
309
      Just $ do
310
311
312
313
314
315
316
317
318
        let path = byteStringToFilePath content
        dirExists <- doesDirectoryExist path
        result <- if not dirExists then return Nothing
                  else do
                    cabalFile <- tryFindAddSourcePackageDesc path "Error reading package index."
                    descr     <- PackageDesc.Parse.readPackageDescription normal cabalFile
                    return . Just $ BuildTreeRef (refTypeFromTypeCode typeCode) (packageId descr)
                                                 descr path blockNo
        return result
319

320
  _ -> Nothing
321

322
  where
323
    fileName = Tar.entryPath entry
324

325
extractPrefs :: Tar.Entry -> Maybe [Dependency]
326
327
extractPrefs entry = case Tar.entryContent entry of
  Tar.NormalFile content _
328
     | takeFileName entrypath == "preferred-versions"
329
    -> Just prefs
330
331
    where
      entrypath = Tar.entryPath entry
332
      prefs     = parsePreferredVersions content
333
334
  _ -> Nothing

335
parsePreferredVersions :: ByteString -> [Dependency]
EyalLotem's avatar
EyalLotem committed
336
parsePreferredVersions = mapMaybe simpleParse
337
338
                       . filter (not . isPrefixOf "--")
                       . lines
339
                       . BS.Char8.unpack -- TODO: Are we sure no unicode?
340
341
342
343
344

------------------------------------------------------------------------
-- Reading and updating the index cache
--

345
346
347
348
349
-- | Variation on 'sequence' which evaluates the actions lazily
--
-- Pattern matching on the result list will execute just the first action;
-- more generally pattern matching on the first @n@ '(:)' nodes will execute
-- the first @n@ actions.
Łukasz Dąbek's avatar
Łukasz Dąbek committed
350
lazySequence :: [IO a] -> IO [a]
351
352
353
354
355
356
lazySequence = unsafeInterleaveIO . go
  where
    go []     = return []
    go (x:xs) = do x'  <- x
                   xs' <- lazySequence xs
                   return (x' : xs')
Łukasz Dąbek's avatar
Łukasz Dąbek committed
357

358
359
-- | Which index do we mean?
data Index =
Edsko de Vries's avatar
Edsko de Vries committed
360
    -- | The main index for the specified repository
Edsko de Vries's avatar
Edsko de Vries committed
361
    RepoIndex RepoContext Repo
362

Edsko de Vries's avatar
Edsko de Vries committed
363
364
365
    -- | A sandbox-local repository
    -- Argument is the location of the index file
  | SandboxIndex FilePath
366
367

indexFile :: Index -> FilePath
Edsko de Vries's avatar
Edsko de Vries committed
368
369
indexFile (RepoIndex _ctxt repo) = repoLocalDir repo </> "00-index.tar"
indexFile (SandboxIndex index)   = index
370
371

cacheFile :: Index -> FilePath
Edsko de Vries's avatar
Edsko de Vries committed
372
373
cacheFile (RepoIndex _ctxt repo) = repoLocalDir repo </> "00-index.cache"
cacheFile (SandboxIndex index)   = index `replaceExtension` "cache"
374
375
376
377

updatePackageIndexCacheFile :: Verbosity -> Index -> IO ()
updatePackageIndexCacheFile verbosity index = do
    info verbosity ("Updating index cache file " ++ cacheFile index)
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
    withIndexEntries index $ \entries -> do
      let cache = Cache { cacheEntries = entries }
      writeFile (cacheFile index) (showIndexCache cache)

-- | Read the index (for the purpose of building a cache)
--
-- The callback is provided with list of cache entries, which is guaranteed to
-- be lazily constructed. This list must ONLY be used in the scope of the
-- callback; when the callback is terminated the file handle to the index will
-- be closed and further attempts to read from the list will result in (pure)
-- I/O exceptions.
withIndexEntries :: Index -> ([IndexCacheEntry] -> IO a) -> IO a
withIndexEntries index callback = do
    withFile (indexFile index) ReadMode $ \h -> do
      bs          <- maybeDecompress `fmap` BS.hGetContents h
      pkgsOrPrefs <- lazySequence $ parsePackageIndex bs
      callback $ map toCache (catMaybes pkgsOrPrefs)
395
  where
396
    toCache :: PackageOrDep -> IndexCacheEntry
Łukasz Dąbek's avatar
Łukasz Dąbek committed
397
398
399
    toCache (Pkg (NormalPackage pkgid _ _ blockNo)) = CachePackageId pkgid blockNo
    toCache (Pkg (BuildTreeRef refType _ _ _ blockNo)) = CacheBuildTreeRef refType blockNo
    toCache (Dep d) = CachePreference d
400

401
402
403
data ReadPackageIndexMode = ReadPackageIndexStrict
                          | ReadPackageIndexLazyIO

404
readPackageIndexCacheFile :: Package pkg
405
                          => (PackageEntry -> pkg)
406
                          -> Index
407
                          -> IO (PackageIndex pkg, [Dependency])
Edsko de Vries's avatar
Edsko de Vries committed
408
readPackageIndexCacheFile mkPkg index = do
409
  cache    <- liftM readIndexCache $ BSS.readFile (cacheFile index)
Edsko de Vries's avatar
Edsko de Vries committed
410
411
  indexHnd <- openFile (indexFile index) ReadMode
  packageIndexFromCache mkPkg indexHnd cache ReadPackageIndexLazyIO
412
413

packageIndexFromCache :: Package pkg
414
                      => (PackageEntry -> pkg)
415
                      -> Handle
416
                      -> Cache
417
                      -> ReadPackageIndexMode
418
                      -> IO (PackageIndex pkg, [Dependency])
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
packageIndexFromCache mkPkg hnd cache mode = do
     (pkgs, prefs) <- packageListFromCache mkPkg hnd cache mode
     pkgIndex <- evaluate $ PackageIndex.fromList pkgs
     return (pkgIndex, prefs)

-- | Read package list
--
-- The result packages (though not the preferences) are guaranteed to be listed
-- in the same order as they are in the tar file (because later entries in a tar
-- file mask earlier ones).
packageListFromCache :: (PackageEntry -> pkg)
                     -> Handle
                     -> Cache
                     -> ReadPackageIndexMode
                     -> IO ([pkg], [Dependency])
packageListFromCache mkPkg hnd Cache{..} mode = accum mempty [] cacheEntries
435
  where
436
    accum srcpkgs prefs [] = return (reverse srcpkgs, prefs)
437
438
439
440
441
442

    accum srcpkgs prefs (CachePackageId pkgid blockno : entries) = do
      -- Given the cache entry, make a package index entry.
      -- The magic here is that we use lazy IO to read the .cabal file
      -- from the index tarball if it turns out that we need it.
      -- Most of the time we only need the package id.
443
444
445
446
      ~(pkg, pkgtxt) <- unsafeInterleaveIO $ do
        pkgtxt <- getEntryContent blockno
        pkg    <- readPackageDescription pkgtxt
        return (pkg, pkgtxt)
447
448
449
450
451
452
      let srcpkg = case mode of
            ReadPackageIndexLazyIO ->
              mkPkg (NormalPackage pkgid pkg pkgtxt blockno)
            ReadPackageIndexStrict ->
              pkg `seq` pkgtxt `seq` mkPkg (NormalPackage pkgid pkg
                                            pkgtxt blockno)
453
454
      accum (srcpkg:srcpkgs) prefs entries

455
    accum srcpkgs prefs (CacheBuildTreeRef refType blockno : entries) = do
456
457
458
      -- We have to read the .cabal file eagerly here because we can't cache the
      -- package id for build tree references - the user might edit the .cabal
      -- file after the reference was added to the index.
459
      path <- liftM byteStringToFilePath . getEntryContent $ blockno
460
461
462
      pkg  <- do let err = "Error reading package index from cache."
                 file <- tryFindAddSourcePackageDesc path err
                 PackageDesc.Parse.readPackageDescription normal file
463
      let srcpkg = mkPkg (BuildTreeRef refType (packageId pkg) pkg path blockno)
464
465
      accum (srcpkg:srcpkgs) prefs entries

refold's avatar
refold committed
466
    accum srcpkgs prefs (CachePreference pref : entries) =
467
468
      accum srcpkgs (pref:prefs) entries

469
470
    getEntryContent :: BlockNo -> IO ByteString
    getEntryContent blockno = do
471
472
473
      hSeek hnd AbsoluteSeek (fromIntegral (blockno * 512))
      header  <- BS.hGet hnd 512
      size    <- getEntrySize header
474
      BS.hGet hnd (fromIntegral size)
475

476
    getEntrySize :: ByteString -> IO Tar.FileSize
477
478
479
480
481
    getEntrySize header =
      case Tar.read header of
        Tar.Next e _ ->
          case Tar.entryContent e of
            Tar.NormalFile _ size -> return size
482
            Tar.OtherEntryType typecode _ size
483
              | Tar.isBuildTreeRefTypeCode typecode
484
                                  -> return size
485
486
487
            _                     -> interror "unexpected tar entry type"
        _ -> interror "could not read tar file entry"

488
    readPackageDescription :: ByteString -> IO GenericPackageDescription
489
    readPackageDescription content =
490
      case parsePackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content of
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
        ParseOk _ d -> return d
        _           -> interror "failed to parse .cabal file"

    interror msg = die $ "internal error when reading package index: " ++ msg
                      ++ "The package index or index cache is probably "
                      ++ "corrupt. Running cabal update might fix it."

------------------------------------------------------------------------
-- Index cache data structure
--

-- | Tar files are block structured with 512 byte blocks. Every header and file
-- content starts on a block boundary.
--
type BlockNo = Int

data IndexCacheEntry = CachePackageId PackageId BlockNo
508
                     | CacheBuildTreeRef BuildTreeRefType BlockNo
refold's avatar
refold committed
509
                     | CachePreference Dependency
510
  deriving (Eq)
511

512
513
installedComponentId, blocknoKey, buildTreeRefKey, preferredVersionKey :: String
installedComponentId = "pkg:"
514
515
516
517
blocknoKey = "b#"
buildTreeRefKey     = "build-tree-ref:"
preferredVersionKey = "pref-ver:"

518
519
520
521
readIndexCacheEntry :: BSS.ByteString -> Maybe IndexCacheEntry
readIndexCacheEntry = \line ->
  case BSS.words line of
    [key, pkgnamestr, pkgverstr, sep, blocknostr]
522
      | key == BSS.pack installedComponentId && sep == BSS.pack blocknoKey ->
refold's avatar
refold committed
523
524
      case (parseName pkgnamestr, parseVer pkgverstr [],
            parseBlockNo blocknostr) of
525
526
527
        (Just pkgname, Just pkgver, Just blockno)
          -> Just (CachePackageId (PackageIdentifier pkgname pkgver) blockno)
        _ -> Nothing
528
    [key, typecodestr, blocknostr] | key == BSS.pack buildTreeRefKey ->
529
530
531
532
533
      case (parseRefType typecodestr, parseBlockNo blocknostr) of
        (Just refType, Just blockno)
          -> Just (CacheBuildTreeRef refType blockno)
        _ -> Nothing

534
    (key: remainder) | key == BSS.pack preferredVersionKey ->
refold's avatar
refold committed
535
      fmap CachePreference (simpleParse (BSS.unpack (BSS.unwords remainder)))
536
    _  -> Nothing
537
  where
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
    parseName str
      | BSS.all (\c -> isAlphaNum c || c == '-') str
                  = Just (PackageName (BSS.unpack str))
      | otherwise = Nothing

    parseVer str vs =
      case BSS.readInt str of
        Nothing        -> Nothing
        Just (v, str') -> case BSS.uncons str' of
          Just ('.', str'') -> parseVer str'' (v:vs)
          Just _            -> Nothing
          Nothing           -> Just (Version (reverse (v:vs)) [])

    parseBlockNo str =
      case BSS.readInt str of
        Just (blockno, remainder) | BSS.null remainder -> Just blockno
        _                                              -> Nothing

556
557
558
559
560
561
562
    parseRefType str =
      case BSS.uncons str of
        Just (typeCode, remainder)
          | BSS.null remainder && Tar.isBuildTreeRefTypeCode typeCode
            -> Just (refTypeFromTypeCode typeCode)
        _   -> Nothing

563
showIndexCacheEntry :: IndexCacheEntry -> String
564
showIndexCacheEntry entry = unwords $ case entry of
565
   CachePackageId pkgid b -> [ installedComponentId
566
567
568
569
570
571
572
573
574
575
576
577
                             , display (packageName pkgid)
                             , display (packageVersion pkgid)
                             , blocknoKey
                             , show b
                             ]
   CacheBuildTreeRef t b  -> [ buildTreeRefKey
                             , [typeCodeFromRefType t]
                             , show b
                             ]
   CachePreference dep    -> [ preferredVersionKey
                             , display dep
                             ]
578

579
580
581
582
583
584
585
586
587
-- | Cabal caches various information about the Hackage index
data Cache = Cache {
    cacheEntries :: [IndexCacheEntry]
  }

readIndexCache :: BSS.ByteString -> Cache
readIndexCache bs = Cache {
    cacheEntries = mapMaybe readIndexCacheEntry $ BSS.lines bs
  }
588

589
590
showIndexCache :: Cache -> String
showIndexCache Cache{..} = unlines $ map showIndexCacheEntry cacheEntries