Make it possible to evaluate monadic actions when assigning
record fields
Conor McBride
ctm at cs.nott.ac.uk
Wed Jul 11 08:25:15 EDT 2007
Hi
On 11 Jul 2007, at 11:13, apfelmus wrote:
> Wouter Swierstra wrote:
>>
>>
>> Using Control.Applicative you could already write:
>>
>> f <$> x <*> y
>
> No, since f is not a pure function, it's f :: x -> y -> m c. The
> correct
> form would be
>
> join $ f <$> x <*> y
>
> (Why doesn't haddock document infix precedences?) But maybe some
> type-class hackery can be used to eliminate the join.
Indeed it can. Ignoring conventional wisdom about dirty linen, here are
idiom brackets
> class Applicative i => Idiomatic i f g | g -> f i where
> idiomatic :: i f -> g
> iI :: Idiomatic i f g => f -> g
> iI = idiomatic . pure
> data Ii = Ii
> instance Applicative i => Idiomatic i x (Ii -> i x) where
> idiomatic xi Ii = xi
> instance Idiomatic i f g => Idiomatic i (s -> f) (i s -> g) where
> idiomatic sfi si = idiomatic (sfi <*> si)
So that
iI f x y Ii = f <$> x <*> y
Now add
> data Ji = Ji
> instance (Monad i, Applicative i) => Idiomatic i (i x) (Ji -> i
x) where
> idiomatic xii Ji = join xii
and you've got
iI f x y Ji = join $ f <$> x <*> y
or, more flexibly,
> data J = J
> instance (Monad i, Idiomatic i f g) => Idiomatic i (i f) (J -> g)
where
> idiomatic fii J = idiomatic (join fii)
so you can insert joins wherever you like, thus:
iI f x y J z Ii = join (f <$> x <*> y) <*> z
= do {x' <- x; y' <- y; f' <- f x y; z' <- z; return (f' z')}
Of course, the implementation is an ugly hack, made uglier still by
ASCII.
Worse, for reasons I have never entirely understood, the type-class
hackery doesn't allow these brackets to nest as they should. Even so, I
find them a considerable convenience. I always assumed that was down to
peculiarity on my part.
I thought I'd present it as a curio illustrating part of the design
space, but I don't imagine there's that big a market for an "idiom
brackets done properly" proposal.
All the best
Conor
More information about the Haskell-prime
mailing list