Superclass defaults
Bas van Dijk
v.dijk.bas at gmail.com
Mon Aug 29 14:03:37 CEST 2011
On 29 August 2011 11:11, Aleksey Khudyakov <alexey.skladnoy at gmail.com> wrote:
>> "Option 3 avoids that problem but risks perplexity: if I make use of
>> some cool package which introduces some Foo :: * -> *, I might notice
>> that Foo is a monad and add a Monad Foo instance in my own code,
>> expecting the Applicative Foo instance to be generated in concert; to
>> my horror, I find my code has subtle bugs because the package
>> introduced a different, non-monadic, Applicative Foo instance which
>> I'm accidentally using instead."
>>
>> talks about "subtle bugs". Could you give an example of such a bug?
>>
>> I would expect that the non-monadic Applicative Foo instance is always
>> somehow "compatible" with the monadic one. However I don't have a
>> clear definition of "compatible" yet...
>>
> I think it's something like that. Module Foo defines list and make
> ZipList-like Applicative instance. Would you add standard list monad
> you have a bug.
>
> But if you add monad instance which is not compatible with existing
> applicative you have bug whether you use extension or not.
>
> module Foo where
> data [a] = a : [a] | []
>
> instance Functor [] where
> fmap = map
> instamce Applicative [] where
> pure = repeat
> (<*>) = zipWith ($)
>
> module Main where
> instance Monad [] where
> return x = [x]
> (>>=) = concatMap
>
Indeed. So in other words your saying that if a programmer uses a
module which defines a stream-like list type like for example:
newtype StreamList a = SL { toList :: [a] }
instance Functor StreamList where
fmap f (SL xs) = SL (map f xs)
instance Applicative StreamList where
pure x = SL $ repeat x
SL fs <*> SL xs = SL $ zipWith ($) fs xs
And she decides to add a monad instance like the regular list monad:
instance Monad StreamList where
return x = SL [x]
xs >>= f = SL $ concatMap (toList . f) $ toList xs
That would be a mistake on her part since 'ap' would not be equivalent to '<*>'.
The correct monad instance should be something like:
instance Monad StreamList where
return = pure
xs >>= f = SL $ join $ fmap (toList . f) $ toList xs
where
join :: [[a]] -> [a]
join [] = []
join ([] :xss) = join (map tail xss)
join ((x:xs):xss) = x : join (map tail xss)
where 'ap' does equal '<*>' (not tested nor proofed yet though).
I think a good definition of "compatible" would be that forall mf mx.
ap mf mx = mf <*> mx.
So I would still like to see an example where a user defined,
non-monadic '<*>' causes bugs because it's not compatible to the
intrinsic one.
Regards,
Bas
More information about the Glasgow-haskell-users
mailing list