summaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-04-25 01:33:44 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-04-25 01:33:44 -0400
commit6c8f6abbd5f1227fdbb7b8c93f257dca9b6a1372 (patch)
tree6ee22bd09c565135bbf5bde65efbaba640accae3 /Assistant
parent2efb559c7cdce21fb441343c26af4855b6ac842f (diff)
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.
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/Changes.hs2
-rw-r--r--Assistant/TransferQueue.hs20
-rw-r--r--Assistant/Types/TransferQueue.hs4
3 files changed, 12 insertions, 14 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