@@ -55,7 +55,7 @@ import Distribution.Text
5555import Distribution.Verbosity
5656 ( Verbosity , normal , lessVerbose )
5757import Distribution.Simple.Utils
58- ( die , warn , info , fromUTF8 , tryFindPackageDesc )
58+ ( die , warn , info , fromUTF8 )
5959
6060import Data.Char (isAlphaNum )
6161import Data.Maybe (mapMaybe , fromMaybe )
@@ -69,7 +69,8 @@ import qualified Data.ByteString.Lazy.Char8 as BS.Char8
6969import qualified Data.ByteString.Char8 as BSS
7070import Data.ByteString.Lazy (ByteString )
7171import Distribution.Client.GZipUtils (maybeDecompress )
72- import Distribution.Client.Utils (byteStringToFilePath )
72+ import Distribution.Client.Utils ( byteStringToFilePath
73+ , tryFindAddSourcePackageDesc )
7374import Distribution.Compat.Exception (catchIO )
7475import Distribution.Client.Compat.Time (getFileAge , getModTime )
7576import System.Directory (doesFileExist )
@@ -351,7 +352,8 @@ extractPkg entry blockNo = case Tar.entryContent entry of
351352 | Tar. isBuildTreeRefTypeCode typeCode ->
352353 Just $ do
353354 let path = byteStringToFilePath content
354- cabalFile <- tryFindPackageDesc path
355+ err = " Error reading package index."
356+ cabalFile <- tryFindAddSourcePackageDesc path err
355357 descr <- PackageDesc.Parse. readPackageDescription normal cabalFile
356358 return $ BuildTreeRef (refTypeFromTypeCode typeCode) (packageId descr)
357359 descr path blockNo
@@ -452,8 +454,9 @@ packageIndexFromCache mkPkg hnd entrs mode = accum mempty [] entrs
452454 -- package id for build tree references - the user might edit the .cabal
453455 -- file after the reference was added to the index.
454456 path <- liftM byteStringToFilePath . getEntryContent $ blockno
455- pkg <- do cabalFile <- tryFindPackageDesc path
456- PackageDesc.Parse. readPackageDescription normal cabalFile
457+ pkg <- do let err = " Error reading package index from cache."
458+ file <- tryFindAddSourcePackageDesc path err
459+ PackageDesc.Parse. readPackageDescription normal file
457460 let srcpkg = mkPkg (BuildTreeRef refType (packageId pkg) pkg path blockno)
458461 accum (srcpkg: srcpkgs) prefs entries
459462
@@ -503,31 +506,32 @@ data IndexCacheEntry = CachePackageId PackageId BlockNo
503506 | CachePreference Dependency
504507 deriving (Eq )
505508
509+ packageKey , blocknoKey , buildTreeRefKey , preferredVersionKey :: String
510+ packageKey = " pkg:"
511+ blocknoKey = " b#"
512+ buildTreeRefKey = " build-tree-ref:"
513+ preferredVersionKey = " pref-ver:"
514+
506515readIndexCacheEntry :: BSS. ByteString -> Maybe IndexCacheEntry
507516readIndexCacheEntry = \ line ->
508517 case BSS. words line of
509518 [key, pkgnamestr, pkgverstr, sep, blocknostr]
510- | key == packageKey && sep == blocknoKey ->
519+ | key == BSS. pack packageKey && sep == BSS. pack blocknoKey ->
511520 case (parseName pkgnamestr, parseVer pkgverstr [] ,
512521 parseBlockNo blocknostr) of
513522 (Just pkgname, Just pkgver, Just blockno)
514523 -> Just (CachePackageId (PackageIdentifier pkgname pkgver) blockno)
515524 _ -> Nothing
516- [key, typecodestr, blocknostr] | key == buildTreeRefKey ->
525+ [key, typecodestr, blocknostr] | key == BSS. pack buildTreeRefKey ->
517526 case (parseRefType typecodestr, parseBlockNo blocknostr) of
518527 (Just refType, Just blockno)
519528 -> Just (CacheBuildTreeRef refType blockno)
520529 _ -> Nothing
521530
522- (key: remainder) | key == preferredVersionKey ->
531+ (key: remainder) | key == BSS. pack preferredVersionKey ->
523532 fmap CachePreference (simpleParse (BSS. unpack (BSS. unwords remainder)))
524533 _ -> Nothing
525534 where
526- packageKey = BSS. pack " pkg:"
527- blocknoKey = BSS. pack " b#"
528- buildTreeRefKey = BSS. pack " build-tree-ref:"
529- preferredVersionKey = BSS. pack " pref-ver:"
530-
531535 parseName str
532536 | BSS. all (\ c -> isAlphaNum c || c == ' -' ) str
533537 = Just (PackageName (BSS. unpack str))
@@ -554,13 +558,20 @@ readIndexCacheEntry = \line ->
554558 _ -> Nothing
555559
556560showIndexCacheEntry :: IndexCacheEntry -> String
557- showIndexCacheEntry entry = case entry of
558- CachePackageId pkgid b -> " pkg: " ++ display (packageName pkgid)
559- ++ " " ++ display (packageVersion pkgid)
560- ++ " b# " ++ show b
561- CacheBuildTreeRef t b -> " build-tree-ref: " ++ (typeCodeFromRefType t: " " )
562- ++ show b
563- CachePreference dep -> " pref-ver: " ++ display dep
561+ showIndexCacheEntry entry = unwords $ case entry of
562+ CachePackageId pkgid b -> [ packageKey
563+ , display (packageName pkgid)
564+ , display (packageVersion pkgid)
565+ , blocknoKey
566+ , show b
567+ ]
568+ CacheBuildTreeRef t b -> [ buildTreeRefKey
569+ , [typeCodeFromRefType t]
570+ , show b
571+ ]
572+ CachePreference dep -> [ preferredVersionKey
573+ , display dep
574+ ]
564575
565576readIndexCache :: BSS. ByteString -> [IndexCacheEntry ]
566577readIndexCache = mapMaybe readIndexCacheEntry . BSS. lines
0 commit comments