Functor-Applicative-Monad Proposal: Difference between revisions
(Functor => Applicative => Monad Proposal) |
(pure -> return) |
||
Line 6: | Line 6: | ||
class Functor f => Applicative f where | class Functor f => Applicative f where | ||
return :: a -> f a | |||
(<*>) :: f (a -> b) -> f a -> f b | (<*>) :: f (a -> b) -> f a -> f b | ||
(*>) :: f a -> f b -> f b | (*>) :: f a -> f b -> f b |
Revision as of 06:58, 7 December 2010
The standard class hierarchy is a consequence of Haskell's historical development, rather than logic. The Functor
, Applicative
, and Monad
type classes could be defined as:
class Functor f where
map :: (a -> b) -> f a -> f b
class Functor f => Applicative f where
return :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b
(*>) :: f a -> f b -> f b
(<*) :: f a -> f b -> f a
class Applicative m => Monad m where
(>>=) :: m a -> (a -> m b) -> m b
f >>= x = join $ map f x
join :: m (m a) -> m a
join x = x >>= id
This would eliminate the necessity of declaring a Monad instance for every Applicative, and eliminate the need for sets of duplicate functions such as [fmap
, liftM
, map
, liftA
], [(<*>)
, ap
], and [concat
, join
].
fail
should be removed from Monad; a failed pattern match could error in the same way as is does for pure code. The only sensible uses for fail seem to be synonyms for mzero
.
Pointed
has not been included due to controversy as to whether it should be a subclass of Functor, a superclass of Functor, independent of Functor, or perhaps it is not sufficiently useful to include at all.
Backward compatibility could be eased with a legacy module, such as:
module Legacy where
fmap :: Functor f => (a -> b) -> f a -> f b
fmap = map
liftA :: Applicative f => (a -> b) -> f a -> f b
liftA = map
liftM :: Monad m => (a -> b) -> m a -> m b
liftM = map
ap :: Monad m => m (a -> b) -> m a -> m b
ap = (<*>)
(>>) :: Monad m => m a -> m b -> m b
(>>) = (*>)
concat :: [[a]] -> [a]
concat = join
etc.
And for those who really want a list map,
listMap :: (a -> b) -> [a] -> [b]
listMap = map