diff options
| -rw-r--r-- | Annex/Content.hs | 5 | ||||
| -rw-r--r-- | Types/NumCopies.hs | 35 |
2 files changed, 27 insertions, 13 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index d0596644e..da29aa4ed 100644 --- a/Annex/Content.hs +++ b/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 diff --git a/Types/NumCopies.hs b/Types/NumCopies.hs index 1a3b973cc..38bce6818 100644 --- a/Types/NumCopies.hs +++ b/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 |