mapM{,_} -> traverse{._}

Let GHC figure-out where the specialization to Monad is effective and where
use Applicative.

Upon investigation I did not found the differences to use either, except of
obvious ones.

Author: Anton-Latukha

main/Main.hs

@@ -16,6 +16,7 @@ import           Control.Monad
 import           Control.Monad.Catch
 import           Control.Monad.Free
 import           Control.Monad.IO.Class
+import           Data.Foldable                  ( traverse_ )
 import qualified Data.HashMap.Lazy             as M
 import qualified Data.Map                      as Map
 import           Data.List                      ( sortOn )
@@ -58,10 +59,10 @@ main = do
               handleResult opts mempty
                 .   parseNixTextLoc
                 =<< liftIO Text.getContents
-            paths -> mapM_ (processFile opts) paths
-          Just "-" -> mapM_ (processFile opts) . lines =<< liftIO getContents
+            paths -> traverse_ (processFile opts) paths
+          Just "-" -> traverse_ (processFile opts) . lines =<< liftIO getContents
           Just path ->
-            mapM_ (processFile opts) . lines =<< liftIO (readFile path)
+            traverse_ (processFile opts) . lines =<< liftIO (readFile path)
         Just s  -> handleResult opts mempty (parseNixTextLoc s)
       Just path -> do
         let file = addExtension (dropExtension path) "nixc"

src/Nix/Builtins.hs

@@ -535,7 +535,7 @@ any_
   => NValue t f m
   -> NValue t f m
   -> m (NValue t f m)
-any_ f = toValue <=< anyM fromValue <=< mapM (callFunc f) <=< fromValue
+any_ f = toValue <=< anyM fromValue <=< traverse (callFunc f) <=< fromValue
 
 allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
 allM _ []       = pure True
@@ -550,7 +550,7 @@ all_
   => NValue t f m
   -> NValue t f m
   -> m (NValue t f m)
-all_ f = toValue <=< allM fromValue <=< mapM (callFunc f) <=< fromValue
+all_ f = toValue <=< allM fromValue <=< traverse (callFunc f) <=< fromValue
 
 foldl'_
   :: forall e t f m
@@ -1179,7 +1179,7 @@ removeAttrs set v =
   do
     (m, p) <- fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) set
     (nsToRemove :: [NixString]) <- fromValue $ Deeper v
-    toRemove <- mapM fromStringNoContext nsToRemove
+    toRemove <- traverse fromStringNoContext nsToRemove
     toValue (go m toRemove, go p toRemove)
  where
   go = foldl' (flip M.delete)
@@ -1406,7 +1406,7 @@ concatLists
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
 concatLists =
   toValue . concat <=<
-    mapM
+    traverse
       (pure <=<
         (fromValue @[NValue t f m]) <=< demand
       )

src/Nix/Effects/Derivation.hs

@@ -96,7 +96,7 @@ parsePath p = case Store.parsePath "/nix/store" (Text.encodeUtf8 p) of
 writeDerivation :: (Framed e m, MonadStore m) => Derivation -> m Store.StorePath
 writeDerivation drv@Derivation{inputs, name} = do
   let (inputSrcs, inputDrvs) = inputs
-  references <- fmap Set.fromList $ mapM parsePath $ Set.toList $ Set.union inputSrcs $ Set.fromList $ Map.keys inputDrvs
+  references <- fmap Set.fromList $ traverse parsePath $ Set.toList $ Set.union inputSrcs $ Set.fromList $ Map.keys inputDrvs
   path <- addTextToStore (Text.append name ".drv") (unparseDrv drv) (S.fromList $ Set.toList references) False
   parsePath $ Text.pack $ unStorePath path
 
@@ -300,12 +300,12 @@ buildDerivationWithContext drvAttrs = do
       useJson     <- getAttrOr "__structuredAttrs" False   $ pure
       ignoreNulls <- getAttrOr "__ignoreNulls"     False   $ pure
 
-      args        <- getAttrOr "args"              mempty  $ mapM (fromValue' >=> extractNixString)
+      args        <- getAttrOr "args"              mempty  $ traverse (fromValue' >=> extractNixString)
       builder     <- getAttr   "builder"                   $ extractNixString
       platform    <- getAttr   "system"                    $ extractNoCtx >=> assertNonNull
       mHash       <- getAttrOr "outputHash"        mempty  $ extractNoCtx >=> (pure . pure)
       hashMode    <- getAttrOr "outputHashMode"    Flat    $ extractNoCtx >=> parseHashMode
-      outputs     <- getAttrOr "outputs"           ["out"] $ mapM (fromValue' >=> extractNoCtx)
+      outputs     <- getAttrOr "outputs"           ["out"] $ traverse (fromValue' >=> extractNoCtx)
 
       mFixedOutput <-
         maybe
@@ -333,7 +333,7 @@ buildDerivationWithContext drvAttrs = do
           rawString :: Text <- extractNixString jsonString
           pure $ Map.singleton "__json" rawString
         else
-          mapM (lift . coerceToString callFunc CopyToStore CoerceAny >=> extractNixString) $
+          traverse (lift . coerceToString callFunc CopyToStore CoerceAny >=> extractNixString) $
             Map.fromList $ M.toList $ deleteKeys [ "args", "__ignoreNulls" ] attrs
 
       pure $ defaultDerivation { platform, builder, args, env,  hashMode, useJson

src/Nix/Eval.hs

@@ -228,7 +228,7 @@ attrSetAlter (k : ks) pos m p val =
     ) <$> attrSetAlter ks pos st sp val
 
 desugarBinds :: forall r . ([Binding r] -> r) -> [Binding r] -> [Binding r]
-desugarBinds embed binds = evalState (mapM (go <=< collect) binds) M.empty
+desugarBinds embed binds = evalState (traverse (go <=< collect) binds) M.empty
  where
   collect
     :: Binding r
@@ -268,7 +268,7 @@ evalBinds
   -> m (AttrSet v, AttrSet SourcePos)
 evalBinds recursive binds = do
   scope <- currentScopes :: m (Scopes m v)
-  buildResult scope . concat =<< mapM (go scope) (moveOverridesLast binds)
+  buildResult scope . concat =<< traverse (go scope) (moveOverridesLast binds)
  where
   moveOverridesLast = uncurry (<>) . partition
     (\case

src/Nix/Render/Frame.hs

@@ -52,7 +52,7 @@ renderFrames (x : xs) = do
     | verbose opts <= Informational -> do
       f <- renderFrame @v @t @f x
       pure $ concatMap go (reverse xs) <> f
-    | otherwise -> concat <$> mapM (renderFrame @v @t @f) (reverse (x : xs))
+    | otherwise -> concat <$> traverse (renderFrame @v @t @f) (reverse (x : xs))
   pure $
     list
       mempty

src/Nix/Type/Infer.hs

@@ -277,7 +277,7 @@ fresh = TVar <$> freshTVar
 
 instantiate :: MonadState InferState m => Scheme -> m Type
 instantiate (Forall as t) = do
-  as' <- mapM (const fresh) as
+  as' <- traverse (const fresh) as
   let s = Subst $ Map.fromList $ zip as as'
   pure $ apply s t
 

src/Nix/Utils.hs

@@ -75,7 +75,7 @@ loeb :: Functor f => f (f a -> a) -> f a
 loeb x = go where go = fmap ($ go) x
 
 loebM :: (MonadFix m, Traversable t) => t (t a -> m a) -> m (t a)
-loebM f = mfix $ \a -> mapM ($ a) f
+loebM f = mfix $ \a -> traverse ($ a) f
 
 para :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a
 para f = f . fmap (id &&& para f) . unFix

tests/ParserTests.hs

@@ -22,6 +22,7 @@ import Prettyprinter.Render.Text
 import Test.Tasty
 import Test.Tasty.HUnit
 import Test.Tasty.TH
+import Data.Foldable (traverse_)
 
 case_constant_int = assertParseText "234" $ mkInt 234
 
@@ -229,9 +230,9 @@ case_identifier_keyword_prefix = do
 
 makeTextParseTest str = assertParseText ("\"" <> str <> "\"") $ mkStr str
 
-case_simple_string = mapM_ makeTextParseTest ["abcdef", "a", "A", "   a a  ", ""]
+case_simple_string = traverse_ makeTextParseTest ["abcdef", "a", "A", "   a a  ", ""]
 
-case_string_dollar = mapM_ makeTextParseTest ["a$b", "a$$b", "$cdef", "gh$i"]
+case_string_dollar = traverse_ makeTextParseTest ["a$b", "a$$b", "$cdef", "gh$i"]
 
 case_string_escape = do
   assertParseText "\"\\$\\n\\t\\r\\\\\"" $ mkStr "$\n\t\r\\"