From 2b7f9c8442aea97d93011814b7ce6b05e0d576b6 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 25 Jul 2012 14:02:50 -0400
Subject: fix including of remote in TransferInfo when queueing new transfers

---
 Assistant/TransferQueue.hs | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs
index 1fb0bfa37..a01c85405 100644
--- a/Assistant/TransferQueue.hs
+++ b/Assistant/TransferQueue.hs
@@ -28,17 +28,17 @@ data Schedule = Next | Later
 newTransferQueue :: IO TransferQueue
 newTransferQueue = atomically $ TransferQueue <$> newTChan <*> newTVar 0
 
-stubInfo :: AssociatedFile -> TransferInfo
-stubInfo f = TransferInfo
+stubInfo :: AssociatedFile -> Remote -> TransferInfo
+stubInfo f r = TransferInfo
 	{ startedTime = Nothing
 	, transferPid = Nothing
 	, transferTid = Nothing
-	, transferRemote = Nothing
+	, transferRemote = Just r
 	, bytesComplete = Nothing
 	, associatedFile = f
 	}
 
-{- Adds pending transfers to queue for some of the known remotes. -}
+{- Adds transfers to queue for some of the known remotes. -}
 queueTransfers :: Schedule -> TransferQueue -> DaemonStatusHandle -> Key -> AssociatedFile -> Direction -> Annex ()
 queueTransfers schedule q daemonstatus k f direction = do
 	rs <- knownRemotes <$> getDaemonStatus daemonstatus
@@ -62,9 +62,8 @@ queueTransfers schedule q daemonstatus k f direction = do
 			, transferKey = k
 			, transferUUID = Remote.uuid r
 			}
-		go r = liftIO $ atomically $ do
-			let info = (stubInfo f) { transferRemote = Just r }
-			enqueue schedule q (gentransfer r) info
+		go r = liftIO $ atomically $
+			enqueue schedule q (gentransfer r) (stubInfo f r)
 
 enqueue :: Schedule -> TransferQueue -> Transfer -> TransferInfo -> STM ()
 enqueue schedule q t info
@@ -76,16 +75,17 @@ enqueue schedule q t info
 			void $ modifyTVar' (queuesize q) succ
 
 {- Adds a transfer to the queue. -}
-queueTransfer :: Schedule -> TransferQueue -> AssociatedFile -> Transfer -> IO ()
-queueTransfer schedule q f t = atomically $ enqueue schedule q t (stubInfo f)
+queueTransfer :: Schedule -> TransferQueue -> AssociatedFile -> Transfer -> Remote -> IO ()
+queueTransfer schedule q f t remote = atomically $
+	enqueue schedule q t (stubInfo f remote)
 
 {- Blocks until the queue is no larger than a given size, and then adds a
  - transfer to the queue. -}
-queueTransferAt :: Integer -> Schedule -> TransferQueue -> AssociatedFile -> Transfer -> IO ()
-queueTransferAt wantsz schedule q f t = atomically $ do
+queueTransferAt :: Integer -> Schedule -> TransferQueue -> AssociatedFile -> Transfer -> Remote -> IO ()
+queueTransferAt wantsz schedule q f t remote = atomically $ do
 	sz <- readTVar (queuesize q)
 	if sz <= wantsz
-		then enqueue schedule q t (stubInfo f)
+		then enqueue schedule q t (stubInfo f remote)
 		else retry -- blocks until queuesize changes
 
 {- Blocks until a pending transfer is available from the queue. -}
-- 
cgit v1.2.3