问题
In this answer I made up on the spot something which looks a bit like a "higher order Traversable
": like Traversable
but for functors from the category of endofunctors on Hask to Hask.
{-# LANGUAGE RankNTypes #-}
import Data.Functor.Compose
import Data.Functor.Identity
class HFunctor t where
hmap :: (forall x. f x -> g x) -> t f -> t g
class HFunctor t => HTraversable t where
htraverse :: Applicative g => (forall x. f x -> g x) -> t f -> g (t Identity)
htraverse eta = hsequence . hmap eta
hsequence :: Applicative f => t f -> f (t Identity)
hsequence = htraverse id
I made HFunctor
a superclass of HTraversable
because it seemed right, but when I sat down to write hmapDefault
I got stuck.
hmapDefault :: HTraversable t => (forall x. f x -> g x) -> t f -> t g
hmapDefault eta = runIdentity . htraverse (Identity . eta)
-- • Couldn't match type ‘x’ with ‘g x’
-- Expected type: f x -> Identity x
-- Actual type: f x -> Identity (g x)
Identity . eta
has a type forall y. f y -> Identity (g y)
, so when I pass it into htraverse
g
unifies with Identity
and x
has to unify with both y
and g y
, so it fails because the traversal function is not a natural transformation.
I attempted to patch it up using Compose
:
hmapDefault :: HTraversable t => (forall x. f x -> g x) -> t f -> t g
hmapDefault eta = runIdentity . getCompose . htraverse (Compose . Identity . eta)
Now Compose . Identity . eta
is a natural transformation, but you can't htraverse
with it because you don't know Applicative g
. And even if you could do that, the runIdentity
call returns g (t Identity)
and you're left with no way to put the g
back inside the t
.
I then realised that my htraverse
isn't really analogous to plain old traverse
. The traversal function of traverse
puts the new value inside an Applicative
effect, making the type expression bigger. So htraverse
should probably look like this:
class HFunctor t => HTraversable t where
htraverse :: Applicative a => (forall x. f x -> a (g x)) -> t f -> a (t g)
It's promising that this definition looks more like Traversable
, and hmapDefault
goes off without a hitch,
hmapDefault :: HTraversable t => (forall x. f x -> g x) -> t f -> t g
hmapDefault eta = runIdentity . htraverse (Identity . eta)
but I'm struggling to come up with a good analogue for sequenceA
. I tried
hsequence :: (HTraversable t, Applicative f) => t f -> f (t Identity)
hsequence = htraverse (fmap Identity)
but I can't come up with a way of implementing htraverse
in terms of hsequence
. As before, f
is not a natural transformation.
htraverse f = hsequence . hmap f
-- • Couldn't match type ‘x’ with ‘g x’
-- Expected type: f x -> a x
-- Actual type: f x -> a (g x)
I suspect I have my hsequence
type signature wrong. Is Applicative
the problem - do I need to go all the way up to indexed monads? What should a class for "traversable functors from the Functor
category to Hask" look like? Does such a thing even exist?
回答1:
In first order, we have sequence = traverse id
.
Here the first argument of htraverse
has type forall x. f x -> a (g x)
, we can't have id
, but we can try with an isomorphism instead. For f x
to be isomorphic to a (g x)
, we can pick f ~ Compose a g
.
htraverse = hsequence . hmap (Compose . eta)
hsequence :: Applicative a => t (Compose a g) -> a (t g)
hsequence = htraverse getCompose
来源:https://stackoverflow.com/questions/44187945/what-should-a-higher-order-traversable-class-look-like