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

  readPackageIndexFile,
20
21
22
  parsePackageIndex,
  readRepoIndex,
  updateRepoIndexCache,
23
24

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

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

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

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

85

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

95
convert :: InstalledPackageIndex -> PackageIndex InstalledPackage
96
convert index' = PackageIndex.fromList
97
    -- There can be multiple installed instances of each package version,
Ian D. Bollinger's avatar
Ian D. Bollinger committed
98
    -- like when the same package is installed in the global & user DBs.
99
100
101
102
103
104
    -- InstalledPackageIndex.allPackagesBySourcePackageId gives us the
    -- installed packages with the most preferred instances first, so by
    -- picking the first we should get the user one. This is almost but not
    -- quite the same as what ghc does.
    [ InstalledPackage ipkg (sourceDeps index' ipkg)
    | (_,ipkg:_) <- InstalledPackageIndex.allPackagesBySourcePackageId index' ]
105
106
107
108
109
110
111
112
113
  where
    -- The InstalledPackageInfo only lists dependencies by the
    -- InstalledPackageId, which means we do not directly know the corresponding
    -- source dependency. The only way to find out is to lookup the
    -- InstalledPackageId to get the InstalledPackageInfo and look at its
    -- source PackageId. But if the package is broken because it depends on
    -- other packages that do not exist then we have a problem we cannot find
    -- the original source package id. Instead we make up a bogus package id.
    -- This should have the same effect since it should be a dependency on a
Ian D. Bollinger's avatar
Ian D. Bollinger committed
114
    -- nonexistent package.
115
116
117
118
119
120
121
122
123
    sourceDeps index ipkg =
      [ maybe (brokenPackageId depid) packageId mdep
      | let depids = InstalledPackageInfo.depends ipkg
            getpkg = InstalledPackageIndex.lookupInstalledPackageId index
      , (depid, mdep) <- zip depids (map getpkg depids) ]

    brokenPackageId (InstalledPackageId str) =
      PackageIdentifier (PackageName (str ++ "-broken")) (Version [] [])

124
125
126
------------------------------------------------------------------------
-- Reading the source package index
--
127

128
129
130
-- | Read a repository index from disk, from the local files specified by
-- a list of 'Repo's.
--
131
-- All the 'SourcePackage's are marked as having come from the appropriate
132
133
134
135
-- 'Repo'.
--
-- This is a higher level wrapper used internally in cabal-install.
--
136
getSourcePackages :: Verbosity -> [Repo] -> IO SourcePackageDb
137
138
139
140
141
142
143
144
145
146
147
148
149
150
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
151
152
  warn verbosity $ "No remote package servers have been specified. Usually "
                ++ "you would have one specified in the config file."
153
  return SourcePackageDb {
154
155
156
    packageIndex       = mempty,
    packagePreferences = mempty
  }
157
getSourcePackages' verbosity repos mode = do
158
  info verbosity "Reading available packages..."
159
  pkgss <- mapM (\r -> readRepoIndex verbosity r mode) repos
160
  let (pkgs, prefs) = mconcat pkgss
Duncan Coutts's avatar
Duncan Coutts committed
161
      prefs' = Map.fromListWith intersectVersionRanges
162
                 [ (name, range) | Dependency name range <- prefs ]
163
164
  _ <- evaluate pkgs
  _ <- evaluate prefs'
165
  return SourcePackageDb {
166
167
168
    packageIndex       = pkgs,
    packagePreferences = prefs'
  }
169

170
171
172
-- | Read a repository index from disk, from the local file specified by
-- the 'Repo'.
--
173
-- All the 'SourcePackage's are marked as having come from the given 'Repo'.
174
175
176
--
-- This is a higher level wrapper used internally in cabal-install.
--
177
readRepoIndex :: Verbosity -> Repo -> ReadPackageIndexMode
178
              -> IO (PackageIndex SourcePackage, [Dependency])
179
readRepoIndex verbosity repo mode =
180
  let indexFile = repoLocalDir repo </> "00-index.tar"
181
182
183
184
      cacheFile = repoLocalDir repo </> "00-index.cache"
  in handleNotFound $ do
    warnIfIndexIsOld indexFile
    whenCacheOutOfDate indexFile cacheFile $ do
EyalLotem's avatar
EyalLotem committed
185
      info verbosity "Updating the index cache file..."
186
      updatePackageIndexCacheFile indexFile cacheFile
187
    readPackageIndexCacheFile mkAvailablePackage indexFile cacheFile mode
Duncan Coutts's avatar
Duncan Coutts committed
188

189
  where
190
    mkAvailablePackage pkgEntry =
191
      SourcePackage {
192
        packageInfoId      = pkgid,
193
194
        packageDescription = packageDesc pkgEntry,
        packageSource      = case pkgEntry of
195
196
          NormalPackage _ _ _ _       -> RepoTarballPackage repo pkgid Nothing
          BuildTreeRef  _  _ _ path _ -> LocalUnpackedPackage path,
197
198
199
        packageDescrOverride = case pkgEntry of
          NormalPackage _ _ pkgtxt _ -> Just pkgtxt
          _                          -> Nothing
200
      }
201
202
      where
        pkgid = packageId pkgEntry
203

refold's avatar
refold committed
204
    handleNotFound action = catchIO action $ \e -> if isDoesNotExistError e
205
206
207
208
209
210
211
212
213
214
215
      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

216
217
    isOldThreshold = 15 --days
    warnIfIndexIsOld indexFile = do
218
219
      dt <- getFileAge indexFile
      when (dt >= isOldThreshold) $ case repoKind repo of
220
221
        Left  remoteRepo -> warn verbosity $
             "The package list for '" ++ remoteRepoName remoteRepo
222
          ++ "' is " ++ show dt ++ " days old.\nRun "
223
224
225
          ++ "'cabal update' to get the latest list of available packages."
        Right _localRepo -> return ()

226
227
228
229
230
231
-- | 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
EyalLotem's avatar
EyalLotem committed
232
      info verbosity "Updating the index cache file..."
233
234
235
236
237
      updatePackageIndexCacheFile indexFile cacheFile
  where
    indexFile = repoLocalDir repo </> "00-index.tar"
    cacheFile = repoLocalDir repo </> "00-index.cache"

238
whenCacheOutOfDate :: FilePath -> FilePath -> IO () -> IO ()
239
whenCacheOutOfDate origFile cacheFile action = do
240
241
242
243
244
245
  exists <- doesFileExist cacheFile
  if not exists
    then action
    else do
      origTime  <- getModTime origFile
      cacheTime <- getModTime cacheFile
246
      when (origTime > cacheTime) action
247
248
249
250

------------------------------------------------------------------------
-- Reading the index file
--
251

252
-- | An index entry is either a normal package, or a local build tree reference.
refold's avatar
refold committed
253
254
data PackageEntry =
  NormalPackage  PackageId GenericPackageDescription ByteString BlockNo
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
  | 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
272
273
274
275

type MkPackageEntry = IO PackageEntry

instance Package PackageEntry where
276
277
  packageId (NormalPackage  pkgid _ _ _) = pkgid
  packageId (BuildTreeRef _ pkgid _ _ _) = pkgid
278
279

packageDesc :: PackageEntry -> GenericPackageDescription
280
281
packageDesc (NormalPackage  _ descr _ _) = descr
packageDesc (BuildTreeRef _ _ descr _ _) = descr
282

283
284
285
-- | Read a compressed \"00-index.tar.gz\" file into a 'PackageIndex'.
--
-- This is supposed to be an \"all in one\" way to easily get at the info in
Ian D. Bollinger's avatar
Ian D. Bollinger committed
286
-- the Hackage package index.
287
288
289
290
291
292
--
-- It takes a function to map a 'GenericPackageDescription' into any more
-- specific instance of 'Package' that you might want to use. In the simple
-- case you can just use @\_ p -> p@ here.
--
readPackageIndexFile :: Package pkg
293
                     => (PackageEntry -> pkg)
294
295
                     -> FilePath
                     -> IO (PackageIndex pkg, [Dependency])
296
readPackageIndexFile mkPkg indexFile = do
297
298
299
300
  (mkPkgs, prefs) <- either fail return
                     . parsePackageIndex
                     . maybeDecompress
                     =<< BS.readFile indexFile
301

302
303
304
  pkgEntries  <- sequence mkPkgs
  pkgs <- evaluate $ PackageIndex.fromList (map mkPkg pkgEntries)
  return (pkgs, prefs)
305
306
307
308

-- | Parse an uncompressed \"00-index.tar\" repository index file represented
-- as a 'ByteString'.
--
309
parsePackageIndex :: ByteString
310
                  -> Either String ([MkPackageEntry], [Dependency])
311
312
313
314
315
316
317
318
parsePackageIndex = accum 0 [] [] . Tar.read
  where
    accum blockNo pkgs prefs es = case es of
      Tar.Fail err   -> Left  err
      Tar.Done       -> Right (reverse pkgs, reverse prefs)
      Tar.Next e es' -> accum blockNo' pkgs' prefs' es'
        where
          (pkgs', prefs') = extract blockNo pkgs prefs e
319
          blockNo'        = blockNo + Tar.entrySizeInBlocks e
320
321
322
323
324
325
326

    extract blockNo pkgs prefs entry =
       fromMaybe (pkgs, prefs) $
                 tryExtractPkg
         `mplus` tryExtractPrefs
      where
        tryExtractPkg = do
327
328
          mkPkgEntry <- extractPkg entry blockNo
          return (mkPkgEntry:pkgs, prefs)
329
330
331
332
333

        tryExtractPrefs = do
          prefs' <- extractPrefs entry
          return (pkgs, prefs'++prefs)

334
335
extractPkg :: Tar.Entry -> BlockNo -> Maybe MkPackageEntry
extractPkg entry blockNo = case Tar.entryContent entry of
336
337
338
339
  Tar.NormalFile content _
     | takeExtension fileName == ".cabal"
    -> case splitDirectories (normalise fileName) of
        [pkgname,vers,_] -> case simpleParse vers of
340
          Just ver -> Just $ return (NormalPackage pkgid descr content blockNo)
341
342
343
344
345
346
347
348
349
            where
              pkgid  = PackageIdentifier (PackageName pkgname) ver
              parsed = parsePackageDescription . fromUTF8 . BS.Char8.unpack
                                               $ content
              descr  = case parsed of
                ParseOk _ d -> d
                _           -> error $ "Couldn't read cabal file "
                                    ++ show fileName
          _ -> Nothing
350
        _ -> Nothing
351
352

  Tar.OtherEntryType typeCode content _
353
    | Tar.isBuildTreeRefTypeCode typeCode ->
354
355
      Just $ do
        let path   = byteStringToFilePath content
356
357
            err = "Error reading package index."
        cabalFile <- tryFindAddSourcePackageDesc path err
358
        descr     <- PackageDesc.Parse.readPackageDescription normal cabalFile
359
360
        return $ BuildTreeRef (refTypeFromTypeCode typeCode) (packageId descr)
                              descr path blockNo
361

362
  _ -> Nothing
363

364
  where
365
    fileName = Tar.entryPath entry
366

367
368
369
370
371
372
373
374
375
extractPrefs :: Tar.Entry -> Maybe [Dependency]
extractPrefs entry = case Tar.entryContent entry of
  Tar.NormalFile content _
     | takeFileName (Tar.entryPath entry) == "preferred-versions"
    -> Just . parsePreferredVersions
     . BS.Char8.unpack $ content
  _ -> Nothing

parsePreferredVersions :: String -> [Dependency]
EyalLotem's avatar
EyalLotem committed
376
parsePreferredVersions = mapMaybe simpleParse
377
378
379
380
381
382
383
384
385
                       . filter (not . isPrefixOf "--")
                       . lines

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

updatePackageIndexCacheFile :: FilePath -> FilePath -> IO ()
updatePackageIndexCacheFile indexFile cacheFile = do
386
387
388
389
390
391
    (mkPkgs, prefs) <- either fail return
                       . parsePackageIndex
                       . maybeDecompress
                       =<< BS.readFile indexFile
    pkgEntries <- sequence mkPkgs
    let cache = mkCache pkgEntries prefs
392
393
394
    writeFile cacheFile (showIndexCache cache)
  where
    mkCache pkgs prefs =
refold's avatar
refold committed
395
        [ CachePreference pref          | pref <- prefs ]
396
     ++ [ CachePackageId pkgid blockNo
397
        | (NormalPackage pkgid _ _ blockNo) <- pkgs ]
398
399
     ++ [ CacheBuildTreeRef refType blockNo
        | (BuildTreeRef refType _ _ _ blockNo) <- pkgs]
400

401
402
403
data ReadPackageIndexMode = ReadPackageIndexStrict
                          | ReadPackageIndexLazyIO

404
readPackageIndexCacheFile :: Package pkg
405
                          => (PackageEntry -> pkg)
406
407
                          -> FilePath
                          -> FilePath
408
                          -> ReadPackageIndexMode
409
                          -> IO (PackageIndex pkg, [Dependency])
410
readPackageIndexCacheFile mkPkg indexFile cacheFile mode = do
411
  cache    <- liftM readIndexCache (BSS.readFile cacheFile)
412
413
414
415
416
417
418
  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
419
420
421


packageIndexFromCache :: Package pkg
422
                      => (PackageEntry -> pkg)
423
424
                      -> Handle
                      -> [IndexCacheEntry]
425
                      -> ReadPackageIndexMode
426
                      -> IO (PackageIndex pkg, [Dependency])
427
packageIndexFromCache mkPkg hnd entrs mode = accum mempty [] entrs
428
429
430
431
432
433
434
435
436
437
438
439
440
  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.
441
442
443
444
      ~(pkg, pkgtxt) <- unsafeInterleaveIO $ do
        pkgtxt <- getEntryContent blockno
        pkg    <- readPackageDescription pkgtxt
        return (pkg, pkgtxt)
445
446
447
448
449
450
      let srcpkg = case mode of
            ReadPackageIndexLazyIO ->
              mkPkg (NormalPackage pkgid pkg pkgtxt blockno)
            ReadPackageIndexStrict ->
              pkg `seq` pkgtxt `seq` mkPkg (NormalPackage pkgid pkg
                                            pkgtxt blockno)
451
452
      accum (srcpkg:srcpkgs) prefs entries

453
    accum srcpkgs prefs (CacheBuildTreeRef refType blockno : entries) = do
454
455
456
      -- 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.
457
      path <- liftM byteStringToFilePath . getEntryContent $ blockno
458
459
460
      pkg  <- do let err = "Error reading package index from cache."
                 file <- tryFindAddSourcePackageDesc path err
                 PackageDesc.Parse.readPackageDescription normal file
461
      let srcpkg = mkPkg (BuildTreeRef refType (packageId pkg) pkg path blockno)
462
463
      accum (srcpkg:srcpkgs) prefs entries

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

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

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

486
    readPackageDescription :: ByteString -> IO GenericPackageDescription
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
    readPackageDescription content =
      case parsePackageDescription . fromUTF8 . BS.Char8.unpack $ content of
        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
506
                     | CacheBuildTreeRef BuildTreeRefType BlockNo
refold's avatar
refold committed
507
                     | CachePreference Dependency
508
  deriving (Eq)
509

510
511
512
513
514
515
packageKey, blocknoKey, buildTreeRefKey, preferredVersionKey :: String
packageKey = "pkg:"
blocknoKey = "b#"
buildTreeRefKey     = "build-tree-ref:"
preferredVersionKey = "pref-ver:"

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

532
    (key: remainder) | key == BSS.pack preferredVersionKey ->
refold's avatar
refold committed
533
      fmap CachePreference (simpleParse (BSS.unpack (BSS.unwords remainder)))
534
    _  -> Nothing
535
  where
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
    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

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

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

readIndexCache :: BSS.ByteString -> [IndexCacheEntry]
EyalLotem's avatar
EyalLotem committed
578
readIndexCache = mapMaybe readIndexCacheEntry . BSS.lines
579
580
581

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