aboutsummaryrefslogtreecommitdiff
path: root/Annex/Content.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-12-10 14:51:04 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-12-10 14:51:04 -0400
commita373d36d1b1da3a5b7c7e6d681d39f18e787b40f (patch)
tree90379701e02a3988ad2ebb0bbda45edcbc02a205 /Annex/Content.hs
parentdd4d3a4c327948a24bf0e2c7cf82ed66999437aa (diff)
check InodeCache in inAnnex et al
This avoids querying the database when the content file doen't exist (or otherwise fails the provided check). However, it does add overhead of querying the database, and will certianly impact performance.
Diffstat (limited to 'Annex/Content.hs')
-rw-r--r--Annex/Content.hs19
1 files changed, 15 insertions, 4 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index bfc70ac9a..44f1ad0a0 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -84,7 +84,10 @@ inAnnex key = inAnnexCheck key $ liftIO . doesFileExist
inAnnexCheck :: Key -> (FilePath -> Annex Bool) -> Annex Bool
inAnnexCheck key check = inAnnex' id False check key
-{- Generic inAnnex, handling both indirect and direct mode.
+{- inAnnex that performs an arbitrary check of the key's content.
+ -
+ - When the content is unlocked, it must also be unmodified, or the bad
+ - value will be returned.
-
- In direct mode, at least one of the associated files must pass the
- check. Additionally, the file must be unmodified.
@@ -93,9 +96,17 @@ inAnnex' :: (a -> Bool) -> a -> (FilePath -> Annex a) -> Key -> Annex a
inAnnex' isgood bad check key = withObjectLoc key checkindirect checkdirect
where
checkindirect loc = do
- whenM (fromRepo Git.repoIsUrl) $
- error "inAnnex cannot check remote repo"
- check loc
+ r <- check loc
+ if isgood r
+ then do
+ cache <- Database.Keys.getInodeCaches key
+ if null cache
+ then return r
+ else ifM (sameInodeCache loc cache)
+ ( return r
+ , return bad
+ )
+ else return bad
checkdirect [] = return bad
checkdirect (loc:locs) = do
r <- check loc