library submission: Data.Either.unzipEithers :: [Either a b]
-> ([a], [b])
Ross Paterson
ross at soi.city.ac.uk
Mon Sep 17 09:33:39 EDT 2007
On Mon, Sep 17, 2007 at 01:51:34PM +0100, Conor McBride wrote:
> For your general amusement, a generalisation:
>
> > separate :: (Traversable t, Applicative a, Monoid (a x), Monoid (a y)) =>
> > t (Either x y) -> (a x, a y)
> > separate = foldMap (either (pure &&& mempty) (mempty &&& pure))
Or even
newtype Wrap f a = Wrap { unWrap :: f a }
instance Alternative f => Monoid (Wrap f a) where
mempty = Wrap empty
Wrap x `mappend` Wrap y = Wrap (x <|> y)
separate :: (Foldable t, Alternative f) => t (Either x y) -> (f x, f y)
separate = (unWrap *** unWrap) .
foldMap (either ((Wrap . pure) &&& mempty) (mempty &&& (Wrap . pure)))
More information about the Libraries
mailing list