aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Benjamin Barenblat <bbarenblat@gmail.com>2022-01-19 12:58:54 -0500
committerGravatar Benjamin Barenblat <bbarenblat@gmail.com>2022-01-19 13:31:02 -0500
commit44df82dcbf72d01d2bbb6c0afacff329ca749854 (patch)
tree2619d3890a9e7e532f0ad19fd5fb4e6579bd0db7
parent0ded71e9a53b1482019aedaa194e913d3a021c8d (diff)
Eliminate Data.Map.insertWith'
containers-0.6 removed insertWith' in favor of the Data.Map.Strict API. Switch to the new API where appropriate.
-rw-r--r--Annex.hs11
-rw-r--r--Assistant/Alert/Utility.hs6
-rw-r--r--Assistant/DaemonStatus.hs5
-rw-r--r--Assistant/NamedThread.hs5
-rw-r--r--Assistant/TransferQueue.hs5
-rw-r--r--Git/Queue.hs5
-rw-r--r--Logs/MapLog.hs5
-rw-r--r--Logs/UUID.hs5
-rw-r--r--Types/MetaData.hs5
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 <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
-
- 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 <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
-
- 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 <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
-
- 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 <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
-
- 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 <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
-
- 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 <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
-
- 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 <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
-
- 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 <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
-
- 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 <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
-
- 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