Add Applicative instances for MTL types
David Menendez
dave at zednenem.com
Wed Jan 14 13:56:14 EST 2009
On Wed, Jan 14, 2009 at 12:16 PM, Bas van Dijk <v.dijk.bas at gmail.com> wrote:
> On Wed, Jan 14, 2009 at 2:50 PM, Ross Paterson <ross at soi.city.ac.uk> wrote:
>>
>> Even though Applicative is not a superclass of Monad, I think we ought to
>> ensure that the instances are compatible. That is, if an Applicative
>> is also a Monad, then we should have pure = return and (<*>) = ap.
>
> Yes, but what if an Applicative isn't a Monad?
>
> We can't have two instances because they overlap:
>
> instance Monad m => Applicative (ErrorT e m) where
> pure = return
> (<*>) = ap
>
> instance Applicative m => Applicative (ErrorT e m) where
> pure = ErrorT . pure . pure
> ef <*> ex = ErrorT $ liftA2 (<*>) (runErrorT ef) (runErrorT ex)
>
> I think the latter is more useful because there are more Applicatives
> than Monads out there.
The latter is just normal composition of applicative functors, in this
case "Comp m (Either e)".
newtype Comp f g x = Comp { unComp :: f (g x) }
instance (Functor f, Functor g) => Functor (Comp f g) where
fmap f = Comp . fmap (fmap f) . unComp
instance (Applicative f, Applicative g) => Applicative (Comp f g) where
pure = Comp . pure . pure
f <*> x = Comp $ liftA2 (<*>) (unComp f) (unComp x)
Given how easy it is to combine different functors and applicative
functors, there isn't very much need for (applicative) functor
transformers.
I agree with Ross, the functor and applicative instances for monad
transformers should satisfy these laws:
fmap = liftM
pure = return
(<*>) = ap
>> This fails for your ErrorT instance: ap runs the second computation
>> only if the first succeeded, while (<*>) runs them both before checking
>> for errors. It needs a Monad constraint (like StateT), though not an
>> Error constraint.
>
> But isn't 'runErrorT ex' only evaluated when 'runErrorT ef' returns
> 'Right f' because of lazy evaluation?
No, in your definition, the effects of the transformed applicative
functor are evaluated regardless of the error condition.
Try this code:
runState (runErrorT (throwError "!" <*> put False)) True
The first definition of <*> returns (Left "!", True). The second
returns (Left "!", False).
--
Dave Menendez <dave at zednenem.com>
<http://www.eyrie.org/~zednenem/>
More information about the Libraries
mailing list