Functor => Applicative => Monad
John Smith
voldermort at hotmail.com
Wed Dec 1 10:02:42 CET 2010
Regarding recent concerns as to whether Pointed is actually useful (and if it is, is that Pointed Functors or pure
Pointed?), how about a slightly more modest reform?
class Functor f where
map :: (a -> b) -> f a -> f b
class Functor f => Applicative f where
pure :: 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
(unrelated, but also valid)
instance MonadPlus m => Monoid (m a) where
mempty = mzero
mappend = mplus
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
More information about the Libraries
mailing list