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.
This commit is contained in:
Joey Hess 2014-08-20 20:08:45 -04:00
parent 9cb78e18ad
commit aebcc395ff
9 changed files with 35 additions and 31 deletions

View file

@ -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