refactor

Annex/Content.hs

@@ -183,10 +183,7 @@ contentLockFile key = Just <$> calcRepo (gitAnnexContentLock key)
 lockContentShared :: Key -> (VerifiedCopy -> Annex a) -> Annex a
 lockContentShared key a = lockContentUsing lock key $ do
 	u <- getUUID
-	bracketIO 
-		(invalidatableVerifiedCopy VerifiedCopyLock u) 
-		invalidateVerifiedCopy
-		a
+	withVerifiedCopy VerifiedCopyLock u a
   where
 #ifndef mingw32_HOST_OS
 	lock contentfile Nothing = liftIO $ tryLockShared Nothing contentfile

Types/NumCopies.hs

@@ -15,12 +15,16 @@ module Types.NumCopies (
 	deDupVerifiedCopies,
 	mkVerifiedCopy,
 	invalidatableVerifiedCopy,
+	withVerifiedCopy,
 ) where
 
 import Types.UUID
+import Utility.Exception (bracketIO)
 
 import qualified Data.Map as M
 import Control.Concurrent.MVar
+import Control.Monad.Catch (MonadMask)
+import Control.Monad.IO.Class (MonadIO)
 
 newtype NumCopies = NumCopies Int
 	deriving (Ord, Eq)
@@ -44,6 +48,15 @@ data VerifiedCopy
 	| VerifiedCopyLock V
 	deriving (Show)
 
+data V = V
+	{ _getUUID :: UUID
+	, _checkVerifiedCopy :: IO Bool
+	, _invalidateVerifiedCopy :: IO ()
+	}
+
+instance Show V where
+	show v = show (_getUUID v)
+
 instance ToUUID VerifiedCopy where
 	toUUID = _getUUID . toV
 	
@@ -59,15 +72,6 @@ checkVerifiedCopy = _checkVerifiedCopy . toV
 invalidateVerifiedCopy :: VerifiedCopy -> IO ()
 invalidateVerifiedCopy = _invalidateVerifiedCopy . toV
 
-data V = V
-	{ _getUUID :: UUID
-	, _checkVerifiedCopy :: IO Bool
-	, _invalidateVerifiedCopy :: IO ()
-	}
-
-instance Show V where
-	show v = show (_getUUID v)
-
 strongestVerifiedCopy :: VerifiedCopy -> VerifiedCopy -> VerifiedCopy
 strongestVerifiedCopy a@(VerifiedCopyLock _) _ = a
 strongestVerifiedCopy _ b@(VerifiedCopyLock _) = b
@@ -91,3 +95,16 @@ invalidatableVerifiedCopy mk u = do
 		return ()
 	let check = isEmptyMVar v
 	return $ mk $ V (toUUID u) check invalidate
+
+-- Constructs a VerifiedCopy, and runs the action, ensuring that the
+-- verified copy is invalidated when the action returns, or on error.
+withVerifiedCopy 
+	:: (Monad m, MonadMask m, MonadIO m, ToUUID u)
+	=> (V -> VerifiedCopy)
+	-> u
+	-> (VerifiedCopy -> m a)
+	-> m a
+withVerifiedCopy mk u = bracketIO setup cleanup
+  where
+	setup = invalidatableVerifiedCopy mk u
+	cleanup = invalidateVerifiedCopy