[GHC] #4517: Add Data.Functor.Backwards to transformers
David Menendez
dave at zednenem.com
Sat Nov 20 22:17:29 EST 2010
On Sat, Nov 20, 2010 at 8:08 PM, Ross Paterson <ross at soi.city.ac.uk> wrote:
> On Sat, Nov 20, 2010 at 05:25:23PM -0500, roconnor at theorem.ca wrote:
>> Data.Functor.Backwards is a wrapper for functors that allow Foldable,
>> Traversable, and Applicative functors to be operated backwards. It is
>> similar to Dual for Monoids. The Applicative instance runs effects in
>> reversed order. The Foldable instance folds from right to left, The
>> Traversable instance traverses from right to left.
>
> The current version of the module is here:
>
> http://hackage.haskell.org/packages/archive/applicative-extras/0.1.6/doc/html/Control-Applicative-Backwards.html
>
> I think this fits with transformers, and the implementation for
> Traversable is cute.
>
> My only question is whether a constructor that flips Applicatives should
> be identified with one that reverses the traversal order of containers.
I have a library lying around which defines two transformers: Backward
reverses Applicative instances, and Reverse reverses Foldable,
Traversable, Alternative, and MonadPlus instances.
*Reverse> traverse (\x -> pure x <|> pure (x*10)) [1,2] :: [[Int]]
[[1,2],[1,20],[10,2],[10,20]]
*Reverse> runBackward $ traverse (\x -> pure x <|> pure (x*10)) [1,2] :: [[Int]]
[[1,2],[10,2],[1,20],[10,20]]
*Reverse> getReverse $ traverse (\x -> pure x <|> pure (x*10)) [1,2] :: [[Int]]
[[10,20],[10,2],[1,20],[1,2]]
*Reverse> runBackward . getReverse $ traverse (\x -> pure x <|> pure
(x*10)) [1,2] :: [[Int]]
[[10,20],[1,20],[10,2],[1,2]]
I'm not sure how necessary this distinction is. It was based on some
reasonable-seeming laws governing <|>/mplus/mappend and traverse, but
it's really only meaningful for lists (and other sequences which are
isomorphic to lists).
The key code is,
instance Applicative f => Applicative (Backward f) where
pure = Backward . pure
Backward f <*> Backward a = Backward (a <**> f)
instance Traversable f => Traversable (Reverse f) where
traverse f = fmap Reverse . runBackward . traverse (Backward . f)
. getReverse
instance Alternative f => Alternative (Reverse f) where
empty = Reverse empty
Reverse x <|> Reverse y = Reverse (y <|> x)
(It turns out, you can use MonadFix to apply Backward to Monad
instances as well. I'm not sure whether that's guaranteed to be
compatible with the Applicative instance.)
--
Dave Menendez <dave at zednenem.com>
<http://www.eyrie.org/~zednenem/>
More information about the Libraries
mailing list