Commit f9dc00da authored by Edsko de Vries's avatar Edsko de Vries
Browse files

Introduce readBuildTreeRefsFromCache

and simplify listBuildTreeRefs. This is just a refactoring, no actual change in
functionality.
parent 9c4c47db
......@@ -17,13 +17,14 @@ module Distribution.Client.IndexUtils (
getIndexFileAge,
getInstalledPackages,
getSourcePackages,
getSourcePackagesStrict,
Index(..),
PackageEntry(..),
parsePackageIndex,
readRepoIndex,
updateRepoIndexCache,
updatePackageIndexCacheFile,
readCacheStrict,
BuildTreeRefType(..), refTypeFromTypeCode, typeCodeFromRefType
) where
......@@ -113,12 +114,6 @@ getSourcePackages :: Verbosity -> [Repo] -> IO SourcePackageDb
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
......@@ -143,6 +138,13 @@ getSourcePackages' verbosity repos mode = do
packagePreferences = prefs'
}
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
-- | Read a repository index from disk, from the local file specified by
-- the 'Repo'.
--
......@@ -421,21 +423,30 @@ readPackageIndexCacheFile mkPkg index mode = do
ReadPackageIndexLazyIO -> do indexHnd <- openFile f m
act indexHnd
packageIndexFromCache :: Package pkg
=> (PackageEntry -> pkg)
-> Handle
-> Cache
-> ReadPackageIndexMode
-> IO (PackageIndex pkg, [Dependency])
packageIndexFromCache mkPkg hnd Cache{..} mode = accum mempty [] cacheEntries
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
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 [] = return (reverse srcpkgs, prefs)
accum srcpkgs prefs (CachePackageId pkgid blockno : entries) = do
-- Given the cache entry, make a package index entry.
......
......@@ -24,12 +24,9 @@ import Distribution.Client.IndexUtils ( BuildTreeRefType(..)
, refTypeFromTypeCode
, typeCodeFromRefType
, updatePackageIndexCacheFile
, getSourcePackagesStrict
, readCacheStrict
, Index(..) )
import Distribution.Client.PackageIndex ( allPackages )
import Distribution.Client.Types ( Repo(..)
, SourcePackageDb(..)
, SourcePackage(..), PackageLocation(..) )
import qualified Distribution.Client.IndexUtils as IndexUtils
import Distribution.Client.Utils ( byteStringToFilePath, filePathToByteString
, makeAbsoluteToCwd, tryCanonicalizePath
, tryFindAddSourcePackageDesc )
......@@ -93,6 +90,17 @@ readBuildTreeRefs =
readBuildTreeRefsFromFile :: FilePath -> IO [BuildTreeRef]
readBuildTreeRefsFromFile = liftM (readBuildTreeRefs . Tar.read) . BS.readFile
-- | Read build tree references from an index cache
readBuildTreeRefsFromCache :: Verbosity -> FilePath -> IO [BuildTreeRef]
readBuildTreeRefsFromCache verbosity indexPath = do
(mRefs, _prefs) <- readCacheStrict verbosity (SandboxIndex indexPath) buildTreeRef
return (catMaybes mRefs)
where
buildTreeRef pkgEntry =
case pkgEntry of
IndexUtils.NormalPackage _ _ _ _ -> Nothing
IndexUtils.BuildTreeRef typ _ _ path _ -> Just $ BuildTreeRef typ path
-- | Given a local build tree ref, serialise it to a tar archive entry.
writeBuildTreeRef :: BuildTreeRef -> Tar.Entry
writeBuildTreeRef (BuildTreeRef refType path) = Tar.simpleEntry tarPath content
......@@ -260,15 +268,11 @@ listBuildTreeRefs verbosity listIgnored refTypesToList path = do
LinksAndSnapshots -> const True
listWithIgnored :: IO [BuildTreeRef]
listWithIgnored = readBuildTreeRefsFromFile $ path
listWithIgnored = readBuildTreeRefsFromFile path
listWithoutIgnored :: IO [FilePath]
listWithoutIgnored = do
let repo = RepoLocal { repoLocalDir = takeDirectory path }
pkgIndex <- fmap packageIndex
. getSourcePackagesStrict verbosity $ [repo]
return [ pkgPath | (LocalUnpackedPackage pkgPath) <-
map packageSource . allPackages $ pkgIndex ]
listWithoutIgnored = fmap (map buildTreePath)
$ readBuildTreeRefsFromCache verbosity path
-- | Check that the package index file exists and exit with error if it does not.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment