Commit 19ad156b authored by martinvlk's avatar martinvlk
Browse files

Addressing another round of review comments.

parent 3c3a001b
......@@ -453,7 +453,7 @@ sandboxDeleteSource verbosity buildTreeRefs _sandboxFlags globalFlags = do
indexFile <- tryGetIndexFilePath (pkgEnvSavedConfig pkgEnv)
(removedPaths, convDict) <- Index.removeBuildTreeRefs verbosity indexFile buildTreeRefs
withRemoveTimestamps sandboxDir $ return removedPaths
withRemoveTimestamps sandboxDir removedPaths
let removedRefs = fmap (convertWith convDict) removedPaths
......
......@@ -157,7 +157,12 @@ addBuildTreeRefs verbosity path l' refType = do
(path `replaceExtension` "cache")
-- | Remove given local build tree references from the index.
removeBuildTreeRefs :: Verbosity -> FilePath -> [FilePath] -> IO ([FilePath], [(FilePath, FilePath)])
removeBuildTreeRefs :: Verbosity -> FilePath -> [FilePath]
-> IO ([FilePath], [(FilePath, FilePath)]) -- ^ A tuple consisting of:
-- * removed build tree refs
-- * and mappings from provided
-- build tree refs to corresponding
-- full directory paths)
removeBuildTreeRefs _ _ [] =
error "Distribution.Client.Sandbox.Index.removeBuildTreeRefs: unexpected"
removeBuildTreeRefs verbosity indexPath l' = do
......@@ -183,16 +188,16 @@ removeBuildTreeRefs verbosity indexPath l' = do
where
doRemove srcRefs tmpFile = do
(newIdx, changedPaths) <- Tar.read `fmap` BS.readFile indexPath
>>= runWriterT . Tar.filterEntriesM (p srcRefs)
>>= runWriterT . Tar.filterEntriesM (p $ fmap snd srcRefs)
BS.writeFile tmpFile $ Tar.writeEntries newIdx
return changedPaths
p :: [(FilePath, FilePath)] -> Tar.Entry -> WriterT [FilePath] IO Bool
p :: [FilePath] -> Tar.Entry -> WriterT [FilePath] IO Bool
p refs entry = case readBuildTreeRef entry of
Nothing -> return 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)) -> if pth `elem` fmap snd refs
(Just (BuildTreeRef _ pth)) -> if pth `elem` refs
then tell [pth] >> return False
else return True
......
......@@ -159,10 +159,11 @@ withAddTimestamps sandboxDir act = do
let initialTimestamp = 0
withActionOnAllTimestamps (addTimestamps initialTimestamp) sandboxDir act
-- | Given an IO action that returns a list of build tree refs, remove those
-- | Given a list of build tree refs, remove those
-- build tree refs from the timestamps file (for all compilers).
withRemoveTimestamps :: FilePath -> IO [FilePath] -> IO ()
withRemoveTimestamps = withActionOnAllTimestamps removeTimestamps
withRemoveTimestamps :: FilePath -> [FilePath] -> IO ()
withRemoveTimestamps idxFile =
withActionOnAllTimestamps removeTimestamps idxFile . return
-- | Given an IO action that returns a list of build tree refs, update the
-- timestamps of the returned build tree refs to the current time (only for the
......
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