summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Assistant/ThreadedMonad.hs17
-rw-r--r--Assistant/Threads/Transferrer.hs16
2 files changed, 18 insertions, 15 deletions
diff --git a/Assistant/ThreadedMonad.hs b/Assistant/ThreadedMonad.hs
index 4e871ab67..16f3a9dd9 100644
--- a/Assistant/ThreadedMonad.hs
+++ b/Assistant/ThreadedMonad.hs
@@ -12,6 +12,7 @@ import qualified Annex
import Control.Concurrent
import Data.Tuple
+import System.Posix.Types
{- The Annex state is stored in a MVar, so that threaded actions can access
- it. -}
@@ -37,14 +38,14 @@ withThreadState a = do
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.
+{- Runs an Annex action in a separate process, 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.
+ - 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
+unsafeForkProcessThreadState :: ThreadState -> Annex a -> IO ProcessID
+unsafeForkProcessThreadState mvar a = do
state <- readMVar mvar
- Annex.eval state a
+ forkProcess $ void $ Annex.eval state a
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 09c0aa036..f40218c08 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -14,7 +14,6 @@ import Assistant.TransferQueue
import Assistant.TransferSlots
import Logs.Transfer
import Annex.Content
-import Utility.ThreadScheduler
import Command
import qualified Command.Move
@@ -27,11 +26,14 @@ maxTransfers = 1
{- Dispatches transfers from the queue. -}
transfererThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> TransferSlots -> IO ()
-transfererThread st dstatus transferqueue slots = runEvery (Seconds 1) $ do
- (t, info) <- getNextTransfer transferqueue
- whenM (runThreadState st $ shouldTransfer dstatus t) $
- void $ inTransferSlot slots $
- runTransfer st dstatus t info
+transfererThread st dstatus transferqueue slots = go
+ where
+ go = do
+ (t, info) <- getNextTransfer transferqueue
+ whenM (runThreadState st $ shouldTransfer dstatus t) $
+ void $ inTransferSlot slots $
+ runTransfer st dstatus t info
+ go
{- Checks if the requested transfer is already running, or
- the file to download is already present. -}
@@ -68,7 +70,7 @@ runTransfer st dstatus t info
(_, Nothing) -> noop
(Just remote, Just file) -> do
now <- getCurrentTime
- pid <- forkProcess $ unsafeRunThreadState st $ void $
+ pid <- unsafeForkProcessThreadState st $
doCommand $ cmd remote False file (transferKey t)
runThreadState st $
adjustTransfers dstatus $