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

20
21
22
  parsePackageIndex,
  readRepoIndex,
  updateRepoIndexCache,
23
  updatePackageIndexCacheFile,
24
25

  BuildTreeRefType(..), refTypeFromTypeCode, typeCodeFromRefType
26
27
  ) where

Duncan Coutts's avatar
Duncan Coutts committed
28
import qualified Distribution.Client.Tar as Tar
29
import Distribution.Client.Types
30

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

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

86

87
88
getInstalledPackages :: Verbosity -> Compiler
                     -> PackageDBStack -> ProgramConfiguration
89
                     -> IO InstalledPackageIndex
90
getInstalledPackages verbosity comp packageDbs conf =
91
    Configure.getInstalledPackages verbosity' comp packageDbs conf
92
  where
93
94
95
    --FIXME: make getInstalledPackages use sensible verbosity in the first place
    verbosity'  = lessVerbose verbosity

96
97
98
------------------------------------------------------------------------
-- Reading the source package index
--
99

100
101
102
-- | Read a repository index from disk, from the local files specified by
-- a list of 'Repo's.
--
103
-- All the 'SourcePackage's are marked as having come from the appropriate
104
105
106
107
-- 'Repo'.
--
-- This is a higher level wrapper used internally in cabal-install.
--
108
getSourcePackages :: Verbosity -> [Repo] -> IO SourcePackageDb
109
110
111
112
113
114
115
116
117
118
119
120
121
122
getSourcePackages verbosity repos = getSourcePackages' verbosity repos
                                    ReadPackageIndexLazyIO

-- | Like 'getSourcePackages', but reads the package index strictly. Useful if
-- you want to write to the package index after having read it.
getSourcePackagesStrict :: Verbosity -> [Repo] -> IO SourcePackageDb
getSourcePackagesStrict verbosity repos = getSourcePackages' verbosity repos
                                          ReadPackageIndexStrict

-- | Common implementation used by getSourcePackages and
-- getSourcePackagesStrict.
getSourcePackages' :: Verbosity -> [Repo] -> ReadPackageIndexMode
                      -> IO SourcePackageDb
getSourcePackages' verbosity [] _mode = do
123
124
  warn verbosity $ "No remote package servers have been specified. Usually "
                ++ "you would have one specified in the config file."
125
  return SourcePackageDb {
126
127
128
    packageIndex       = mempty,
    packagePreferences = mempty
  }
129
getSourcePackages' verbosity repos mode = do
130
  info verbosity "Reading available packages..."
131
  pkgss <- mapM (\r -> readRepoIndex verbosity r mode) repos
132
  let (pkgs, prefs) = mconcat pkgss
Duncan Coutts's avatar
Duncan Coutts committed
133
      prefs' = Map.fromListWith intersectVersionRanges
134
                 [ (name, range) | Dependency name range <- prefs ]
135
136
  _ <- evaluate pkgs
  _ <- evaluate prefs'
137
  return SourcePackageDb {
138
139
140
    packageIndex       = pkgs,
    packagePreferences = prefs'
  }
141

142
143
144
-- | Read a repository index from disk, from the local file specified by
-- the 'Repo'.
--
145
-- All the 'SourcePackage's are marked as having come from the given 'Repo'.
146
147
148
--
-- This is a higher level wrapper used internally in cabal-install.
--
149
readRepoIndex :: Verbosity -> Repo -> ReadPackageIndexMode
150
              -> IO (PackageIndex SourcePackage, [Dependency])
151
readRepoIndex verbosity repo mode =
152
  let indexFile = repoLocalDir repo </> "00-index.tar"
153
154
      cacheFile = repoLocalDir repo </> "00-index.cache"
  in handleNotFound $ do
155
    warnIfIndexIsOld =<< getIndexFileAge repo
156
    whenCacheOutOfDate indexFile cacheFile $ do
157
      updatePackageIndexCacheFile verbosity indexFile cacheFile
158
    readPackageIndexCacheFile mkAvailablePackage indexFile cacheFile mode
Duncan Coutts's avatar
Duncan Coutts committed
159

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

refold's avatar
refold committed
175
    handleNotFound action = catchIO action $ \e -> if isDoesNotExistError e
176
177
178
179
180
181
182
183
184
185
186
      then do
        case repoKind repo of
          Left  remoteRepo -> warn verbosity $
               "The package list for '" ++ remoteRepoName remoteRepo
            ++ "' does not exist. Run 'cabal update' to download it."
          Right _localRepo -> warn verbosity $
               "The package list for the local repo '" ++ repoLocalDir repo
            ++ "' is missing. The repo is invalid."
        return mempty
      else ioError e

187
    isOldThreshold = 15 --days
188
    warnIfIndexIsOld dt = do
189
      when (dt >= isOldThreshold) $ case repoKind repo of
190
191
        Left  remoteRepo -> warn verbosity $
             "The package list for '" ++ remoteRepoName remoteRepo
192
          ++ "' is " ++ shows (floor dt :: Int) " days old.\nRun "
193
194
195
          ++ "'cabal update' to get the latest list of available packages."
        Right _localRepo -> return ()

196
197
198
199
200
201

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


202
203
204
205
206
207
-- | 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.
--
updateRepoIndexCache :: Verbosity -> Repo -> IO ()
updateRepoIndexCache verbosity repo =
    whenCacheOutOfDate indexFile cacheFile $ do
208
      updatePackageIndexCacheFile verbosity indexFile cacheFile
209
210
211
212
  where
    indexFile = repoLocalDir repo </> "00-index.tar"
    cacheFile = repoLocalDir repo </> "00-index.cache"

213
whenCacheOutOfDate :: FilePath -> FilePath -> IO () -> IO ()
214
whenCacheOutOfDate origFile cacheFile action = do
215
216
217
218
219
220
  exists <- doesFileExist cacheFile
  if not exists
    then action
    else do
      origTime  <- getModTime origFile
      cacheTime <- getModTime cacheFile
221
      when (origTime > cacheTime) action
222
223
224
225

------------------------------------------------------------------------
-- Reading the index file
--
226

227
-- | An index entry is either a normal package, or a local build tree reference.
refold's avatar
refold committed
228
229
data PackageEntry =
  NormalPackage  PackageId GenericPackageDescription ByteString BlockNo
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
  | 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
247

248
type MkPackageEntry = IO (Maybe PackageEntry)
249
250

instance Package PackageEntry where
251
252
  packageId (NormalPackage  pkgid _ _ _) = pkgid
  packageId (BuildTreeRef _ pkgid _ _ _) = pkgid
253
254

packageDesc :: PackageEntry -> GenericPackageDescription
255
256
packageDesc (NormalPackage  _ descr _ _) = descr
packageDesc (BuildTreeRef _ _ descr _ _) = descr
257

258
259
260
-- | Parse an uncompressed \"00-index.tar\" repository index file represented
-- as a 'ByteString'.
--
Łukasz Dąbek's avatar
Łukasz Dąbek committed
261
262
263

data PackageOrDep = Pkg PackageEntry | Dep Dependency

264
parsePackageIndex :: ByteString
265
                  -> [IO (Maybe PackageOrDep)]
Łukasz Dąbek's avatar
Łukasz Dąbek committed
266
parsePackageIndex = accum 0 . Tar.read
267
  where
Łukasz Dąbek's avatar
Łukasz Dąbek committed
268
269
270
271
    accum blockNo es = case es of
      Tar.Fail err   -> error ("parsePackageIndex: " ++ err)
      Tar.Done       -> []
      Tar.Next e es' -> ps ++ accum blockNo' es'
272
        where
Łukasz Dąbek's avatar
Łukasz Dąbek committed
273
274
          ps       = extract blockNo e
          blockNo' = blockNo + Tar.entrySizeInBlocks e
275

Łukasz Dąbek's avatar
Łukasz Dąbek committed
276
    extract blockNo entry = tryExtractPkg ++ tryExtractPrefs
277
      where
Łukasz Dąbek's avatar
Łukasz Dąbek committed
278
279
280
        maybeToList Nothing  = []
        maybeToList (Just a) = [a]

281
        tryExtractPkg = do
Łukasz Dąbek's avatar
Łukasz Dąbek committed
282
          mkPkgEntry <- maybeToList $ extractPkg entry blockNo
283
          return $ fmap (fmap Pkg) mkPkgEntry
284
285

        tryExtractPrefs = do
Łukasz Dąbek's avatar
Łukasz Dąbek committed
286
          (_,prefs') <- maybeToList $ extractPrefs entry
287
          fmap (return . Just . Dep) prefs'
288

289
290
extractPkg :: Tar.Entry -> BlockNo -> Maybe MkPackageEntry
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 (FilePath, [Dependency])
326
327
extractPrefs entry = case Tar.entryContent entry of
  Tar.NormalFile content _
328
329
330
331
332
     | takeFileName entrypath == "preferred-versions"
    -> Just (entrypath, prefs)
    where
      entrypath = Tar.entryPath entry
      prefs     = parsePreferredVersions (BS.Char8.unpack content)
333
334
335
  _ -> Nothing

parsePreferredVersions :: String -> [Dependency]
EyalLotem's avatar
EyalLotem committed
336
parsePreferredVersions = mapMaybe simpleParse
337
338
339
340
341
342
343
                       . filter (not . isPrefixOf "--")
                       . lines

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

Łukasz Dąbek's avatar
Łukasz Dąbek committed
344
345
346
347
348
349
350
lazySequence :: [IO a] -> IO [a]
lazySequence [] = return []
lazySequence (x:xs) = unsafeInterleaveIO $ do
    x'  <- unsafeInterleaveIO x
    xs' <- lazySequence xs
    return (x':xs')

351
352
updatePackageIndexCacheFile :: Verbosity -> FilePath -> FilePath -> IO ()
updatePackageIndexCacheFile verbosity indexFile cacheFile = do
353
    info verbosity ("Updating index cache file " ++ cacheFile)
Łukasz Dąbek's avatar
Łukasz Dąbek committed
354
355
356
357
358
    pkgsOrPrefs <- return
                 . parsePackageIndex
                 . maybeDecompress
               =<< BS.readFile indexFile
    entries <- lazySequence pkgsOrPrefs
359
    let cache = map toCache $ catMaybes entries
360
361
    writeFile cacheFile (showIndexCache cache)
  where
Łukasz Dąbek's avatar
Łukasz Dąbek committed
362
363
364
    toCache (Pkg (NormalPackage pkgid _ _ blockNo)) = CachePackageId pkgid blockNo
    toCache (Pkg (BuildTreeRef refType _ _ _ blockNo)) = CacheBuildTreeRef refType blockNo
    toCache (Dep d) = CachePreference d
365

366
367
368
data ReadPackageIndexMode = ReadPackageIndexStrict
                          | ReadPackageIndexLazyIO

369
readPackageIndexCacheFile :: Package pkg
370
                          => (PackageEntry -> pkg)
371
372
                          -> FilePath
                          -> FilePath
373
                          -> ReadPackageIndexMode
374
                          -> IO (PackageIndex pkg, [Dependency])
375
readPackageIndexCacheFile mkPkg indexFile cacheFile mode = do
376
  cache    <- liftM readIndexCache (BSS.readFile cacheFile)
377
378
379
380
381
382
383
  myWithFile indexFile ReadMode $ \indexHnd ->
    packageIndexFromCache mkPkg indexHnd cache mode
  where
    myWithFile f m act = case mode of
      ReadPackageIndexStrict -> withFile f m act
      ReadPackageIndexLazyIO -> do indexHnd <- openFile f m
                                   act indexHnd
384
385
386


packageIndexFromCache :: Package pkg
387
                      => (PackageEntry -> pkg)
388
389
                      -> Handle
                      -> [IndexCacheEntry]
390
                      -> ReadPackageIndexMode
391
                      -> IO (PackageIndex pkg, [Dependency])
392
packageIndexFromCache mkPkg hnd entrs mode = accum mempty [] entrs
393
394
395
396
397
398
399
400
401
402
403
404
405
  where
    accum srcpkgs prefs [] = do
      -- Have to reverse entries, since in a tar file, later entries mask
      -- earlier ones, and PackageIndex.fromList does the same, but we
      -- accumulate the list of entries in reverse order, so need to reverse.
      pkgIndex <- evaluate $ PackageIndex.fromList (reverse srcpkgs)
      return (pkgIndex, prefs)

    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.
406
407
408
409
      ~(pkg, pkgtxt) <- unsafeInterleaveIO $ do
        pkgtxt <- getEntryContent blockno
        pkg    <- readPackageDescription pkgtxt
        return (pkg, pkgtxt)
410
411
412
413
414
415
      let srcpkg = case mode of
            ReadPackageIndexLazyIO ->
              mkPkg (NormalPackage pkgid pkg pkgtxt blockno)
            ReadPackageIndexStrict ->
              pkg `seq` pkgtxt `seq` mkPkg (NormalPackage pkgid pkg
                                            pkgtxt blockno)
416
417
      accum (srcpkg:srcpkgs) prefs entries

418
    accum srcpkgs prefs (CacheBuildTreeRef refType blockno : entries) = do
419
420
421
      -- 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.
422
      path <- liftM byteStringToFilePath . getEntryContent $ blockno
423
424
425
      pkg  <- do let err = "Error reading package index from cache."
                 file <- tryFindAddSourcePackageDesc path err
                 PackageDesc.Parse.readPackageDescription normal file
426
      let srcpkg = mkPkg (BuildTreeRef refType (packageId pkg) pkg path blockno)
427
428
      accum (srcpkg:srcpkgs) prefs entries

refold's avatar
refold committed
429
    accum srcpkgs prefs (CachePreference pref : entries) =
430
431
      accum srcpkgs (pref:prefs) entries

432
433
    getEntryContent :: BlockNo -> IO ByteString
    getEntryContent blockno = do
434
435
436
      hSeek hnd AbsoluteSeek (fromIntegral (blockno * 512))
      header  <- BS.hGet hnd 512
      size    <- getEntrySize header
437
      BS.hGet hnd (fromIntegral size)
438

439
    getEntrySize :: ByteString -> IO Tar.FileSize
440
441
442
443
444
    getEntrySize header =
      case Tar.read header of
        Tar.Next e _ ->
          case Tar.entryContent e of
            Tar.NormalFile _ size -> return size
445
            Tar.OtherEntryType typecode _ size
446
              | Tar.isBuildTreeRefTypeCode typecode
447
                                  -> return size
448
449
450
            _                     -> interror "unexpected tar entry type"
        _ -> interror "could not read tar file entry"

451
    readPackageDescription :: ByteString -> IO GenericPackageDescription
452
    readPackageDescription content =
453
      case parsePackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content of
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
        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
471
                     | CacheBuildTreeRef BuildTreeRefType BlockNo
refold's avatar
refold committed
472
                     | CachePreference Dependency
473
  deriving (Eq)
474

475
476
installedComponentId, blocknoKey, buildTreeRefKey, preferredVersionKey :: String
installedComponentId = "pkg:"
477
478
479
480
blocknoKey = "b#"
buildTreeRefKey     = "build-tree-ref:"
preferredVersionKey = "pref-ver:"

481
482
483
484
readIndexCacheEntry :: BSS.ByteString -> Maybe IndexCacheEntry
readIndexCacheEntry = \line ->
  case BSS.words line of
    [key, pkgnamestr, pkgverstr, sep, blocknostr]
485
      | key == BSS.pack installedComponentId && sep == BSS.pack blocknoKey ->
refold's avatar
refold committed
486
487
      case (parseName pkgnamestr, parseVer pkgverstr [],
            parseBlockNo blocknostr) of
488
489
490
        (Just pkgname, Just pkgver, Just blockno)
          -> Just (CachePackageId (PackageIdentifier pkgname pkgver) blockno)
        _ -> Nothing
491
    [key, typecodestr, blocknostr] | key == BSS.pack buildTreeRefKey ->
492
493
494
495
496
      case (parseRefType typecodestr, parseBlockNo blocknostr) of
        (Just refType, Just blockno)
          -> Just (CacheBuildTreeRef refType blockno)
        _ -> Nothing

497
    (key: remainder) | key == BSS.pack preferredVersionKey ->
refold's avatar
refold committed
498
      fmap CachePreference (simpleParse (BSS.unpack (BSS.unwords remainder)))
499
    _  -> Nothing
500
  where
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
    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

519
520
521
522
523
524
525
    parseRefType str =
      case BSS.uncons str of
        Just (typeCode, remainder)
          | BSS.null remainder && Tar.isBuildTreeRefTypeCode typeCode
            -> Just (refTypeFromTypeCode typeCode)
        _   -> Nothing

526
showIndexCacheEntry :: IndexCacheEntry -> String
527
showIndexCacheEntry entry = unwords $ case entry of
528
   CachePackageId pkgid b -> [ installedComponentId
529
530
531
532
533
534
535
536
537
538
539
540
                             , display (packageName pkgid)
                             , display (packageVersion pkgid)
                             , blocknoKey
                             , show b
                             ]
   CacheBuildTreeRef t b  -> [ buildTreeRefKey
                             , [typeCodeFromRefType t]
                             , show b
                             ]
   CachePreference dep    -> [ preferredVersionKey
                             , display dep
                             ]
541
542

readIndexCache :: BSS.ByteString -> [IndexCacheEntry]
EyalLotem's avatar
EyalLotem committed
543
readIndexCache = mapMaybe readIndexCacheEntry . BSS.lines
544
545
546

showIndexCache :: [IndexCacheEntry] -> String
showIndexCache = unlines . map showIndexCacheEntry