update the cache automatically when moving objects in or out
This commit is contained in:
parent
78498719a0
commit
664765e757
2 changed files with 25 additions and 12 deletions
|
@ -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
|
||||
|
|
|
@ -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. -}
|
||||
|
|
Loading…
Reference in a new issue