[Haskell-cafe] traversal with an arrow
Olaf Klinke
olf at aatal-apotheke.de
Fri Jun 17 15:01:55 UTC 2022
Dear Café,
Is there prior art to the following generalisation?
A Hoogle search for the type signatures did not turn up anything.
import Control.Arrow
import Control.Monad (foldM)
-- | Categories which every Traversable is a functor in.
-- For Traversable t, the instance should satisfy
--
-- @
-- foldMapArrow f = foldMapArrow id . traverseArrow f
-- @
class Arrow a => ArrowTraverse a where
traverseArrow :: Traversable t => a x y -> a (t x) (t y)
foldArrow :: Foldable t => a (y,x) y -> a (y,t x) y
instance ArrowTraverse (->) where
traverseArrow = fmap
foldArrow f = uncurry ((foldl.curry) f)
instance Monad m => ArrowTraverse (Kleisli m) where
traverseArrow (Kleisli k) = Kleisli (mapM k)
foldArrow (Kleisli k) = (Kleisli . uncurry) (foldM (curry k))
-- | Generalizes foldMap.
-- For Kleisli m, this function is also known as foldMapM.
foldMapArrow :: (ArrowTraverse a, Foldable f, Monoid y) => a x y -> a (f x) y
foldMapArrow f = (arr (const mempty) &&& id) >>> foldArrow ((id *** f) >>> arr (uncurry mappend))
The thing is that there are more instances for this class, for example
by using Ross Paterson's arrow transformers [1].
I found myself implementing an arrow that is a Kleisli arrow with a
reader context. Neither the standard arrow machinery nor the arrows
package seem to grant me the power to write a traverseArrow for
it. Either it can't be done, or my arrow-fu is not strong enough.
Olaf
[1] https://hackage.haskell.org/package/arrows
More information about the Haskell-Cafe
mailing list