diff options
| author |  Joey Hess <joey@kitenet.net> | 2014-01-05 21:30:48 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2014-01-05 21:30:48 -0400 |
| commit | 4cf6d95c1a9d10cb59669eaceafce4c7a3155eb6 (patch) | |
| tree | 2ed9440dd31cb4cb925e9010bd54694b8c776519 /Assistant/TransferQueue.hs | |
| parent | 5d305f1337e88ae7a07f54adc06c4a9d1d39f872 (diff) | |
assistant: Fixed several minor memory leaks that manifested when adding a large number of files.
Diffstat (limited to 'Assistant/TransferQueue.hs')
| -rw-r--r-- | Assistant/TransferQueue.hs | 11 |
1 files changed, 7 insertions, 4 deletions
diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index f94e73c2b..05b0ba73a 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE BangPatterns #-} + module Assistant.TransferQueue ( TransferQueue, Schedule(..), @@ -32,7 +34,7 @@ import Annex.Wanted import Utility.TList import Control.Concurrent.STM -import qualified Data.Map as M +import qualified Data.Map.Strict as M import qualified Data.Set as S type Reason = String @@ -189,7 +191,7 @@ getNextTransfer acceptable = do if acceptable info then do adjustTransfersSTM dstatus $ - M.insertWith' const t info + M.insert t info return $ Just r else return Nothing @@ -217,7 +219,8 @@ dequeueTransfers c = do dequeueTransfersSTM :: TransferQueue -> (Transfer -> Bool) -> STM [(Transfer, TransferInfo)] dequeueTransfersSTM q c = do - (removed, ts) <- partition (c . fst) <$> readTList (queuelist q) - void $ writeTVar (queuesize q) (length ts) + !(removed, ts) <- partition (c . fst) <$> readTList (queuelist q) + let !len = length ts + void $ writeTVar (queuesize q) len setTList (queuelist q) ts return removed |