summaryrefslogtreecommitdiff
path: root/Annex
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-11-09 18:33:15 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-11-09 18:33:15 -0400
commitd3e1a3619ff6939367f43cbd46131b7f60ef6bd0 (patch)
treebc7e29364f11d3369730b0b61ad58e942b95d1cf /Annex
parent2934a65ac5bbab5ac127c495c8c2492e729c2b67 (diff)
safer inannex checking
git-annex-shell inannex now returns always 0, 1, or 100 (the last when it's unclear if content is currently in the index due to it currently being moved or dropped). (Actual locking code still not yet written.)
Diffstat (limited to 'Annex')
-rw-r--r--Annex/Content.hs36
1 files changed, 24 insertions, 12 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index dc714276d..efe12bb5d 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -7,8 +7,8 @@
module Annex.Content (
inAnnex,
- lockExclusive,
- lockShared,
+ inAnnexSafe,
+ lockContent,
calcGitLink,
logStatus,
getViaTmp,
@@ -36,22 +36,34 @@ import Types.Key
import Utility.DataUnits
import Config
-{- Checks if a given key is currently present in the gitAnnexLocation. -}
+{- Checks if a given key's content is currently present. -}
inAnnex :: Key -> Annex Bool
-inAnnex key = do
+inAnnex = inAnnex' doesFileExist
+inAnnex' :: (FilePath -> IO a) -> Key -> Annex a
+inAnnex' a key = do
whenM (fromRepo Git.repoIsUrl) $
error "inAnnex cannot check remote repo"
- inRepo $ doesFileExist . gitAnnexLocation key
+ inRepo $ a . gitAnnexLocation key
+
+{- A safer check; the key's content must not only be present, but
+ - is not in the process of being removed. -}
+inAnnexSafe :: Key -> Annex (Maybe Bool)
+inAnnexSafe = inAnnex' $ \f -> do
+ e <- doesFileExist f
+ if e
+ then do
+ locked <- testlock f
+ if locked
+ then return Nothing
+ else return $ Just True
+ else return $ Just False
+ where
+ testlock f = return False -- TODO
{- Content is exclusively locked to indicate that it's in the process of
- being removed. -}
-lockExclusive :: Key -> Annex a -> Annex a
-lockExclusive key a = a -- TODO
-
-{- Things that rely on content being present can take a shared lock to
- - avoid it vanishing from under them. -}
-lockShared :: Key -> Annex a -> Annex a
-lockShared key a = a -- TODO
+lockContent :: Key -> Annex a -> Annex a
+lockContent key a = a -- TODO
{- Calculates the relative path to use to link a file to a key. -}
calcGitLink :: FilePath -> Key -> Annex FilePath