diff options
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/Changes.hs | 2 | ||||
| -rw-r--r-- | Assistant/TransferQueue.hs | 20 | ||||
| -rw-r--r-- | Assistant/Types/TransferQueue.hs | 4 |
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 |