summaryrefslogtreecommitdiff
path: root/Annex/Content.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-08-20 20:08:45 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-08-20 20:13:47 -0400
commit28ac29b518a49363788b3607130cee5aff5534e9 (patch)
tree25985e4f7937c64e662ef5447651f4e44d2b9cbf /Annex/Content.hs
parent6f8f6b7dde108168ac5a9f0b3fb2cb8ea2d2f60c (diff)
use types to enforce that removeAnnex can only be called inside lockContent
This fixed one bug where it needed to be and wasn't (in Assistant.Unused). And also found one place where lockContent was used unnecessarily (by drop --from remote). A few other places like uninit probably don't really need to lockContent, but it doesn't hurt to do call it anyway. This commit was sponsored by David Wagner.
Diffstat (limited to 'Annex/Content.hs')
-rw-r--r--Annex/Content.hs19
1 files changed, 13 insertions, 6 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 90ab7db58..86b78c04e 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -152,14 +152,20 @@ contentLockFile key = ifM isDirect
, return Nothing
)
+newtype ContentLock = ContentLock Key
+
{- Content is exclusively locked while running an action that might remove
- - it. (If the content is not present, no locking is done.) -}
-lockContent :: Key -> Annex a -> Annex a
+ - it. (If the content is not present, no locking is done.)
+ -}
+lockContent :: Key -> (ContentLock -> Annex a) -> Annex a
lockContent key a = do
contentfile <- calcRepo $ gitAnnexLocation key
lockfile <- contentLockFile key
maybe noop setuplockfile lockfile
- bracket (lock contentfile lockfile) (unlock lockfile) (const a)
+ bracket
+ (lock contentfile lockfile)
+ (unlock lockfile)
+ (const $ a $ ContentLock key)
where
alreadylocked = error "content is locked"
setuplockfile lockfile = modifyContent lockfile $
@@ -426,9 +432,10 @@ cleanObjectLoc key cleaner = do
{- Removes a key's file from .git/annex/objects/
-
- In direct mode, deletes the associated files or files, and replaces
- - them with symlinks. -}
-removeAnnex :: Key -> Annex ()
-removeAnnex key = withObjectLoc key remove removedirect
+ - them with symlinks.
+ -}
+removeAnnex :: ContentLock -> Annex ()
+removeAnnex (ContentLock key) = withObjectLoc key remove removedirect
where
remove file = cleanObjectLoc key $ do
secureErase file