run transfer with copy of annex state

This should have made it run concurrently with other annex actions,
but I'm still seeing it serialize. Perhaps I need to forkProcess?

2 files changed, 13 insertions, 1 deletions

diff --git a/Assistant/ThreadedMonad.hs b/Assistant/ThreadedMonad.hs
index 7b915e12c..4e871ab67 100644
--- a/Assistant/ThreadedMonad.hs
+++ b/Assistant/ThreadedMonad.hs
@@ -36,3 +36,15 @@ withThreadState a = do
  - time. -}
 runThreadState :: ThreadState -> Annex a -> IO a
 runThreadState mvar a = modifyMVar mvar $ \state -> swap <$> Annex.run state a
+
+{- Runs an Annex action, using a copy of the state from the MVar.
+ -
+ - The state modified by the action is thrown away, so it's up to the
+ - action to perform any necessary shutdown tasks in order for state to not
+ - be lost. And it's up to the caller to resynchronise with any changes
+ - the action makes to eg, the git-annex branch.
+ -}
+unsafeRunThreadState :: ThreadState -> Annex a -> IO a
+unsafeRunThreadState mvar a = do
+	state <- readMVar mvar
+	Annex.eval state a
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 29cc393f2..0b47e9781 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -97,6 +97,6 @@ runTransfer st t info
 		inthread a = do
 			mvar <- newEmptyMVar
 			void $ forkIO $
-				runThreadState st a `E.finally` putMVar mvar ()
+				unsafeRunThreadState st a `E.finally` putMVar mvar ()
 			void $ takeMVar mvar -- wait for transfer thread
 			runThreadState st invalidateCache