[Haskell] Do the libraries define S' ?
Conor T McBride
c.t.mcbride at durham.ac.uk
Thu Jul 8 06:29:03 EDT 2004
Hi folks
Iavor S. Diatchki wrote:
> hi,
> you can use the reader (environment monad) for this.
> lately i have been using 2 combinators to do things like that (thanks to
> Thomas Hallgren for showing me this):
>
> -- a nicer name for fmap (or liftM if one prefers)
> (#) :: Functor f => (a -> b) -> f a -> f b
>
> -- a nicer name for "ap" from Monad.hs
> (<#) :: Monad m => m (a -> b) -> m a -> m b
> i like those two as then you don't need all the liftM? functions.
> -iavor
As some of you know, I like them a lot too. In fact, if you have a
return-like thing and an ap-like thing, you can make fmap as well.
(Note that the return for the environment monad is none other than
S's best friend K.)
So I got hacking, a little while ago...
infixl 9 <%> -- my name for <# -- others have other names
class Idiom i where
idi :: x -> i x
(<%>) :: i (s -> t) -> i s -> i t
I call them idioms because it's like having the apparatus
of applicative programming, just in a different (perhaps impure)
idiom.
[I only just found out that they show up under the name Sequence
in the experimental Control.Sequence module. I should have known.
It's part of the Arrow stuff, and these things are an interesting
species of Arrow. As far as I know, it was Ross Paterson who
identified them in the categorical jungle as weakly symmetric lax
monoidal functors.]
I thought I'd like some `funny brackets' which would just shunt
the typechecker into an idiom and allow me to program fairly
normally. Replacing this
return f `ap` t1 `ap` ... `ap` tn
with this
idI f t1 ... tn Idi
Being a crook, I figured out how to implement my idI ... Idi
brackets. Sick hack follows:
data Idi = Idi
class Idiom i => Idiomatic i f g | g -> f i where
idI :: f -> g
idiomatic :: i f -> g
instance Idiom i => Idiomatic i x (Idi -> i x) where
idI x Idi = idi x
idiomatic ix Idi = ix
instance Idiomatic i f g => Idiomatic i (s -> f) (i s -> g) where
idI sf = idiomatic (idi sf)
idiomatic isf is = idiomatic (isf <%> is)
It's also useful to insert stuff which just has an effect in the
idiom, but whose pure part isn't important. You just shove in
Ig blah
like this---here rhubarb and custard get executed, but their
values don't get passed to f.
idI f t1 Ig rhubarb t2 t3 Ig custard Idi
How to make this work?
data Ig = Ig
instance Idiomatic i f g => Idiomatic i f (Ig -> i x -> g) where
idI f = idiomatic (idi f)
idiomatic f Ig ix = idiomatic (idi const <%> f <%> ix)
Why bother with these idioms? For one thing, it's a more functional
notation for working with monads. But there's more to it than that.
Here's a serious generalization of the Prelude's mapM
class IFunctor f where
imap :: Idiom i => (s -> i t) -> f s -> i (f t)
instance IFunctor [] where
imap f [] = idI [] Idi
imap f (x : xs) = idI (:) (f x) (imap f xs) Idi
imap is mapM when f is [] and i is a monad. To my mind, imap is
the real payoff for working with idioms. First-order type constructors
are IFunctors, but ((->) r) isn't (or you could solve the Halting
Problem). imap is more powerful than mapM not only because it
generalizes lists, but because it only needs idioms, not monads.
Here's a non-monadic idiom:
newtype Monoid a => a :<++ x = Acc {accumulated :: a}
instance Monoid a => Idiom ((:<++) a) where
idi _ = Acc mempty
Acc a <%> Acc b = Acc (mappend a b)
Now a :<++ t is a phantom type, indicating that its
a has been accumulated from some t. We can now write the
map-and-flatten pattern once, for all IFunctors and all
Monoids:
icrush :: (IFunctor f, Monoid a) => (x -> a) -> f x -> a
icrush ax = accumulated . imap (Acc . ax)
One of my favourite monoids is this:
newtype Must = Must {must :: Bool}
instance Monoid Must where
mempty = Must True
mappend (Must x) (Must y) = Must (x && y)
Now we can generalize all to IFunctors
all :: IFunctor f => (x -> Bool) -> f x -> Bool
all p = must . icrush (Must . p)
And that's how you solve the Halting Problem if ((->) r) is
an IFunctor!
[Exercise for masochists: given suitable monoids, find all
the library functions implementable by icrush idi,
modulo newtypes.]
I apologize if I'm becoming tediously repetitive every time a
whiff of this approaches the list, but I find this equipment
really useful. Quite a few people have been using it in
various forms: the parser-combinator experts had these
gadgets long ago, but I don't think they've achieved the
widespread currency they deserve. And every time they come up
as cool gadgets for working _with_monads_, I feel I have to
jump in, because they're all that and loads more.
Cheers
Conor
More information about the Haskell
mailing list