Make it possible to evaluate monadic actions when assigning record fields

Donald Bruce Stewart dons at cse.unsw.edu.au
Wed Jul 11 08:33:56 EDT 2007


ctm:
> 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

Very nice! Just so we don't forget this, I created a wiki page,

    http://haskell.org/haskellwiki/Idiom_brackets

-- Don


More information about the Haskell-prime mailing list