avoid insertWith' depreaction warning
Switch to Data.Map.Strict everywhere that used it. There are still lots of lazy maps in git-annex. I think switching these is safe. The risk is that there might be a map that is used in a way that relies on the values not being evaluated to WHNF, and switching to strict might result in bad performance or memory use. So, I have not switched everything.
This commit is contained in:
parent
558a0a9328
commit
256d8f07e8
11 changed files with 24 additions and 26 deletions
|
@ -13,7 +13,7 @@ import Utility.Tense
|
|||
|
||||
import qualified Data.Text as T
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Map.Strict as M
|
||||
|
||||
{- This is as many alerts as it makes sense to display at a time.
|
||||
- A display might be smaller, or larger, the point is to not overwhelm the
|
||||
|
@ -121,8 +121,7 @@ mergeAlert i al m = maybe updatePrune updateCombine (alertCombiner al)
|
|||
pruneold l =
|
||||
let (f, rest) = partition (\(_, a) -> isFiller a) l
|
||||
in drop bloat f ++ rest
|
||||
updatePrune = pruneBloat $ M.filterWithKey pruneSame $
|
||||
M.insertWith' const i al m
|
||||
updatePrune = pruneBloat $ M.filterWithKey pruneSame $ M.insert i al m
|
||||
updateCombine combiner =
|
||||
let combined = M.mapMaybe (combiner al) m
|
||||
in if M.null combined
|
||||
|
|
|
@ -25,7 +25,7 @@ import Annex.Export
|
|||
import Control.Concurrent.STM
|
||||
import System.Posix.Types
|
||||
import Data.Time.Clock.POSIX
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
getDaemonStatus :: Assistant DaemonStatus
|
||||
|
@ -181,7 +181,7 @@ alterTransferInfo t a = updateTransferInfo' $ M.adjust a t
|
|||
- or if already present, updates it while preserving the old transferTid,
|
||||
- transferPaused, and bytesComplete values, which are not written to disk. -}
|
||||
updateTransferInfo :: Transfer -> TransferInfo -> Assistant ()
|
||||
updateTransferInfo t info = updateTransferInfo' $ M.insertWith' merge t info
|
||||
updateTransferInfo t info = updateTransferInfo' $ M.insertWith merge t info
|
||||
where
|
||||
merge new old = new
|
||||
{ transferTid = maybe (transferTid new) Just (transferTid old)
|
||||
|
|
|
@ -20,7 +20,7 @@ import Utility.NotificationBroadcaster
|
|||
|
||||
import Control.Concurrent
|
||||
import Control.Concurrent.Async
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Control.Exception as E
|
||||
|
||||
#ifdef WITH_WEBAPP
|
||||
|
@ -57,7 +57,7 @@ startNamedThread urlrenderer (NamedThread afterstartupsanitycheck name a) =
|
|||
aid <- liftIO $ runner $ d { threadName = name }
|
||||
restart <- asIO $ startNamedThread urlrenderer (NamedThread False name a)
|
||||
modifyDaemonStatus_ $ \s -> s
|
||||
{ startedThreads = M.insertWith' const name (aid, restart) (startedThreads s) }
|
||||
{ startedThreads = M.insert name (aid, restart) (startedThreads s) }
|
||||
runmanaged first d = do
|
||||
aid <- async $ runAssistant d $ do
|
||||
void first
|
||||
|
|
|
@ -35,7 +35,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
|
||||
|
@ -198,7 +198,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
|
||||
|
||||
|
|
|
@ -17,7 +17,7 @@ import Git.Types
|
|||
import Control.Concurrent
|
||||
import Control.Concurrent.Async
|
||||
import Control.Concurrent.STM
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Map.Strict as M
|
||||
|
||||
data PairingWith = PairingWithSelf | PairingWithFriend
|
||||
deriving (Eq, Show, Read)
|
||||
|
@ -37,7 +37,7 @@ addWormholePairingState h tv = atomically $ do
|
|||
m <- readTVar tv
|
||||
-- use of head is safe because allids is infinite
|
||||
let i = Prelude.head $ filter (`notElem` M.keys m) allids
|
||||
writeTVar tv (M.insertWith' const i h m)
|
||||
writeTVar tv (M.insert i h m)
|
||||
return i
|
||||
where
|
||||
allids = map WormholePairingId [1..]
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue