diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-10-09 10:30:22 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-10-09 10:30:22 -0400 |
commit | bd0c751b267c080ba28a6efeb88b1c0af293429f (patch) | |
tree | 392ae425adfbe0324f53b6c7502ae98acb5c05f7 /Types | |
parent | 9b613b4275987d2a5424c8995b304e2a45e9cc66 (diff) |
refactor
Diffstat (limited to 'Types')
-rw-r--r-- | Types/NumCopies.hs | 35 |
1 files changed, 26 insertions, 9 deletions
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 |