[Haskell-cafe] Question about abstraction
Claus Reinke
claus.reinke at talk21.com
Fri Jul 4 05:57:16 EDT 2008
> combineWith :: b -> (b -> a -> b) -> a -> a -> a -> a -> b
> n `combineWith` f = \tl tr bl br -> n `f` tl `f` tr `f` bl `f` br
>
> instance Foldable T where
> foldMap f = foldT mempty $ \_ x -> f x `combineWith` mappend
>
> -- But 'traverse' won't typecheck:
>
> instance Traversable T where
> traverse f = foldT (pure L) $ \p x -> (N p <$> f x) `combineWith` (<*>)
>
> -- Is it possible to make 'combineWith' more general so that the
> -- previous typechecks (maybe using arbitrary-rank polymorphism but I
> -- don't see how)?
Looks tempting, doesn't it?-) But while the code is the same,
the types needed for the two uses are rather different (and the
inferred type not the most general one):
combineWith :: b -> (b -> a -> b) -> (a -> a-> a-> a->
b)
combineWith :: f (a->a->a->a->b) -> (forall a b . f (a->b) -> f a -> f b) -> (f a->f a->f a->f a->f
b)
We can shorten them a bit:
type Four a b = a -> a -> a -> a -> b
combineWith :: b -> (b -> a -> b) -> Four a b
combineWith :: f (Four a b) -> (forall a b . f (a->b) -> f a -> f b) -> Four (f a) (f b)
and we can add a dummy constructor to make them more similar:
newtype Id a = Id{unId::a}
combineWith :: f b -> ( f b -> f a -> f b) -> Four (f a) (f b) -- f ~ Id
combineWith :: f (Four a b) -> (forall a b . f (a->b) -> f a -> f b) -> Four (f a) (f b)
which leaves us with the crux of the matter: the function parameters
and their uses are completely different: four independent applications
of mappend vs four accumulating applications of (<*>).
We still can make the simple case look like the complex case, by
moving the mappend to the first parameter, but whether that is helpful
is another question:
combineWith :: f (Four a b) -> (forall a b . f (a->b) -> f a -> f b) -> Four (f a) (f b)
n `combineWith` f = \tl tr bl br -> n `f` tl `f` tr `f` bl `f` br
four f a b c d e = f (f (f (f a b) c) d) e
instance Foldable T where
foldMap f = unId . foldT (Id mempty) (\_ x -> Id (four mappend $ f x) `combineWith` (\(Id a) (Id
b)->Id (a b)))
instance Traversable T where
traverse f = foldT (pure L) $ \p x -> (N p <$> f x) `combineWith` (<*>)
Slightly more interesting is that foldMap should be an application
of traverse (see Traversable documentation, and its source, for
foldMapDefault).
Hth,
Claus
More information about the Haskell-Cafe
mailing list