summaryrefslogtreecommitdiff
path: root/Types
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-10-09 10:30:22 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-10-09 10:30:22 -0400
commitbd0c751b267c080ba28a6efeb88b1c0af293429f (patch)
tree392ae425adfbe0324f53b6c7502ae98acb5c05f7 /Types
parent9b613b4275987d2a5424c8995b304e2a45e9cc66 (diff)
refactor
Diffstat (limited to 'Types')
-rw-r--r--Types/NumCopies.hs35
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