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.
This commit is contained in:
parent
c6da464051
commit
362ed9f0e3
4 changed files with 21 additions and 16 deletions
|
@ -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. -}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue