diff options
Diffstat (limited to 'compiler/utils')
| -rw-r--r-- | compiler/utils/Exception.hs | 3 | ||||
| -rw-r--r-- | compiler/utils/IOEnv.hs | 5 | ||||
| -rw-r--r-- | compiler/utils/Maybes.hs | 32 | ||||
| -rw-r--r-- | compiler/utils/State.hs | 2 | ||||
| -rw-r--r-- | compiler/utils/Stream.hs | 4 |
5 files changed, 29 insertions, 17 deletions
diff --git a/compiler/utils/Exception.hs b/compiler/utils/Exception.hs index 850393e359..8168992e00 100644 --- a/compiler/utils/Exception.hs +++ b/compiler/utils/Exception.hs @@ -6,6 +6,7 @@ module Exception ) where +import Control.Applicative as A import Control.Exception import Control.Monad.IO.Class @@ -28,7 +29,7 @@ tryIO = try -- implementations of 'gbracket' and 'gfinally' use 'gmask' -- thus rarely require overriding. -- -class MonadIO m => ExceptionMonad m where +class (A.Applicative m, MonadIO m) => ExceptionMonad m where -- | Generalised version of 'Control.Exception.catch', allowing an arbitrary -- exception handling monad instead of just 'IO'. diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs index fae3b9634f..31ac2b3731 100644 --- a/compiler/utils/IOEnv.hs +++ b/compiler/utils/IOEnv.hs @@ -58,13 +58,14 @@ unIOEnv (IOEnv m) = m instance Monad (IOEnv m) where (>>=) = thenM - (>>) = thenM_ - return = returnM + (>>) = (*>) + return = pure fail _ = failM -- Ignore the string instance Applicative (IOEnv m) where pure = returnM IOEnv f <*> IOEnv x = IOEnv (\ env -> f env <*> x env ) + (*>) = thenM_ instance Functor (IOEnv m) where fmap f (IOEnv m) = IOEnv (\ env -> fmap f (m env)) diff --git a/compiler/utils/Maybes.hs b/compiler/utils/Maybes.hs index 84e2d97d56..56b6dab5d9 100644 --- a/compiler/utils/Maybes.hs +++ b/compiler/utils/Maybes.hs @@ -68,32 +68,42 @@ instance Functor m => Functor (MaybeT m) where #if __GLASGOW_HASKELL__ < 710 -- Pre-AMP change -instance (Monad m, Functor m) => Applicative (MaybeT m) where +instance (Monad m, Applicative m) => Applicative (MaybeT m) where #else instance (Monad m) => Applicative (MaybeT m) where #endif - pure = return + pure = MaybeT . pure . Just (<*>) = ap -instance Monad m => Monad (MaybeT m) where - return = MaybeT . return . Just - x >>= f = MaybeT $ runMaybeT x >>= maybe (return Nothing) (runMaybeT . f) - fail _ = MaybeT $ return Nothing +#if __GLASGOW_HASKELL__ < 710 +-- Pre-AMP change +instance (Monad m, Applicative m) => Monad (MaybeT m) where +#else +instance (Monad m) => Monad (MaybeT m) where +#endif + return = pure + x >>= f = MaybeT $ runMaybeT x >>= maybe (pure Nothing) (runMaybeT . f) + fail _ = MaybeT $ pure Nothing #if __GLASGOW_HASKELL__ < 710 -- Pre-AMP change -instance (Monad m, Functor m) => Alternative (MaybeT m) where +instance (Monad m, Applicative m) => Alternative (MaybeT m) where #else instance (Monad m) => Alternative (MaybeT m) where #endif empty = mzero (<|>) = mplus +#if __GLASGOW_HASKELL__ < 710 +-- Pre-AMP change +instance (Monad m, Applicative m) => MonadPlus (MaybeT m) where +#else instance Monad m => MonadPlus (MaybeT m) where - mzero = MaybeT $ return Nothing +#endif + mzero = MaybeT $ pure Nothing p `mplus` q = MaybeT $ do ma <- runMaybeT p case ma of - Just a -> return (Just a) + Just a -> pure (Just a) Nothing -> runMaybeT q liftMaybeT :: Monad m => m a -> MaybeT m a @@ -113,11 +123,11 @@ instance Functor (MaybeErr err) where fmap = liftM instance Applicative (MaybeErr err) where - pure = return + pure = Succeeded (<*>) = ap instance Monad (MaybeErr err) where - return v = Succeeded v + return = pure Succeeded v >>= k = k v Failed e >>= _ = Failed e diff --git a/compiler/utils/State.hs b/compiler/utils/State.hs index 7346841613..a1903cee76 100644 --- a/compiler/utils/State.hs +++ b/compiler/utils/State.hs @@ -19,7 +19,7 @@ instance Applicative (State s) where (# x, s'' #) -> (# f x, s'' #) instance Monad (State s) where - return x = State $ \s -> (# x, s #) + return = pure m >>= n = State $ \s -> case runState' m s of (# r, s' #) -> runState' (n r) s' diff --git a/compiler/utils/Stream.hs b/compiler/utils/Stream.hs index edb0b0c558..fcef97b654 100644 --- a/compiler/utils/Stream.hs +++ b/compiler/utils/Stream.hs @@ -46,11 +46,11 @@ instance Monad f => Functor (Stream f a) where fmap = liftM instance Monad m => Applicative (Stream m a) where - pure = return + pure a = Stream (return (Left a)) (<*>) = ap instance Monad m => Monad (Stream m a) where - return a = Stream (return (Left a)) + return = pure Stream m >>= k = Stream $ do r <- m |