use DList for the transfer queue

Some nice efficiency gains here for list appending, although mostly
the small size of the transfer queue makes them irrelivant.

4 files changed, 21 insertions, 16 deletions

diff --git a/Assistant/Changes.hs b/Assistant/Changes.hs
index 9daef511b..2ecd2036c 100644
--- a/Assistant/Changes.hs
+++ b/Assistant/Changes.hs
@@ -32,7 +32,7 @@ getChanges = (atomically . getTList) <<~ changePool
 
 {- Gets all unhandled changes, without blocking. -}
 getAnyChanges :: Assistant [Change]
-getAnyChanges = (atomically . readTList) <<~ changePool
+getAnyChanges = (atomically . takeTList) <<~ changePool
 
 {- Puts unhandled changes back into the pool.
  - Note: Original order is not preserved. -}
diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs
index e0b57a2ac..f94e73c2b 100644
--- a/Assistant/TransferQueue.hs
+++ b/Assistant/TransferQueue.hs
@@ -39,7 +39,7 @@ type Reason = String
 
 {- Reads the queue's content without blocking or changing it. -}
 getTransferQueue :: Assistant [(Transfer, TransferInfo)]
-getTransferQueue = (atomically . readTVar . queuelist) <<~ transferQueue
+getTransferQueue = (atomically . readTList . queuelist) <<~ transferQueue
 
 stubInfo :: AssociatedFile -> Remote -> TransferInfo
 stubInfo f r = stubTransferInfo
@@ -126,10 +126,9 @@ queueDeferredDownloads reason schedule = do
 
 enqueue :: Reason -> Schedule -> Transfer -> TransferInfo -> Assistant ()
 enqueue reason schedule t info
-	| schedule == Next = go (new:)
-	| otherwise = go (\l -> l++[new])
+	| schedule == Next = go consTList
+	| otherwise = go snocTList
   where
-	new = (t, info)
 	go modlist = whenM (add modlist) $ do
 		debug [ "queued", describeTransfer t info, ": " ++ reason ]
 		notifyTransfer
@@ -139,11 +138,11 @@ enqueue reason schedule t info
 		liftIO $ atomically $ ifM (checkRunningTransferSTM dstatus t)
 			( return False
 			, do
-				l <- readTVar (queuelist q)
+				l <- readTList (queuelist q)
 				if (t `notElem` map fst l)
 					then do	
 						void $ modifyTVar' (queuesize q) succ
-						void $ modifyTVar' (queuelist q) modlist
+						void $ modlist (queuelist q) (t, info)
 						return True
 					else return False
 			)
@@ -184,9 +183,9 @@ getNextTransfer acceptable = do
 		if sz < 1
 			then retry -- blocks until queuesize changes
 			else do
-				(r@(t,info):rest) <- readTVar (queuelist q)
-				writeTVar (queuelist q) rest
+				(r@(t,info):rest) <- readTList (queuelist q)
 				void $ modifyTVar' (queuesize q) pred
+				setTList (queuelist q) rest
 				if acceptable info
 					then do
 						adjustTransfersSTM dstatus $
@@ -218,8 +217,7 @@ dequeueTransfers c = do
 
 dequeueTransfersSTM :: TransferQueue -> (Transfer -> Bool) -> STM [(Transfer, TransferInfo)]
 dequeueTransfersSTM q c = do
-	(removed, ts) <- partition (c . fst)
-		<$> readTVar (queuelist q)
+	(removed, ts) <- partition (c . fst) <$> readTList (queuelist q)
 	void $ writeTVar (queuesize q) (length ts)
-	void $ writeTVar (queuelist q) ts
+	setTList (queuelist q) ts
 	return removed
diff --git a/Assistant/Types/TransferQueue.hs b/Assistant/Types/TransferQueue.hs
index 706c64bbb..e4e305d5a 100644
--- a/Assistant/Types/TransferQueue.hs
+++ b/Assistant/Types/TransferQueue.hs
@@ -16,7 +16,7 @@ import Utility.TList
 
 data TransferQueue = TransferQueue
 	{ queuesize :: TVar Int
-	, queuelist :: TVar [(Transfer, TransferInfo)]
+	, queuelist :: TList (Transfer, TransferInfo)
 	, deferreddownloads :: TList (Key, AssociatedFile)
 	}
 
@@ -26,5 +26,5 @@ data Schedule = Next | Later
 newTransferQueue :: IO TransferQueue
 newTransferQueue = atomically $ TransferQueue
 	<$> newTVar 0
-	<*> newTVar []
+	<*> newTList
 	<*> newTList
diff --git a/Utility/TList.hs b/Utility/TList.hs
index 33a50b7dd..716f72017 100644
--- a/Utility/TList.hs
+++ b/Utility/TList.hs
@@ -25,10 +25,14 @@ newTList = newEmptyTMVar
 getTList :: TList a -> STM [a]
 getTList tlist = D.toList <$> takeTMVar tlist
 
-{- Gets anything currently in the TList, without blocking.
+{- Takes anything currently in the TList, without blocking.
  - TList is left empty. -}
+takeTList :: TList a -> STM [a]
+takeTList tlist = maybe [] D.toList <$> tryTakeTMVar tlist
+
+{- Reads anything in the list, without modifying it, or blocking. -}
 readTList :: TList a -> STM [a]
-readTList tlist = maybe [] D.toList <$> tryTakeTMVar tlist
+readTList tlist = maybe [] D.toList <$> tryReadTMVar tlist
 
 {- Mutates a TList. -}
 modifyTList :: TList a -> (D.DList a -> D.DList a) -> STM ()
@@ -50,3 +54,6 @@ snocTList tlist v = modifyTList tlist $ \dl -> D.snoc dl v
 
 appendTList :: TList a -> [a] -> STM ()
 appendTList tlist l = modifyTList tlist $ \dl -> D.append dl (D.fromList l)
+
+setTList :: TList a -> [a] -> STM ()
+setTList tlist l = modifyTList tlist $ const $ D.fromList l