Suggestion regarding (.) and map
Dan Doel
dan.doel at gmail.com
Thu Apr 24 17:20:22 EDT 2008
On Thursday 24 April 2008, Wolfgang Jeltsch wrote:
> I don’t think that this is reasonable. (.) corresponds to the little
> circle in math which is a composition. So (.) = (<<<) would be far better.
Were I building a library, this might be the direction I'd take things.
They're two incompatible generalizations, and you have to decide which is
more important to you.
For instance, you can generalize from arrows into categories (with objects in
*):
class Category (~>) where
id :: a ~> a
(.) :: (b ~> c) -> (a ~> b) -> (a ~> c)
And, of course, from this, you get the usual meanings for (->):
instance Category (->) where
id x = x
(f . g) x = f (g x)
An example of a Category that isn't an Arrow (I think) is:
newtype Op (~>) a b = Op { unOp :: b ~> a }
instance Category (~>) => Category (Op (~>)) where
id = Op id
-- (.) :: (b <~ c) -> (a <~ b) -> (a <~ c)
(Op f) . (Op g) = Op (g . f)
type HaskOp = Op (->)
(Why is this even potentially useful? Well, if you define functors with
reference to what two categories they relate, you get (pardon the illegal
syntax):
map :: (a ~1> b) -> (f a ~2> f b)
Which gives you current covariant endofunctors if (~1>) = (~2>) = (->), but it
also gives you contravariant endofunctors if (~1>) = (->) and (~2>) = Op
(->). Is this a useful way of structuring things in practice? I don't know.)
Now, going the (.) = map route, one should note the following Functor
instance:
instance (Arrow (~>)) => Functor ((~>) e) where
-- fmap :: (a -> b) -> (e ~> a) -> (e ~> b)
fmap f g = arr f <<< g
So, in this case (.) is composition of a pure function with an arrow, but it
does not recover full arrow composition. It certainly doesn't recover
composition in the general Category class above, because there's no operation
for lifting functions into an arbitrary Category (think Op: given a function
(a -> b), I can't get a (b -> a) in general).
(At a glance, if you have the generalized Functors that reference their
associated Categories, you have:
map (a ~1> b) -> (e ~3> a) ~2> (e ~3> b)
so for (~1>) = (~3>), and (~2>) = (->), you've recovered (.) for arbitrary
categories:
instance (Category (~>) => Functor ((~>) e) (~>) (->) where
map f g = f . g
so, perhaps with a generalized Functor, you can have (.) = map *and* have (.)
be a generalized composition.)
Now, the above Category stuff isn't even in any library that I know of, would
break tons of stuff (with the generalized Functor, which is also kind of
messy), and I haven't even seriously explored it, so it'd be ridiculous to
request going in that direction for H'. But, restricted to the current
libraries, if you do want to generalize (.), you have to decide whether you
want to generalize it as composition of arrows, or as functor application.
The former isn't a special case of the latter (with the current Functor, at
least).
Generalizing (.) to Arrow composition seems more natural to me, but
generalizing to map may well have more uses.
-- Dan
More information about the Haskell-prime
mailing list