[#144] Add traverseToSnd and friends to Relude.Extra.Tuple (#145)

.hlint.yaml

@@ -2994,3 +2994,35 @@
     note: If you import 'putLBSLn' from Relude, it's already lifted
     name: '''liftIO'' is not needed'
     rhs: putLBSLn
+- hint:
+    lhs: fmap (,a) (f a)
+    note: Use `traverseToFst` from `Relude.Extra.Tuple`
+    rhs: traverseToFst f a
+- hint:
+    lhs: fmap (flip (,) a) (f a)
+    note: Use `traverseToFst` from `Relude.Extra.Tuple`
+    rhs: traverseToFst f a
+- hint:
+    lhs: (,a) <$> f a
+    note: Use `traverseToFst` from `Relude.Extra.Tuple`
+    rhs: traverseToFst f a
+- hint:
+    lhs: flip (,) a <$> f a
+    note: Use `traverseToFst` from `Relude.Extra.Tuple`
+    rhs: traverseToFst f a
+- hint:
+    lhs: fmap (a,) (f a)
+    note: Use `traverseToSnd` from `Relude.Extra.Tuple`
+    rhs: traverseToSnd f a
+- hint:
+    lhs: fmap ((,) a) (f a)
+    note: Use `traverseToSnd` from `Relude.Extra.Tuple`
+    rhs: traverseToSnd f a
+- hint:
+    lhs: (a,) <$> f a
+    note: Use `traverseToSnd` from `Relude.Extra.Tuple`
+    rhs: traverseToSnd f a
+- hint:
+    lhs: (,) a <$> f a
+    note: Use `traverseToSnd` from `Relude.Extra.Tuple`
+    rhs: traverseToSnd f a

CHANGELOG.md

@@ -5,6 +5,8 @@ The changelog is available [on GitHub][2].
 
 ## Unreleased: 0.5.0
 
+* [#144](https://github.com/kowainik/relude/issues/144):
+  Add `traverseToSnd` and friends to `Relude.Extra.Tuple`.
 * [#138](https://github.com/kowainik/relude/issues/138):
   Add `RealFloat` to `Relude.Numeric`.
 * [#125](https://github.com/kowainik/relude/issues/125):

hlint/hlint.dhall

@@ -882,4 +882,18 @@ in [ rule.Arguments { arguments =
    , warnLifted "putBSLn" "x"
    , warnLifted "putLBS" "x"
    , warnLifted "putLBSLn" "x"
+
+   ------------
+   -- Extra
+   ------------
+
+   -- Tuple
+   , hintNote "fmap (,a) (f a)"         "traverseToFst f a" "Use `traverseToFst` from `Relude.Extra.Tuple`"
+   , hintNote "fmap (flip (,) a) (f a)" "traverseToFst f a" "Use `traverseToFst` from `Relude.Extra.Tuple`"
+   , hintNote "(,a) <$> f a"            "traverseToFst f a" "Use `traverseToFst` from `Relude.Extra.Tuple`"
+   , hintNote "flip (,) a <$> f a"      "traverseToFst f a" "Use `traverseToFst` from `Relude.Extra.Tuple`"
+   , hintNote "fmap (a,) (f a)"    "traverseToSnd f a" "Use `traverseToSnd` from `Relude.Extra.Tuple`"
+   , hintNote "fmap ((,) a) (f a)" "traverseToSnd f a" "Use `traverseToSnd` from `Relude.Extra.Tuple`"
+   , hintNote "(a,) <$> f a"       "traverseToSnd f a" "Use `traverseToSnd` from `Relude.Extra.Tuple`"
+   , hintNote "(,) a <$> f a"      "traverseToSnd f a" "Use `traverseToSnd` from `Relude.Extra.Tuple`"
    ]

src/Relude/Extra/Tuple.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE TupleSections #-}
+
 {- |
 Copyright:  (c) 2018-2019 Kowainik
 License:    MIT
@@ -11,10 +13,12 @@ module Relude.Extra.Tuple
        , mapToFst
        , mapToSnd
        , mapBoth
+       , traverseToFst
+       , traverseToSnd
+       , traverseBoth
        ) where
 
--- $setup
--- >>> import Relude
+import Relude
 
 {- | Creates a tuple by pairing something with itself.
 
@@ -60,3 +64,47 @@ mapToSnd f a = (a, f a)
 mapBoth :: (a -> b) -> (a, a) -> (b, b)
 mapBoth f (a1, a2) = (f a1, f a2)
 {-# INLINE mapBoth #-}
+
+{- | Apply a function that returns a value inside of a functor,
+with the output in the first slot, the input in the second,
+and the entire tuple inside the functor.
+
+
+A dual to 'traverseToSnd'
+
+>>> traverseToFst (Just . (+1)) 10
+Just (11,10)
+>>> traverseToFst (const Nothing) 10
+Nothing
+-}
+traverseToFst :: Functor t => (a -> t b) -> a -> t (b, a)
+traverseToFst f a = (,a) <$> f a
+{-# INLINE traverseToFst #-}
+
+{- | Apply a function that returns a value inside of a functor,
+with the output in the second slot, the input in the first,
+and the entire tuple inside the functor.
+
+A dual to 'traverseToFst'.
+
+>>> traverseToSnd (Just . (+1)) 10
+Just (10,11)
+>>> traverseToSnd (const Nothing) 10
+Nothing
+-}
+traverseToSnd :: Functor t => (a -> t b) -> a -> t (a, b)
+traverseToSnd f a = (a,) <$> f a
+{-# INLINE traverseToSnd #-}
+
+{- | Maps a function that returns a value inside of
+an applicative functor over both elements of a tuple,
+with the entire tuple inside the applicative functor.
+
+>>> traverseBoth (Just . ("Hello " <>)) ("Alice", "Bob")
+Just ("Hello Alice","Hello Bob")
+>>> traverseBoth (const Nothing) ("Alice", "Bob")
+Nothing
+-}
+traverseBoth :: Applicative t => (a -> t b) -> (a, a) -> t (b, b)
+traverseBoth f (a1, a2) = (,) <$> f a1 <*> f a2
+{-# INLINE traverseBoth #-}