d5e06e7b89
This doesn't quite work, because canceling a transfer sends a signal to git-annex, but not to rsync (etc). Looked at making git-annex run in its own process group, which could then be killed, and would kill child processes. But, rsync checks if it's process group is the foreground process group and doesn't show progress if not, and when git has run git-annex, if git-annex makes a new process group, that is not the case. Also, if git has run git-annex, ctrl-c wouldn't be propigated to it if it made a new process group. So this seems like a blind alley, but recording it here just in case.
38 lines
1 KiB
Haskell
38 lines
1 KiB
Haskell
{- making the Annex monad available across threads
|
|
-
|
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Assistant.ThreadedMonad where
|
|
|
|
import Common.Annex
|
|
import qualified Annex
|
|
|
|
import Control.Concurrent
|
|
import Data.Tuple
|
|
|
|
{- 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; only one thread can run in Annex at a
|
|
- time. -}
|
|
runThreadState :: ThreadState -> Annex a -> IO a
|
|
runThreadState mvar a = modifyMVar mvar $ \state -> swap <$> Annex.run state a
|