From 6c8f6abbd5f1227fdbb7b8c93f257dca9b6a1372 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 25 Apr 2013 01:33:44 -0400
Subject: 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.
---
 Assistant/Changes.hs             |  2 +-
 Assistant/TransferQueue.hs       | 20 +++++++++-----------
 Assistant/Types/TransferQueue.hs |  4 ++--
 3 files changed, 12 insertions(+), 14 deletions(-)

(limited to 'Assistant')

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
-- 
cgit v1.2.3