From 44df82dcbf72d01d2bbb6c0afacff329ca749854 Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Wed, 19 Jan 2022 12:58:54 -0500 Subject: Eliminate Data.Map.insertWith' containers-0.6 removed insertWith' in favor of the Data.Map.Strict API. Switch to the new API where appropriate. --- Annex.hs | 11 +++++------ Assistant/Alert/Utility.hs | 6 +++--- Assistant/DaemonStatus.hs | 5 +++-- Assistant/NamedThread.hs | 5 +++-- Assistant/TransferQueue.hs | 5 +++-- Git/Queue.hs | 5 +++-- Logs/MapLog.hs | 5 +++-- Logs/UUID.hs | 5 +++-- Types/MetaData.hs | 5 +++-- 9 files changed, 29 insertions(+), 23 deletions(-) diff --git a/Annex.hs b/Annex.hs index 7b4bb706c..54f71aee9 100644 --- a/Annex.hs +++ b/Annex.hs @@ -1,6 +1,7 @@ {- git-annex monad - - Copyright 2010-2018 Joey Hess + - Copyright 2022 Benjamin Barenblat - - Licensed under the GNU GPL version 3 or higher. -} @@ -73,7 +74,7 @@ import "mtl" Control.Monad.Reader import Control.Concurrent import Control.Concurrent.Async import Control.Concurrent.STM -import qualified Data.Map as M +import qualified Data.Map.Strict as M import qualified Data.Set as S {- git-annex's monad is a ReaderT around an AnnexState stored in a MVar. @@ -259,18 +260,16 @@ withState modifier = do {- Sets a flag to True -} setFlag :: String -> Annex () -setFlag flag = changeState $ \s -> - s { flags = M.insertWith' const flag True $ flags s } +setFlag flag = changeState $ \s -> s { flags = M.insert flag True $ flags s } {- Sets a field to a value -} setField :: String -> String -> Annex () setField field value = changeState $ \s -> - s { fields = M.insertWith' const field value $ fields s } + s { fields = M.insert field value $ fields s } {- Adds a cleanup action to perform. -} addCleanup :: CleanupAction -> Annex () -> Annex () -addCleanup k a = changeState $ \s -> - s { cleanup = M.insertWith' const k a $ cleanup s } +addCleanup k a = changeState $ \s -> s { cleanup = M.insert k a $ cleanup s } {- Sets the type of output to emit. -} setOutput :: OutputType -> Annex () diff --git a/Assistant/Alert/Utility.hs b/Assistant/Alert/Utility.hs index 5a6c73b85..4618633cc 100644 --- a/Assistant/Alert/Utility.hs +++ b/Assistant/Alert/Utility.hs @@ -1,6 +1,7 @@ {- git-annex assistant alert utilities - - Copyright 2012, 2013 Joey Hess + - Copyright 2022 Benjamin Barenblat - - Licensed under the GNU GPL version 3 or higher. -} @@ -13,7 +14,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 +122,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 diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index 49823c3c0..3fafb585d 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -1,6 +1,7 @@ {- git-annex assistant daemon status - - Copyright 2012 Joey Hess + - Copyright 2022 Benjamin Barenblat - - Licensed under the GNU GPL version 3 or higher. -} @@ -25,7 +26,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 +182,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) diff --git a/Assistant/NamedThread.hs b/Assistant/NamedThread.hs index 090a3a7cd..ae7375a27 100644 --- a/Assistant/NamedThread.hs +++ b/Assistant/NamedThread.hs @@ -1,6 +1,7 @@ {- git-annex assistant named threads. - - Copyright 2012 Joey Hess + - Copyright 2022 Benjamin Barenblat - - Licensed under the GNU GPL version 3 or higher. -} @@ -20,7 +21,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 +58,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 diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index 278bcbaa1..fbc589673 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -1,6 +1,7 @@ {- git-annex assistant pending transfer queue - - Copyright 2012-2014 Joey Hess + - Copyright 2022 Benjamin Barenblat - - Licensed under the GNU GPL version 3 or higher. -} @@ -35,7 +36,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 +199,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 diff --git a/Git/Queue.hs b/Git/Queue.hs index ee1f83ca9..80d953803 100644 --- a/Git/Queue.hs +++ b/Git/Queue.hs @@ -1,6 +1,7 @@ {- git repository command queue - - Copyright 2010,2012 Joey Hess + - Copyright 2022 Benjamin Barenblat - - Licensed under the GNU GPL version 3 or higher. -} @@ -24,7 +25,7 @@ import Git import Git.Command import qualified Git.UpdateIndex -import qualified Data.Map as M +import qualified Data.Map.Strict as M {- Queable actions that can be performed in a git repository. -} data Action @@ -117,7 +118,7 @@ updateQueue !action different sizeincrease q repo , items = newitems } !newsize = size q' + sizeincrease - !newitems = M.insertWith' combineNewOld (actionKey action) action (items q') + !newitems = M.insertWith combineNewOld (actionKey action) action (items q') combineNewOld :: Action -> Action -> Action combineNewOld (CommandAction _sc1 _ps1 fs1) (CommandAction sc2 ps2 fs2) = diff --git a/Logs/MapLog.hs b/Logs/MapLog.hs index a881eae34..74ddee582 100644 --- a/Logs/MapLog.hs +++ b/Logs/MapLog.hs @@ -7,6 +7,7 @@ - A line of the log will look like: "timestamp field value" - - Copyright 2014 Joey Hess + - Copyright 2022 Benjamin Barenblat - - Licensed under the GNU GPL version 3 or higher. -} @@ -21,7 +22,7 @@ import Common import Annex.VectorClock import Logs.Line -import qualified Data.Map as M +import qualified Data.Map.Strict as M data LogEntry v = LogEntry { changed :: VectorClock @@ -56,7 +57,7 @@ changeMapLog c f v = M.insert f $ LogEntry c v {- Only add an LogEntry if it's newer (or at least as new as) than any - existing LogEntry for a field. -} addMapLog :: Ord f => f -> LogEntry v -> MapLog f v -> MapLog f v -addMapLog = M.insertWith' best +addMapLog = M.insertWith best {- Converts a MapLog into a simple Map without the timestamp information. - This is a one-way trip, but useful for code that never needs to change diff --git a/Logs/UUID.hs b/Logs/UUID.hs index 8da727228..9984e2b76 100644 --- a/Logs/UUID.hs +++ b/Logs/UUID.hs @@ -9,6 +9,7 @@ - uuid.log stores a list of known uuids, and their descriptions. - - Copyright 2010-2012 Joey Hess + - Copyright 2022 Benjamin Barenblat - - Licensed under the GNU GPL version 3 or higher. -} @@ -29,7 +30,7 @@ import Logs import Logs.UUIDBased import qualified Annex.UUID -import qualified Data.Map as M +import qualified Data.Map.Strict as M {- Records a description for a uuid in the log. -} describeUUID :: UUID -> String -> Annex () @@ -79,7 +80,7 @@ uuidMapLoad :: Annex UUIDMap uuidMapLoad = do m <- (simpleMap . parseLog Just) <$> Annex.Branch.get uuidLog u <- Annex.UUID.getUUID - let m' = M.insertWith' preferold u "" m + let m' = M.insertWith preferold u "" m Annex.changeState $ \s -> s { Annex.uuidmap = Just m' } return m' where diff --git a/Types/MetaData.hs b/Types/MetaData.hs index bc27c345f..3e437e791 100644 --- a/Types/MetaData.hs +++ b/Types/MetaData.hs @@ -1,6 +1,7 @@ {- git-annex general metadata - - Copyright 2014 Joey Hess + - Copyright 2022 Benjamin Barenblat - - Licensed under the GNU GPL version 3 or higher. -} @@ -46,7 +47,7 @@ import Utility.QuickCheck import qualified Data.Text as T import qualified Data.Set as S -import qualified Data.Map as M +import qualified Data.Map.Strict as M import qualified Data.HashMap.Strict as HM import Data.Char import qualified Data.CaseInsensitive as CI @@ -208,7 +209,7 @@ updateMetaData f v = updateMetaData' f (S.singleton v) updateMetaData' :: MetaField -> S.Set MetaValue -> MetaData -> MetaData updateMetaData' f s (MetaData m) = MetaData $ - M.insertWith' S.union f s m + M.insertWith S.union f s m {- New metadata overrides old._-} unionMetaData :: MetaData -> MetaData -> MetaData -- cgit v1.2.3