From 721748135b80a20e78ddc780ffedb2c54b74c307 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 6 Jul 2012 14:42:45 -0400
Subject: fix build (almost)

---
 Assistant/Threads/Transferrer.hs | 33 ++++++++++++++++-----------------
 Assistant/TransferQueue.hs       |  1 -
 2 files changed, 16 insertions(+), 18 deletions(-)

(limited to 'Assistant')

diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 249e15cf2..0d0bc6f6d 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -13,13 +13,10 @@ import Assistant.DaemonStatus
 import Assistant.TransferQueue
 import Logs.Transfer
 import Annex.Content
-import Annex.BranchState
 import Utility.ThreadScheduler
 import Command
 import qualified Command.Move
 
-import Control.Exception as E
-import Control.Concurrent
 import Data.Time.Clock
 import qualified Data.Map as M
 
@@ -31,11 +28,11 @@ maxTransfers = 1
 transfererThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> IO ()
 transfererThread st dstatus transferqueue = runEvery (Seconds 1) $ do
 	(t, info) <- getNextTransfer transferqueue
-	go =<< runThreadState st $ shouldTransfer t
-	where
-		go Yes = runTransfer st t
-		go No = noop
-		go TooMany = waitTransfer >> go Yes
+	c <- runThreadState st $ shouldTransfer dstatus t
+	case c of
+		Yes -> void $ runTransfer st dstatus t info
+		Skip -> noop
+		TooMany -> void $ waitTransfer >> runTransfer st dstatus t info
 
 data ShouldTransfer = Yes | Skip | TooMany
 
@@ -51,7 +48,8 @@ shouldTransfer dstatus t = go =<< currentTransfers <$> getDaemonStatus dstatus
 			| M.member t m = return Skip
 			| M.size m > maxTransfers = return TooMany
 			| transferDirection t == Download =
-				ifM (inAnnex $ transferKey t) (No, Yes)
+				ifM (inAnnex $ transferKey t)
+					(return Skip, return Yes)
 			| otherwise = return Yes
 
 {- Waits for any of the transfers in the map to complete. -}
@@ -74,8 +72,8 @@ waitTransfer = error "TODO"
  - effectively running in oneshot mode, without committing changes to the
  - git-annex branch, and transfers should never queue git commands to run.
  -}
-runTransfer :: ThreadState -> Transfer -> TransferInfo -> IO ProcessID
-runTransfer st t info
+runTransfer :: ThreadState -> DaemonStatusHandle -> Transfer -> TransferInfo -> IO ()
+runTransfer st dstatus t info
 	| transferDirection t == Download = go Command.Move.fromStart
 	| otherwise = go Command.Move.toStart
 	where
@@ -84,10 +82,11 @@ runTransfer st t info
 			(_, Nothing) -> noop
 			(Just remote, Just file) -> do
 				now <- getCurrentTime
-				pid <- forkProcess $ unsafeRunThreadState st $
+				pid <- forkProcess $ unsafeRunThreadState st $ void $
 					doCommand $ cmd remote False file (transferKey t)
-				adjustTransfers dstatus $
-					M.insertWith' const t info
-						{ startedTime = Just now
-						, transferPid = Just pid
-						}
+				runThreadState st $ 
+					adjustTransfers dstatus $
+						M.insertWith' const t info
+							{ startedTime = Just now
+							, transferPid = Just pid
+							}
diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs
index a35815ca1..bb65dbae5 100644
--- a/Assistant/TransferQueue.hs
+++ b/Assistant/TransferQueue.hs
@@ -24,7 +24,6 @@ stubInfo :: AssociatedFile -> TransferInfo
 stubInfo f = TransferInfo
 	{ startedTime = Nothing
 	, transferPid = Nothing
-	, transferThread = Nothing
 	, transferRemote = Nothing
 	, bytesComplete = Nothing
 	, associatedFile = f
-- 
cgit v1.2.3