diff options
author | Joey Hess <joey@kitenet.net> | 2012-06-13 12:36:33 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-06-13 12:46:39 -0400 |
commit | ccc50052453ccaf2db0c371c5c36b5eea3e9191a (patch) | |
tree | dfb2ce0b7bfed5c8490cda68b6cd733bef72c473 /Assistant/ThreadedMonad.hs | |
parent | c31ddeda84542414dd58e03473a23a6de8890390 (diff) |
reorganize
Diffstat (limited to 'Assistant/ThreadedMonad.hs')
-rw-r--r-- | Assistant/ThreadedMonad.hs | 40 |
1 files changed, 40 insertions, 0 deletions
diff --git a/Assistant/ThreadedMonad.hs b/Assistant/ThreadedMonad.hs new file mode 100644 index 000000000..c4d331f61 --- /dev/null +++ b/Assistant/ThreadedMonad.hs @@ -0,0 +1,40 @@ +{- making the Annex monad available across threads + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + -} + +{-# LANGUAGE BangPatterns #-} + +module Assistant.ThreadedMonad where + +import Common.Annex +import qualified Annex + +import Control.Concurrent + +{- The Annex state is stored in a MVar, so that threaded actions can access + - it. -} +type ThreadState = MVar Annex.AnnexState + +{- Stores the Annex state in a MVar. + - + - Once the action is finished, retrieves the state from the MVar. + -} +withThreadState :: (ThreadState -> Annex a) -> Annex a +withThreadState a = do + state <- Annex.getState id + mvar <- liftIO $ newMVar state + r <- a mvar + newstate <- liftIO $ takeMVar mvar + Annex.changeState (const newstate) + return r + +{- Runs an Annex action, using the state from the MVar. + - + - This serializes calls by threads. -} +runThreadState :: ThreadState -> Annex a -> IO a +runThreadState mvar a = do + startstate <- takeMVar mvar + !(r, newstate) <- Annex.run startstate a + putMVar mvar newstate + return r |