[Haskell-beginners] Re: maybe use for functors or arrows?
Brent Yorgey
byorgey at seas.upenn.edu
Sun Jun 27 09:36:05 EDT 2010
On Sun, Jun 27, 2010 at 09:59:42AM +0200, Heinrich Apfelmus wrote:
> Michael Mossey wrote:
>> Is there a way to write the function
>>
>> process :: [(Location,Item)] -> [(Location,ValuableItem)]
>>
>>
>> given a function indicating which Item's to keep
>>
>> transform :: Item -> Maybe ValuableItem
>>
>> using functors and arrows? The value for location stays with any item that
>> is kept.
>>
>> What I have is
>>
>> process inp = catMaybes (map g inp)
>> where g (l,i) = case transform i of
>> Nothing -> Nothing
>> Just v -> Just (l,v)
>>
>> This looks like an arrow situation to me because you want to make a
>> function that acts on the second value in a tuple, and a little bit like a
>> Maybe functor.
>
> import Control.Arrow ((***))
>
> process =
> catMaybes . map (uncurry (liftM2 (,)) . (return *** transform))
One could also do
process = catMaybes . map (sequenceA . second transform)
where
Data.Traversable.sequenceA :: (Traversable t, Applicative f) => t (f a) -> f (t a)
is used to "lift" the Maybe from the inside of the tuple to apply to
the whole tuple, specifically
sequenceA :: (a, Maybe b) -> Maybe (a,b)
Unfortunately this will not work without a Traversable instance for
((,) a), which doesn't already exist, but it ought to, and it's easy
to make:
import Data.Foldable
import Data.Traversable
instance Foldable ((,) a) where
foldMap = foldMapDefault
instance Traversable ((,) a) where
sequenceA (a,fb) = fmap ((,) a) fb
-Brent
>
> Whether this is more readable is another question.
>
>
> Regards,
> Heinrich Apfelmus
>
> --
> http://apfelmus.nfshost.com
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
More information about the Beginners
mailing list