Add Super-classes to libraries
Haskell community has a long discussion how to implement a superclasses into Haskell.
Now it is used default
method. But it looks ugly!
But all their abilities are already implemented!
We need just 2 extensions: FlexibleInstances and UndecidableInstances
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
instance Monad m => Applicative m where
pure = return
(<*>) = ap
instance Monad m => Functor m where
fmap = liftM
instance Monad m => Bind m where
(>>-) = flip (>>=)
B.join = M.join
this code is valid!
I've already defined 3 "superclassses" for Monad: Functor, Applicative and Bind!
"superclass' instances" have unique quality from Programming Patterns and typeclasses ideology: do not inherit, extend!
We could easily extend "superclasses" and make a lot of class' dependences.
We don't need to insert inside the class some ugliness like
default return :: Applicative f => a -> f a
return = pure
Next is much prettier!
instance Monoid m => Alternative m where
(<|>) = mplus
empty = mzero
We could even use it with Generic
without any default
:
class ToJSON a where
toJSON :: a -> Value
instance (Generic a, GToJSON (Rep a)) => ToJSON a where
toJSON = genericToJSON defaultOptions
So, I suggest to made true "Applicative and Functor are superclasses of Monad" and add all necessary superclass' instances to base libraries.
Trac metadata
Trac field | Value |
---|---|
Version | 7.6.3 |
Type | FeatureRequest |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | libraries/base |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |