import Control.Category
import Control.Arrow (Arrow(arr, (&&&)), ArrowZero(zeroArrow), ArrowPlus((<+>)))
import Control.Monad (liftM, ap, MonadPlus(..))
-import Control.Monad.Instances ()
#ifndef __NHC__
import Control.Monad.ST.Safe (ST)
import qualified Control.Monad.ST.Lazy.Safe as Lazy (ST)
import Prelude
import System.IO
-import Control.Monad.Instances ()
import Data.Function (fix)
#ifdef __HUGS__
import Hugs.Prelude (MonadFix(mfix))
-- Instances of MonadFix for Prelude monads
--- Maybe:
instance MonadFix Maybe where
mfix f = let a = f (unJust a) in a
where unJust (Just x) = x
unJust Nothing = error "mfix Maybe: Nothing"
--- List:
instance MonadFix [] where
mfix f = case fix (f . head) of
[] -> []
(x:_) -> x : mfix (tail . f)
--- IO:
instance MonadFix IO where
mfix = fixIO
--- Prelude types with Monad instances in Control.Monad.Instances
-
instance MonadFix ((->) r) where
mfix f = \ r -> let a = f a r in a
-- Stability : provisional
-- Portability : portable
--
+-- /This module is DEPRECATED and will be removed in the future!/
+--
-- 'Functor' and 'Monad' instances for @(->) r@ and
-- 'Functor' instances for @(,) a@ and @'Either' a@.
module Control.Monad.Instances (Functor(..),Monad(..)) where
import Prelude
-
-instance Functor ((->) r) where
- fmap = (.)
-
-instance Monad ((->) r) where
- return = const
- f >>= k = \ r -> k (f r) r
-
-instance Functor ((,) a) where
- fmap f (x,y) = (x, f y)
-
-instance Functor (Either a) where
- fmap _ (Left x) = Left x
- fmap f (Right y) = Right (f y)
-
-instance Monad (Either e) where
- return = Right
- Left l >>= _ = Left l
- Right r >>= k = k r
-
data Either a b = Left a | Right b
deriving (Eq, Ord, Read, Show, Generic)
+instance Functor (Either a) where
+ fmap _ (Left x) = Left x
+ fmap f (Right y) = Right (f y)
+
+instance Monad (Either e) where
+ return = Right
+ Left l >>= _ = Left l
+ Right r >>= k = k r
+
-- | Case analysis for the 'Either' type.
-- If the value is @'Left' a@, apply the first function to @a@;
-- if it is @'Right' b@, apply the second function to @b@.
{-# INLINE (>>) #-}
m >> k = m >>= \_ -> k
fail s = error s
+
+instance Functor ((->) r) where
+ fmap = (.)
+
+instance Monad ((->) r) where
+ return = const
+ f >>= k = \ r -> k (f r) r
+
+instance Functor ((,) a) where
+ fmap f (x,y) = (x, f y)
\end{code}