IndexUtils.hs 23.6 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
  convert,
20
21

  readPackageIndexFile,
22
23
24
  parsePackageIndex,
  readRepoIndex,
  updateRepoIndexCache,
25
  updatePackageIndexCacheFile,
26
27

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

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

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

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

90

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

100
convert :: InstalledPackageIndex -> PackageIndex InstalledPackage
101
convert index' = PackageIndex.fromList
102
    -- There can be multiple installed instances of each package version,
Ian D. Bollinger's avatar
Ian D. Bollinger committed
103
    -- like when the same package is installed in the global & user DBs.
104
105
106
107
108
109
    -- 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' ]
110
111
112
113
114
115
116
117
118
  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
119
    -- nonexistent package.
120
121
122
123
124
125
126
127
128
    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 [] [])

129
130
131
------------------------------------------------------------------------
-- Reading the source package index
--
132

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

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

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

refold's avatar
refold committed
208
    handleNotFound action = catchIO action $ \e -> if isDoesNotExistError e
209
210
211
212
213
214
215
216
217
218
219
      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

220
    isOldThreshold = 15 --days
221
    warnIfIndexIsOld dt = do
222
      when (dt >= isOldThreshold) $ case repoKind repo of
223
224
        Left  remoteRepo -> warn verbosity $
             "The package list for '" ++ remoteRepoName remoteRepo
225
          ++ "' is " ++ shows (floor dt :: Int) " days old.\nRun "
226
227
228
          ++ "'cabal update' to get the latest list of available packages."
        Right _localRepo -> return ()

229
230
231
232
233
234

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


235
236
237
238
239
240
-- | 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
241
      updatePackageIndexCacheFile verbosity indexFile cacheFile
242
243
244
245
  where
    indexFile = repoLocalDir repo </> "00-index.tar"
    cacheFile = repoLocalDir repo </> "00-index.cache"

246
whenCacheOutOfDate :: FilePath -> FilePath -> IO () -> IO ()
247
whenCacheOutOfDate origFile cacheFile action = do
248
249
250
251
252
253
  exists <- doesFileExist cacheFile
  if not exists
    then action
    else do
      origTime  <- getModTime origFile
      cacheTime <- getModTime cacheFile
254
      when (origTime > cacheTime) action
255
256
257
258

------------------------------------------------------------------------
-- Reading the index file
--
259

260
-- | An index entry is either a normal package, or a local build tree reference.
refold's avatar
refold committed
261
262
data PackageEntry =
  NormalPackage  PackageId GenericPackageDescription ByteString BlockNo
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
  | 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
280
281
282
283

type MkPackageEntry = IO PackageEntry

instance Package PackageEntry where
284
285
  packageId (NormalPackage  pkgid _ _ _) = pkgid
  packageId (BuildTreeRef _ pkgid _ _ _) = pkgid
286
287

packageDesc :: PackageEntry -> GenericPackageDescription
288
289
packageDesc (NormalPackage  _ descr _ _) = descr
packageDesc (BuildTreeRef _ _ descr _ _) = descr
290

291
292
293
-- | 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
294
-- the Hackage package index.
295
296
297
298
299
300
--
-- 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
301
                     => (PackageEntry -> pkg)
302
303
                     -> FilePath
                     -> IO (PackageIndex pkg, [Dependency])
304
readPackageIndexFile mkPkg indexFile = do
305
306
307
308
  (mkPkgs, prefs) <- either fail return
                     . parsePackageIndex
                     . maybeDecompress
                     =<< BS.readFile indexFile
309

310
311
312
  pkgEntries  <- sequence mkPkgs
  pkgs <- evaluate $ PackageIndex.fromList (map mkPkg pkgEntries)
  return (pkgs, prefs)
313
314
315
316

-- | Parse an uncompressed \"00-index.tar\" repository index file represented
-- as a 'ByteString'.
--
317
parsePackageIndex :: ByteString
318
                  -> Either String ([MkPackageEntry], [Dependency])
319
parsePackageIndex = accum 0 [] Map.empty . Tar.read
320
321
322
  where
    accum blockNo pkgs prefs es = case es of
      Tar.Fail err   -> Left  err
323
324
325
      Tar.Done       -> Right (reverse pkgs, concat (Map.elems prefs))
      Tar.Next e es' -> blockNo' `seq` prefs' `seq`
                        accum blockNo' pkgs' prefs' es'
326
327
        where
          (pkgs', prefs') = extract blockNo pkgs prefs e
328
          blockNo'        = blockNo + Tar.entrySizeInBlocks e
329
330
331
332
333
334
335

    extract blockNo pkgs prefs entry =
       fromMaybe (pkgs, prefs) $
                 tryExtractPkg
         `mplus` tryExtractPrefs
      where
        tryExtractPkg = do
336
337
          mkPkgEntry <- extractPkg entry blockNo
          return (mkPkgEntry:pkgs, prefs)
338
339

        tryExtractPrefs = do
340
341
          (loc,prefs') <- extractPrefs entry
          return (pkgs, Map.insert loc prefs' prefs)
342

343
344
extractPkg :: Tar.Entry -> BlockNo -> Maybe MkPackageEntry
extractPkg entry blockNo = case Tar.entryContent entry of
345
346
347
348
  Tar.NormalFile content _
     | takeExtension fileName == ".cabal"
    -> case splitDirectories (normalise fileName) of
        [pkgname,vers,_] -> case simpleParse vers of
349
          Just ver -> Just $ return (NormalPackage pkgid descr content blockNo)
350
351
            where
              pkgid  = PackageIdentifier (PackageName pkgname) ver
352
              parsed = parsePackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack
353
354
355
356
357
358
                                               $ content
              descr  = case parsed of
                ParseOk _ d -> d
                _           -> error $ "Couldn't read cabal file "
                                    ++ show fileName
          _ -> Nothing
359
        _ -> Nothing
360
361

  Tar.OtherEntryType typeCode content _
362
    | Tar.isBuildTreeRefTypeCode typeCode ->
363
364
      Just $ do
        let path   = byteStringToFilePath content
365
366
            err = "Error reading package index."
        cabalFile <- tryFindAddSourcePackageDesc path err
367
        descr     <- PackageDesc.Parse.readPackageDescription normal cabalFile
368
369
        return $ BuildTreeRef (refTypeFromTypeCode typeCode) (packageId descr)
                              descr path blockNo
370

371
  _ -> Nothing
372

373
  where
374
    fileName = Tar.entryPath entry
375

376
extractPrefs :: Tar.Entry -> Maybe (FilePath, [Dependency])
377
378
extractPrefs entry = case Tar.entryContent entry of
  Tar.NormalFile content _
379
380
381
382
383
     | takeFileName entrypath == "preferred-versions"
    -> Just (entrypath, prefs)
    where
      entrypath = Tar.entryPath entry
      prefs     = parsePreferredVersions (BS.Char8.unpack content)
384
385
386
  _ -> Nothing

parsePreferredVersions :: String -> [Dependency]
EyalLotem's avatar
EyalLotem committed
387
parsePreferredVersions = mapMaybe simpleParse
388
389
390
391
392
393
394
                       . filter (not . isPrefixOf "--")
                       . lines

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

395
396
updatePackageIndexCacheFile :: Verbosity -> FilePath -> FilePath -> IO ()
updatePackageIndexCacheFile verbosity indexFile cacheFile = do
397
    info verbosity ("Updating index cache file " ++ cacheFile)
398
399
400
401
402
403
    (mkPkgs, prefs) <- either fail return
                       . parsePackageIndex
                       . maybeDecompress
                       =<< BS.readFile indexFile
    pkgEntries <- sequence mkPkgs
    let cache = mkCache pkgEntries prefs
404
405
406
    writeFile cacheFile (showIndexCache cache)
  where
    mkCache pkgs prefs =
refold's avatar
refold committed
407
        [ CachePreference pref          | pref <- prefs ]
408
     ++ [ CachePackageId pkgid blockNo
409
        | (NormalPackage pkgid _ _ blockNo) <- pkgs ]
410
411
     ++ [ CacheBuildTreeRef refType blockNo
        | (BuildTreeRef refType _ _ _ blockNo) <- pkgs]
412

413
414
415
data ReadPackageIndexMode = ReadPackageIndexStrict
                          | ReadPackageIndexLazyIO

416
readPackageIndexCacheFile :: Package pkg
417
                          => (PackageEntry -> pkg)
418
419
                          -> FilePath
                          -> FilePath
420
                          -> ReadPackageIndexMode
421
                          -> IO (PackageIndex pkg, [Dependency])
422
readPackageIndexCacheFile mkPkg indexFile cacheFile mode = do
423
  cache    <- liftM readIndexCache (BSS.readFile cacheFile)
424
425
426
427
428
429
430
  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
431
432
433


packageIndexFromCache :: Package pkg
434
                      => (PackageEntry -> pkg)
435
436
                      -> Handle
                      -> [IndexCacheEntry]
437
                      -> ReadPackageIndexMode
438
                      -> IO (PackageIndex pkg, [Dependency])
439
packageIndexFromCache mkPkg hnd entrs mode = accum mempty [] entrs
440
441
442
443
444
445
446
447
448
449
450
451
452
  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.
453
454
455
456
      ~(pkg, pkgtxt) <- unsafeInterleaveIO $ do
        pkgtxt <- getEntryContent blockno
        pkg    <- readPackageDescription pkgtxt
        return (pkg, pkgtxt)
457
458
459
460
461
462
      let srcpkg = case mode of
            ReadPackageIndexLazyIO ->
              mkPkg (NormalPackage pkgid pkg pkgtxt blockno)
            ReadPackageIndexStrict ->
              pkg `seq` pkgtxt `seq` mkPkg (NormalPackage pkgid pkg
                                            pkgtxt blockno)
463
464
      accum (srcpkg:srcpkgs) prefs entries

465
    accum srcpkgs prefs (CacheBuildTreeRef refType blockno : entries) = do
466
467
468
      -- 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.
469
      path <- liftM byteStringToFilePath . getEntryContent $ blockno
470
471
472
      pkg  <- do let err = "Error reading package index from cache."
                 file <- tryFindAddSourcePackageDesc path err
                 PackageDesc.Parse.readPackageDescription normal file
473
      let srcpkg = mkPkg (BuildTreeRef refType (packageId pkg) pkg path blockno)
474
475
      accum (srcpkg:srcpkgs) prefs entries

refold's avatar
refold committed
476
    accum srcpkgs prefs (CachePreference pref : entries) =
477
478
      accum srcpkgs (pref:prefs) entries

479
480
    getEntryContent :: BlockNo -> IO ByteString
    getEntryContent blockno = do
481
482
483
      hSeek hnd AbsoluteSeek (fromIntegral (blockno * 512))
      header  <- BS.hGet hnd 512
      size    <- getEntrySize header
484
      BS.hGet hnd (fromIntegral size)
485

486
    getEntrySize :: ByteString -> IO Tar.FileSize
487
488
489
490
491
    getEntrySize header =
      case Tar.read header of
        Tar.Next e _ ->
          case Tar.entryContent e of
            Tar.NormalFile _ size -> return size
492
            Tar.OtherEntryType typecode _ size
493
              | Tar.isBuildTreeRefTypeCode typecode
494
                                  -> return size
495
496
497
            _                     -> interror "unexpected tar entry type"
        _ -> interror "could not read tar file entry"

498
    readPackageDescription :: ByteString -> IO GenericPackageDescription
499
    readPackageDescription content =
500
      case parsePackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content of
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
        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
518
                     | CacheBuildTreeRef BuildTreeRefType BlockNo
refold's avatar
refold committed
519
                     | CachePreference Dependency
520
  deriving (Eq)
521

522
523
524
525
526
527
packageKey, blocknoKey, buildTreeRefKey, preferredVersionKey :: String
packageKey = "pkg:"
blocknoKey = "b#"
buildTreeRefKey     = "build-tree-ref:"
preferredVersionKey = "pref-ver:"

528
529
530
531
readIndexCacheEntry :: BSS.ByteString -> Maybe IndexCacheEntry
readIndexCacheEntry = \line ->
  case BSS.words line of
    [key, pkgnamestr, pkgverstr, sep, blocknostr]
532
      | key == BSS.pack packageKey && sep == BSS.pack blocknoKey ->
refold's avatar
refold committed
533
534
      case (parseName pkgnamestr, parseVer pkgverstr [],
            parseBlockNo blocknostr) of
535
536
537
        (Just pkgname, Just pkgver, Just blockno)
          -> Just (CachePackageId (PackageIdentifier pkgname pkgver) blockno)
        _ -> Nothing
538
    [key, typecodestr, blocknostr] | key == BSS.pack buildTreeRefKey ->
539
540
541
542
543
      case (parseRefType typecodestr, parseBlockNo blocknostr) of
        (Just refType, Just blockno)
          -> Just (CacheBuildTreeRef refType blockno)
        _ -> Nothing

544
    (key: remainder) | key == BSS.pack preferredVersionKey ->
refold's avatar
refold committed
545
      fmap CachePreference (simpleParse (BSS.unpack (BSS.unwords remainder)))
546
    _  -> Nothing
547
  where
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
    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

566
567
568
569
570
571
572
    parseRefType str =
      case BSS.uncons str of
        Just (typeCode, remainder)
          | BSS.null remainder && Tar.isBuildTreeRefTypeCode typeCode
            -> Just (refTypeFromTypeCode typeCode)
        _   -> Nothing

573
showIndexCacheEntry :: IndexCacheEntry -> String
574
575
576
577
578
579
580
581
582
583
584
585
586
587
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
                             ]
588
589

readIndexCache :: BSS.ByteString -> [IndexCacheEntry]
EyalLotem's avatar
EyalLotem committed
590
readIndexCache = mapMaybe readIndexCacheEntry . BSS.lines
591
592
593

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