[Haskell-cafe] (liftM join .) . mapM
Conor McBride
conor at strictlypositive.org
Tue Dec 29 13:20:16 EST 2009
Hi Tony
On 29 Dec 2009, at 12:10, Tony Morris wrote:
> Can (liftM join .) . mapM be improved?
> (Monad m) => (a -> m [b]) -> [a] -> m [b]
You can
(a) generalize m from Monad to Applicative
(b) generalize [b] to any Monoid
(c) generalize [a] to f a for any Foldable f
and write
ala AppLift foldMap
if you happen to have some of my usual kit. See below.
Cheers
Conor
Here's the machinery.
> class Newtype n where
> type Unwrap n
> wrap :: Unwrap n -> n
> unwrap :: n -> Unwrap n
> ala :: Newtype v' =>
> (t -> t') -> ((s -> t') -> u -> v') -> (s -> t) -> u ->
Unwrap v'
> ala p h f u = unwrap (h (p . f) u)
Here's a rather useful newtype, capturing applicative lifting of
monoids.
> newtype AppLift a x = AppLift (a x)
> instance (Applicative a, Monoid x) => Monoid (AppLift a x) where
> mempty = AppLift (pure mempty)
> mappend (AppLift ax) (AppLift ay) = AppLift (mappend <$> ax <*> ay)
> instance Newtype (AppLift a x) where
> type Unwrap (AppLift a x) = a x
> wrap = AppLift
> unwrap (AppLift ax) = ax
More information about the Haskell-Cafe
mailing list