From 048eaa14522fdbdf84ae0cb3215e75db9af83f5e Mon Sep 17 00:00:00 2001
From: Mikhail Glushenkov <mikhail.glushenkov@gmail.com>
Date: Thu, 9 May 2013 22:22:59 +0200
Subject: [PATCH] Avoid the timestamp check for `add-source --snapshot`
dependencies.
Snapshot deps now behave more like `cabal-dev add-source`. Implemented by adding
a BuildTreeRefType field to the BuildRef index entry.
Fixes #1321.
---
.../Distribution/Client/IndexUtils.hs | 71 +++++++----
cabal-install/Distribution/Client/Sandbox.hs | 18 +--
.../Distribution/Client/Sandbox/Index.hs | 111 ++++++++++++------
.../Distribution/Client/Sandbox/Timestamp.hs | 6 +-
cabal-install/Distribution/Client/Tar.hs | 13 ++
5 files changed, 150 insertions(+), 69 deletions(-)
diff --git a/cabal-install/Distribution/Client/IndexUtils.hs b/cabal-install/Distribution/Client/IndexUtils.hs
index 3a57e619ec..9a2c463578 100644
--- a/cabal-install/Distribution/Client/IndexUtils.hs
+++ b/cabal-install/Distribution/Client/IndexUtils.hs
@@ -20,6 +20,8 @@ module Distribution.Client.IndexUtils (
parsePackageIndex,
readRepoIndex,
updateRepoIndexCache,
+
+ BuildTreeRefType(..), refTypeFromTypeCode, typeCodeFromRefType
) where
import qualified Distribution.Client.Tar as Tar
@@ -189,8 +191,8 @@ readRepoIndex verbosity repo mode =
packageInfoId = pkgid,
packageDescription = packageDesc pkgEntry,
packageSource = case pkgEntry of
- NormalPackage _ _ _ _ -> RepoTarballPackage repo pkgid Nothing
- BuildTreeRef _ _ path _ -> LocalUnpackedPackage path,
+ NormalPackage _ _ _ _ -> RepoTarballPackage repo pkgid Nothing
+ BuildTreeRef _ _ _ path _ -> LocalUnpackedPackage path,
packageDescrOverride = case pkgEntry of
NormalPackage _ _ pkgtxt _ -> Just pkgtxt
_ -> Nothing
@@ -250,17 +252,33 @@ whenCacheOutOfDate origFile cacheFile action = do
-- | An index entry is either a normal package, or a local build tree reference.
data PackageEntry =
NormalPackage PackageId GenericPackageDescription ByteString BlockNo
- | BuildTreeRef PackageId GenericPackageDescription FilePath BlockNo
+ | 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
type MkPackageEntry = IO PackageEntry
instance Package PackageEntry where
- packageId (NormalPackage pkgid _ _ _) = pkgid
- packageId (BuildTreeRef pkgid _ _ _) = pkgid
+ packageId (NormalPackage pkgid _ _ _) = pkgid
+ packageId (BuildTreeRef _ pkgid _ _ _) = pkgid
packageDesc :: PackageEntry -> GenericPackageDescription
-packageDesc (NormalPackage _ descr _ _) = descr
-packageDesc (BuildTreeRef _ descr _ _) = descr
+packageDesc (NormalPackage _ descr _ _) = descr
+packageDesc (BuildTreeRef _ _ descr _ _) = descr
-- | Read a compressed \"00-index.tar.gz\" file into a 'PackageIndex'.
--
@@ -332,12 +350,13 @@ extractPkg entry blockNo = case Tar.entryContent entry of
_ -> Nothing
Tar.OtherEntryType typeCode content _
- | typeCode == Tar.buildTreeRefTypeCode ->
+ | Tar.isBuildTreeRefTypeCode typeCode ->
Just $ do
let path = byteStringToFilePath content
cabalFile <- findPackageDesc path
descr <- PackageDesc.Parse.readPackageDescription normal cabalFile
- return $ BuildTreeRef (packageId descr) descr path blockNo
+ return $ BuildTreeRef (refTypeFromTypeCode typeCode) (packageId descr)
+ descr path blockNo
_ -> Nothing
@@ -375,8 +394,8 @@ updatePackageIndexCacheFile indexFile cacheFile = do
[ CachePreference pref | pref <- prefs ]
++ [ CachePackageId pkgid blockNo
| (NormalPackage pkgid _ _ blockNo) <- pkgs ]
- ++ [ CacheBuildTreeRef blockNo
- | (BuildTreeRef _ _ _ blockNo) <- pkgs]
+ ++ [ CacheBuildTreeRef refType blockNo
+ | (BuildTreeRef refType _ _ _ blockNo) <- pkgs]
data ReadPackageIndexMode = ReadPackageIndexStrict
| ReadPackageIndexLazyIO
@@ -430,14 +449,14 @@ packageIndexFromCache mkPkg hnd entrs mode = accum mempty [] entrs
pkgtxt blockno)
accum (srcpkg:srcpkgs) prefs entries
- accum srcpkgs prefs (CacheBuildTreeRef blockno : entries) = do
+ accum srcpkgs prefs (CacheBuildTreeRef refType blockno : entries) = do
-- 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.
path <- liftM byteStringToFilePath . getEntryContent $ blockno
pkg <- do cabalFile <- findPackageDesc path
PackageDesc.Parse.readPackageDescription normal cabalFile
- let srcpkg = mkPkg (BuildTreeRef (packageId pkg) pkg path blockno)
+ let srcpkg = mkPkg (BuildTreeRef refType (packageId pkg) pkg path blockno)
accum (srcpkg:srcpkgs) prefs entries
accum srcpkgs prefs (CachePreference pref : entries) =
@@ -457,7 +476,7 @@ packageIndexFromCache mkPkg hnd entrs mode = accum mempty [] entrs
case Tar.entryContent e of
Tar.NormalFile _ size -> return size
Tar.OtherEntryType typecode _ size
- | typecode == Tar.buildTreeRefTypeCode
+ | Tar.isBuildTreeRefTypeCode typecode
-> return size
_ -> interror "unexpected tar entry type"
_ -> interror "could not read tar file entry"
@@ -482,9 +501,9 @@ packageIndexFromCache mkPkg hnd entrs mode = accum mempty [] entrs
type BlockNo = Int
data IndexCacheEntry = CachePackageId PackageId BlockNo
- | CacheBuildTreeRef BlockNo
+ | CacheBuildTreeRef BuildTreeRefType BlockNo
| CachePreference Dependency
- deriving (Eq, Show)
+ deriving (Eq)
readIndexCacheEntry :: BSS.ByteString -> Maybe IndexCacheEntry
readIndexCacheEntry = \line ->
@@ -496,10 +515,12 @@ readIndexCacheEntry = \line ->
(Just pkgname, Just pkgver, Just blockno)
-> Just (CachePackageId (PackageIdentifier pkgname pkgver) blockno)
_ -> Nothing
- [key, blocknostr] | key == buildTreeRefKey ->
- case parseBlockNo blocknostr of
- Just blockno -> Just (CacheBuildTreeRef blockno)
- _ -> Nothing
+ [key, typecodestr, blocknostr] | key == buildTreeRefKey ->
+ case (parseRefType typecodestr, parseBlockNo blocknostr) of
+ (Just refType, Just blockno)
+ -> Just (CacheBuildTreeRef refType blockno)
+ _ -> Nothing
+
(key: remainder) | key == preferredVersionKey ->
fmap CachePreference (simpleParse (BSS.unpack (BSS.unwords remainder)))
_ -> Nothing
@@ -527,12 +548,20 @@ readIndexCacheEntry = \line ->
Just (blockno, remainder) | BSS.null remainder -> Just blockno
_ -> Nothing
+ parseRefType str =
+ case BSS.uncons str of
+ Just (typeCode, remainder)
+ | BSS.null remainder && Tar.isBuildTreeRefTypeCode typeCode
+ -> Just (refTypeFromTypeCode typeCode)
+ _ -> Nothing
+
showIndexCacheEntry :: IndexCacheEntry -> String
showIndexCacheEntry entry = case entry of
CachePackageId pkgid b -> "pkg: " ++ display (packageName pkgid)
++ " " ++ display (packageVersion pkgid)
++ " b# " ++ show b
- CacheBuildTreeRef b -> "build-tree-ref: " ++ show b
+ CacheBuildTreeRef t b -> "build-tree-ref: " ++ (typeCodeFromRefType t:" ")
+ ++ show b
CachePreference dep -> "pref-ver: " ++ display dep
readIndexCache :: BSS.ByteString -> [IndexCacheEntry]
diff --git a/cabal-install/Distribution/Client/Sandbox.hs b/cabal-install/Distribution/Client/Sandbox.hs
index ae18b62793..8ce48b0abb 100644
--- a/cabal-install/Distribution/Client/Sandbox.hs
+++ b/cabal-install/Distribution/Client/Sandbox.hs
@@ -46,6 +46,7 @@ import Distribution.Client.Sandbox.Timestamp ( maybeAddCompilerTimestampRecord
, withModifiedDeps )
import Distribution.Client.Config ( SavedConfig(..), loadConfig )
import Distribution.Client.Dependency ( foldProgress )
+import Distribution.Client.IndexUtils ( BuildTreeRefType(..) )
import Distribution.Client.Install ( InstallArgs,
makeInstallContext,
makeInstallPlan,
@@ -288,8 +289,10 @@ sandboxDelete verbosity _sandboxFlags globalFlags = do
removeDirectoryRecursive sandboxDir
-- Common implementation of 'sandboxAddSource' and 'sandboxAddSourceSnapshot'.
-doAddSource :: Verbosity -> [FilePath] -> FilePath -> PackageEnvironment -> IO ()
-doAddSource verbosity buildTreeRefs sandboxDir pkgEnv = do
+doAddSource :: Verbosity -> [FilePath] -> FilePath -> PackageEnvironment
+ -> BuildTreeRefType
+ -> IO ()
+doAddSource verbosity buildTreeRefs sandboxDir pkgEnv refType = do
let savedConfig = pkgEnvSavedConfig pkgEnv
indexFile <- tryGetIndexFilePath savedConfig
@@ -303,7 +306,7 @@ doAddSource verbosity buildTreeRefs sandboxDir pkgEnv = do
-- FIXME: path canonicalisation is done in addBuildTreeRefs, but we do it
-- twice because of the timestamps file.
buildTreeRefs' <- mapM tryCanonicalizePath buildTreeRefs
- Index.addBuildTreeRefs verbosity indexFile buildTreeRefs'
+ Index.addBuildTreeRefs verbosity indexFile buildTreeRefs' refType
return buildTreeRefs'
-- | Entry point for the 'cabal sandbox add-source' command.
@@ -315,7 +318,7 @@ sandboxAddSource verbosity buildTreeRefs sandboxFlags globalFlags = do
if fromFlagOrDefault False (sandboxSnapshot sandboxFlags)
then sandboxAddSourceSnapshot verbosity buildTreeRefs sandboxDir pkgEnv
- else doAddSource verbosity buildTreeRefs sandboxDir pkgEnv
+ else doAddSource verbosity buildTreeRefs sandboxDir pkgEnv LinkRef
-- | Entry point for the 'cabal sandbox add-source --snapshot' command.
sandboxAddSourceSnapshot :: Verbosity -> [FilePath] -> FilePath
@@ -360,7 +363,7 @@ sandboxAddSourceSnapshot verbosity buildTreeRefs sandboxDir pkgEnv = do
return targetDir
-- Once the packages are copied, just 'add-source' them as usual.
- doAddSource verbosity snapshots sandboxDir pkgEnv
+ doAddSource verbosity snapshots sandboxDir pkgEnv SnapshotRef
-- | Entry point for the 'cabal sandbox delete-source' command.
sandboxDeleteSource :: Verbosity -> [FilePath] -> SandboxFlags -> GlobalFlags
@@ -385,7 +388,8 @@ sandboxListSources verbosity _sandboxFlags globalFlags = do
(globalConfigFile globalFlags)
indexFile <- tryGetIndexFilePath (pkgEnvSavedConfig pkgEnv)
- refs <- Index.listBuildTreeRefs verbosity Index.ListIgnored indexFile
+ refs <- Index.listBuildTreeRefs verbosity
+ Index.ListIgnored Index.LinksAndSnapshots indexFile
when (null refs) $
notice verbosity $ "Index file '" ++ indexFile
++ "' has no references to local build trees."
@@ -477,7 +481,7 @@ reinstallAddSourceDeps verbosity config configFlags' configExFlags
{ configDistPref = Flag (sandboxBuildDir sandboxDir) }
indexFile <- tryGetIndexFilePath config
buildTreeRefs <- Index.listBuildTreeRefs verbosity
- Index.DontListIgnored indexFile
+ Index.DontListIgnored Index.OnlyLinks indexFile
retVal <- newIORef NoDepsReinstalled
unless (null buildTreeRefs) $ do
diff --git a/cabal-install/Distribution/Client/Sandbox/Index.hs b/cabal-install/Distribution/Client/Sandbox/Index.hs
index c4f4d39eb5..8c1038650c 100644
--- a/cabal-install/Distribution/Client/Sandbox/Index.hs
+++ b/cabal-install/Distribution/Client/Sandbox/Index.hs
@@ -11,7 +11,7 @@ module Distribution.Client.Sandbox.Index (
createEmpty,
addBuildTreeRefs,
removeBuildTreeRefs,
- ListIgnoredBuildTreeRefs(..),
+ ListIgnoredBuildTreeRefs(..), RefTypesToList(..),
listBuildTreeRefs,
validateIndexPath,
@@ -19,7 +19,10 @@ module Distribution.Client.Sandbox.Index (
) where
import qualified Distribution.Client.Tar as Tar
-import Distribution.Client.IndexUtils ( getSourcePackagesStrict )
+import Distribution.Client.IndexUtils ( BuildTreeRefType(..)
+ , refTypeFromTypeCode
+ , typeCodeFromRefType
+ , getSourcePackagesStrict )
import Distribution.Client.PackageIndex ( allPackages )
import Distribution.Client.Types ( Repo(..), LocalRepo(..)
, SourcePackageDb(..)
@@ -33,7 +36,7 @@ import Distribution.Verbosity ( Verbosity )
import qualified Data.ByteString.Lazy as BS
import Control.Exception ( evaluate )
import Control.Monad ( liftM, unless )
-import Data.List ( (\\), nub )
+import Data.List ( (\\), intersect, nub )
import Data.Maybe ( catMaybes )
import System.Directory ( createDirectoryIfMissing,
doesDirectoryExist, doesFileExist,
@@ -43,55 +46,56 @@ import System.IO ( IOMode(..), SeekMode(..)
, hSeek, withBinaryFile )
-- | A reference to a local build tree.
-newtype BuildTreeRef = BuildTreeRef {
- buildTreePath :: FilePath
+data BuildTreeRef = BuildTreeRef {
+ buildTreeRefType :: !BuildTreeRefType,
+ buildTreePath :: !FilePath
}
defaultIndexFileName :: FilePath
defaultIndexFileName = "00-index.tar"
-- | Given a path, ensure that it refers to a local build tree.
-buildTreeRefFromPath :: FilePath -> IO (Maybe BuildTreeRef)
-buildTreeRefFromPath dir = do
+buildTreeRefFromPath :: BuildTreeRefType -> FilePath -> IO (Maybe BuildTreeRef)
+buildTreeRefFromPath refType dir = do
dirExists <- doesDirectoryExist dir
unless dirExists $
die $ "directory '" ++ dir ++ "' does not exist"
_ <- findPackageDesc dir
- return . Just $ BuildTreeRef { buildTreePath = dir }
+ return . Just $ BuildTreeRef refType dir
-- | Given a tar archive entry, try to parse it as a local build tree reference.
-readBuildTreePath :: Tar.Entry -> Maybe FilePath
-readBuildTreePath entry = case Tar.entryContent entry of
+readBuildTreeRef :: Tar.Entry -> Maybe BuildTreeRef
+readBuildTreeRef entry = case Tar.entryContent entry of
(Tar.OtherEntryType typeCode bs size)
- | (typeCode == Tar.buildTreeRefTypeCode)
- && (size == BS.length bs) -> Just $ byteStringToFilePath bs
+ | (Tar.isBuildTreeRefTypeCode typeCode)
+ && (size == BS.length bs) -> Just $! BuildTreeRef
+ (refTypeFromTypeCode typeCode)
+ (byteStringToFilePath bs)
| otherwise -> Nothing
_ -> Nothing
-- | Given a sequence of tar archive entries, extract all references to local
-- build trees.
-readBuildTreePaths :: Tar.Entries -> [FilePath]
-readBuildTreePaths =
+readBuildTreeRefs :: Tar.Entries -> [BuildTreeRef]
+readBuildTreeRefs =
catMaybes
- . Tar.foldrEntries (\e r -> readBuildTreePath e : r)
+ . Tar.foldrEntries (\e r -> readBuildTreeRef e : r)
[] error
-- | Given a path to a tar archive, extract all references to local build trees.
-readBuildTreePathsFromFile :: FilePath -> IO [FilePath]
-readBuildTreePathsFromFile = liftM (readBuildTreePaths . Tar.read)
- . BS.readFile
+readBuildTreeRefsFromFile :: FilePath -> IO [BuildTreeRef]
+readBuildTreeRefsFromFile = liftM (readBuildTreeRefs . Tar.read) . BS.readFile
--- | Given a local build tree, serialise it to a tar archive entry.
+-- | Given a local build tree ref, serialise it to a tar archive entry.
writeBuildTreeRef :: BuildTreeRef -> Tar.Entry
-writeBuildTreeRef lbt = Tar.simpleEntry tarPath content
+writeBuildTreeRef (BuildTreeRef refType path) = Tar.simpleEntry tarPath content
where
bs = filePathToByteString path
- path = buildTreePath lbt
- -- fromRight can't fail because the path is shorter than 255 characters.
- tarPath = fromRight $ Tar.toTarPath True tarPath'
-- Provide a filename for tools that treat custom entries as ordinary files.
tarPath' = "local-build-tree-reference"
- content = Tar.OtherEntryType Tar.buildTreeRefTypeCode bs (BS.length bs)
+ -- fromRight can't fail because the path is shorter than 255 characters.
+ tarPath = fromRight $ Tar.toTarPath True tarPath'
+ content = Tar.OtherEntryType (typeCodeFromRefType refType) bs (BS.length bs)
-- TODO: Move this to D.C.Utils?
fromRight (Left err) = error err
@@ -123,15 +127,16 @@ createEmpty verbosity path = do
BS.writeFile path zeros
-- | Add given local build tree references to the index.
-addBuildTreeRefs :: Verbosity -> FilePath -> [FilePath] -> IO ()
-addBuildTreeRefs _ _ [] =
+addBuildTreeRefs :: Verbosity -> FilePath -> [FilePath] -> BuildTreeRefType
+ -> IO ()
+addBuildTreeRefs _ _ [] _ =
error "Distribution.Client.Sandbox.Index.addBuildTreeRefs: unexpected"
-addBuildTreeRefs verbosity path l' = do
+addBuildTreeRefs verbosity path l' refType = do
checkIndexExists path
l <- liftM nub . mapM tryCanonicalizePath $ l'
- treesInIndex <- readBuildTreePathsFromFile path
+ treesInIndex <- fmap (map buildTreePath) (readBuildTreeRefsFromFile path)
-- Add only those paths that aren't already in the index.
- treesToAdd <- mapM buildTreeRefFromPath (l \\ treesInIndex)
+ treesToAdd <- mapM (buildTreeRefFromPath refType) (l \\ treesInIndex)
let entries = map writeBuildTreeRef (catMaybes treesToAdd)
unless (null entries) $ do
offset <-
@@ -162,9 +167,12 @@ removeBuildTreeRefs verbosity path l' = do
debug verbosity $ "Successfully renamed '" ++ tmpFile
++ "' to '" ++ path ++ "'"
where
- p l entry = case readBuildTreePath entry of
- Nothing -> True
- (Just pth) -> pth `notElem` l
+ p l entry = case readBuildTreeRef entry of
+ Nothing -> True
+ -- FIXME: removing snapshot deps is done with `delete-source
+ -- .cabal-sandbox/snapshots/$SNAPSHOT_NAME`. Perhaps we also want to
+ -- support removing snapshots by providing the original path.
+ (Just (BuildTreeRef _ pth)) -> pth `notElem` l
-- | A build tree ref can become ignored if the user later adds a build tree ref
-- with the same package ID. We display ignored build tree refs when the user
@@ -172,14 +180,44 @@ removeBuildTreeRefs verbosity path l' = do
-- 'reinstallAddSourceDeps'.
data ListIgnoredBuildTreeRefs = ListIgnored | DontListIgnored
+-- | Which types of build tree refs should be listed?
+data RefTypesToList = OnlySnapshots | OnlyLinks | LinksAndSnapshots
+
-- | List the local build trees that are referred to from the index.
-listBuildTreeRefs :: Verbosity -> ListIgnoredBuildTreeRefs -> FilePath
+listBuildTreeRefs :: Verbosity -> ListIgnoredBuildTreeRefs -> RefTypesToList
+ -> FilePath
-> IO [FilePath]
-listBuildTreeRefs verbosity listIgnored path = do
+listBuildTreeRefs verbosity listIgnored refTypesToList path = do
checkIndexExists path
buildTreeRefs <-
case listIgnored of
DontListIgnored -> do
+ paths <- listWithoutIgnored
+ case refTypesToList of
+ LinksAndSnapshots -> return paths
+ _ -> do
+ allPathsFiltered <- fmap (map buildTreePath . filter predicate)
+ listWithIgnored
+ _ <- evaluate (length allPathsFiltered)
+ return (paths `intersect` allPathsFiltered)
+
+ ListIgnored -> fmap (map buildTreePath . filter predicate) listWithIgnored
+
+ _ <- evaluate (length buildTreeRefs)
+ return buildTreeRefs
+
+ where
+ predicate :: BuildTreeRef -> Bool
+ predicate = case refTypesToList of
+ OnlySnapshots -> (==) SnapshotRef . buildTreeRefType
+ OnlyLinks -> (==) LinkRef . buildTreeRefType
+ LinksAndSnapshots -> const True
+
+ listWithIgnored :: IO [BuildTreeRef]
+ listWithIgnored = readBuildTreeRefsFromFile $ path
+
+ listWithoutIgnored :: IO [FilePath]
+ listWithoutIgnored = do
let repo = Repo { repoKind = Right LocalRepo
, repoLocalDir = takeDirectory path }
pkgIndex <- fmap packageIndex
@@ -187,11 +225,6 @@ listBuildTreeRefs verbosity listIgnored path = do
return [ pkgPath | (LocalUnpackedPackage pkgPath) <-
map packageSource . allPackages $ pkgIndex ]
- ListIgnored -> readBuildTreePathsFromFile path
-
- _ <- evaluate (length buildTreeRefs)
- return buildTreeRefs
-
-- | Check that the package index file exists and exit with error if it does not.
checkIndexExists :: FilePath -> IO ()
diff --git a/cabal-install/Distribution/Client/Sandbox/Timestamp.hs b/cabal-install/Distribution/Client/Sandbox/Timestamp.hs
index 3b4e77d884..0e7729cc1a 100644
--- a/cabal-install/Distribution/Client/Sandbox/Timestamp.hs
+++ b/cabal-install/Distribution/Client/Sandbox/Timestamp.hs
@@ -41,7 +41,8 @@ import Distribution.Version (Version (..),
orLaterVersion)
import Distribution.Client.Sandbox.Index
- (ListIgnoredBuildTreeRefs (..), listBuildTreeRefs)
+ (ListIgnoredBuildTreeRefs (DontListIgnored), RefTypesToList(OnlyLinks)
+ ,listBuildTreeRefs)
import Distribution.Client.SetupWrapper (SetupScriptOptions (..),
defaultSetupScriptOptions,
setupWrapper)
@@ -141,7 +142,8 @@ maybeAddCompilerTimestampRecord :: Verbosity -> FilePath -> FilePath
-> IO ()
maybeAddCompilerTimestampRecord verbosity sandboxDir indexFile
compId platform = do
- buildTreeRefs <- listBuildTreeRefs verbosity DontListIgnored indexFile
+ buildTreeRefs <- listBuildTreeRefs verbosity DontListIgnored OnlyLinks
+ indexFile
withTimestampFile sandboxDir $ \timestampRecords -> do
let key = timestampRecordKey compId platform
case lookup key timestampRecords of
diff --git a/cabal-install/Distribution/Client/Tar.hs b/cabal-install/Distribution/Client/Tar.hs
index ead2dfbc20..9dd546fbc5 100644
--- a/cabal-install/Distribution/Client/Tar.hs
+++ b/cabal-install/Distribution/Client/Tar.hs
@@ -40,6 +40,8 @@ module Distribution.Client.Tar (
TypeCode,
Format(..),
buildTreeRefTypeCode,
+ buildTreeSnapshotTypeCode,
+ isBuildTreeRefTypeCode,
entrySizeInBlocks,
entrySizeInBytes,
@@ -159,6 +161,17 @@ data Entry = Entry {
buildTreeRefTypeCode :: TypeCode
buildTreeRefTypeCode = 'C'
+-- | Type code for the local build tree snapshot entry type.
+buildTreeSnapshotTypeCode :: TypeCode
+buildTreeSnapshotTypeCode = 'S'
+
+-- | Is this a type code for a build tree reference?
+isBuildTreeRefTypeCode :: TypeCode -> Bool
+isBuildTreeRefTypeCode typeCode
+ | (typeCode == buildTreeRefTypeCode
+ || typeCode == buildTreeSnapshotTypeCode) = True
+ | otherwise = False
+
-- | Native 'FilePath' of the file or directory within the archive.
--
entryPath :: Entry -> FilePath
--
GitLab