Remove unnecessary constraints from MonadComprehensions and ParallelListComp
Many parts of MonadComprehensions don't actually require monads instance, the following could do with a Functor
constraint
fmapM :: Monad m => (a -> b) -> m a -> m b
fmapM f xs = [ f x | x <- xs ]
and I don't see any reason why the class MonadZip
(from Control.Monad.Zip) requires a Monad
constraint rather a Functor
constraint:
class Functor f => FunctorZip f where
fzip :: f a -> f b -> f (a,b)
fzip = fzipWith (,)
fzipWith :: (a -> b -> c) -> f a -> f b -> f c
fzipWith f fa fb = fmap (uncurry f) (fzip fa fb)
funzip :: f (a,b) -> (f a, f b)
funzip fab = (fmap fst fab, fmap snd fab)
with the laws
fmap (f *** g) (fzip fa fb) = fzip (fmap f fa) (fmap g fb)
fmap (const ()) fa = fmap (const ()) fb
==> funzip (fzip fa fb) = (fa, fb)
Same with Applicative
(see ApplicativeDo):
liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
liftA2 f a1 a2 = [ f x1 x2 | x1 <- a1, x2 <- a2 ]
The reason I bring this up is because I'm writing a DSL that uses length-indexed vectors whose Functor
and FunctorZip
instances are trivial but whose Monad
instance is complicated and not need.
This proposal shares a similar rationale as ApplicativeDo.
Trac metadata
Trac field | Value |
---|---|
Version | |
Type | FeatureRequest |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler (Type checker) |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |