diff options
| -rw-r--r-- | Annex/Content.hs | 11 | ||||
| -rw-r--r-- | Annex/Content/Direct.hs | 26 |
2 files changed, 25 insertions, 12 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index 3dfb4d864..f0b9b4957 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -187,10 +187,10 @@ prepTmp key = do - and not being copied into place. -} getViaTmpUnchecked :: Key -> (FilePath -> Annex Bool) -> Annex Bool getViaTmpUnchecked key action = do - tmp <- prepTmp key - ifM (action tmp) + tmpfile <- prepTmp key + ifM (action tmpfile) ( do - moveAnnex key tmp + moveAnnex key tmpfile logStatus key InfoPresent return True , do @@ -267,6 +267,7 @@ moveAnnex key src = withObjectLoc key storeobject storedirect ) storedirect [] = storeobject =<< inRepo (gitAnnexLocation key) storedirect (dest:fs) = do + updateCache key src thawContent src liftIO $ replaceFile dest $ moveFile src liftIO $ forM_ fs $ \f -> replaceFile f $ createLink dest @@ -305,7 +306,9 @@ removeAnnex key = withObjectLoc key remove removedirect allowWrite $ parentDir file removeFile file cleanObjectLoc key - removedirect fs = mapM_ resetfile fs + removedirect fs = do + removeCache key + mapM_ resetfile fs resetfile f = do l <- calcGitLink f key top <- fromRepo Git.repoPath diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index e23c6512c..7ab70e612 100644 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -8,8 +8,8 @@ module Annex.Content.Direct ( associatedFiles, unmodifed, - getCache, - showCache, + updateCache, + removeCache ) where import Common.Annex @@ -39,12 +39,22 @@ associatedFiles key = do - expected mtime and inode. -} unmodifed :: Key -> FilePath -> Annex Bool -unmodifed key file = do - cachefile <- inRepo $ gitAnnexCache key - liftIO $ do - curr <- getCache file - old <- catchDefaultIO Nothing $ readCache <$> readFile cachefile - return $ isJust curr && curr == old +unmodifed key file = withCacheFile key $ \cachefile -> do + curr <- getCache file + old <- catchDefaultIO Nothing $ readCache <$> readFile cachefile + return $ isJust curr && curr == old + +{- Stores a cache of attributes for a file that is associated with a key. -} +updateCache :: Key -> FilePath -> Annex () +updateCache key file = withCacheFile key $ \cachefile -> + maybe noop (writeFile cachefile . showCache) =<< getCache file + +{- Removes a cache. -} +removeCache :: Key -> Annex () +removeCache key = withCacheFile key nukeFile + +withCacheFile :: Key -> (FilePath -> IO a) -> Annex a +withCacheFile key a = liftIO . a =<< inRepo (gitAnnexCache key) {- Cache a file's inode, size, and modification time to determine if it's - been changed. -} |