From 1e1f7062a162899ac3618215647ac446aa1db540 Mon Sep 17 00:00:00 2001 From: ross Date: Thu, 5 Feb 2004 18:55:48 +0000 Subject: [PATCH] [project @ 2004-02-05 18:55:47 by ross] moved the monad transformer libraries into a separate mtl package. --- Control/Monad/Cont.hs | 118 ---------------- Control/Monad/Error.hs | 221 ------------------------------ Control/Monad/Identity.hs | 60 -------- Control/Monad/List.hs | 84 ------------ Control/Monad/RWS.hs | 161 ---------------------- Control/Monad/Reader.hs | 138 ------------------- Control/Monad/State.hs | 331 --------------------------------------------- Control/Monad/Trans.hs | 44 ------ Control/Monad/Writer.hs | 165 ---------------------- Makefile.nhc98 | 7 +- 10 files changed, 1 insertion(+), 1328 deletions(-) delete mode 100644 Control/Monad/Cont.hs delete mode 100644 Control/Monad/Error.hs delete mode 100644 Control/Monad/Identity.hs delete mode 100644 Control/Monad/List.hs delete mode 100644 Control/Monad/RWS.hs delete mode 100644 Control/Monad/Reader.hs delete mode 100644 Control/Monad/State.hs delete mode 100644 Control/Monad/Trans.hs delete mode 100644 Control/Monad/Writer.hs diff --git a/Control/Monad/Cont.hs b/Control/Monad/Cont.hs deleted file mode 100644 index 26af5ed..0000000 --- a/Control/Monad/Cont.hs +++ /dev/null @@ -1,118 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Cont --- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : non-portable (multi-parameter type classes) --- --- Continuation monads. --- ------------------------------------------------------------------------------ - -module Control.Monad.Cont ( - MonadCont(..), - Cont(..), - mapCont, - withCont, - ContT(..), - mapContT, - withContT, - module Control.Monad, - module Control.Monad.Trans, - ) where - -import Prelude - -import Control.Monad -import Control.Monad.Trans -import Control.Monad.Reader -import Control.Monad.Writer -import Control.Monad.State -import Control.Monad.RWS - -class (Monad m) => MonadCont m where - callCC :: ((a -> m b) -> m a) -> m a - --- --------------------------------------------------------------------------- --- Our parameterizable continuation monad - -newtype Cont r a = Cont { runCont :: (a -> r) -> r } - -instance Functor (Cont r) where - fmap f m = Cont $ \c -> runCont m (c . f) - -instance Monad (Cont r) where - return a = Cont ($ a) - m >>= k = Cont $ \c -> runCont m $ \a -> runCont (k a) c - -instance MonadCont (Cont r) where - callCC f = Cont $ \c -> runCont (f (\a -> Cont $ \_ -> c a)) c - -mapCont :: (r -> r) -> Cont r a -> Cont r a -mapCont f m = Cont $ f . runCont m - -withCont :: ((b -> r) -> (a -> r)) -> Cont r a -> Cont r b -withCont f m = Cont $ runCont m . f - --- --------------------------------------------------------------------------- --- Our parameterizable continuation monad, with an inner monad - -newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r } - -instance (Monad m) => Functor (ContT r m) where - fmap f m = ContT $ \c -> runContT m (c . f) - -instance (Monad m) => Monad (ContT r m) where - return a = ContT ($ a) - m >>= k = ContT $ \c -> runContT m (\a -> runContT (k a) c) - -instance (Monad m) => MonadCont (ContT r m) where - callCC f = ContT $ \c -> runContT (f (\a -> ContT $ \_ -> c a)) c - -instance MonadTrans (ContT r) where - lift m = ContT (m >>=) - -instance (MonadIO m) => MonadIO (ContT r m) where - liftIO = lift . liftIO - -instance (MonadReader r' m) => MonadReader r' (ContT r m) where - ask = lift ask - local f m = ContT $ \c -> do - r <- ask - local f (runContT m (local (const r) . c)) - -instance (MonadState s m) => MonadState s (ContT r m) where - get = lift get - put = lift . put - --- ----------------------------------------------------------------------------- --- MonadCont instances for other monad transformers - -instance (MonadCont m) => MonadCont (ReaderT r m) where - callCC f = ReaderT $ \r -> - callCC $ \c -> - runReaderT (f (\a -> ReaderT $ \_ -> c a)) r - -instance (MonadCont m) => MonadCont (StateT s m) where - callCC f = StateT $ \s -> - callCC $ \c -> - runStateT (f (\a -> StateT $ \s' -> c (a, s'))) s - -instance (Monoid w, MonadCont m) => MonadCont (WriterT w m) where - callCC f = WriterT $ - callCC $ \c -> - runWriterT (f (\a -> WriterT $ c (a, mempty))) - -instance (Monoid w, MonadCont m) => MonadCont (RWST r w s m) where - callCC f = RWST $ \r s -> - callCC $ \c -> - runRWST (f (\a -> RWST $ \_ s' -> c (a, s', mempty))) r s - -mapContT :: (m r -> m r) -> ContT r m a -> ContT r m a -mapContT f m = ContT $ f . runContT m - -withContT :: ((b -> m r) -> (a -> m r)) -> ContT r m a -> ContT r m b -withContT f m = ContT $ runContT m . f diff --git a/Control/Monad/Error.hs b/Control/Monad/Error.hs deleted file mode 100644 index cfb536d..0000000 --- a/Control/Monad/Error.hs +++ /dev/null @@ -1,221 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Error --- Copyright : (c) Michael Weber , 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : non-portable (multi-parameter type classes) --- --- The Error monad. --- --- Rendered by Michael Weber , --- inspired by the Haskell Monad Template Library from --- Andy Gill () --- ------------------------------------------------------------------------------ - -module Control.Monad.Error ( - Error(..), - MonadError(..), - ErrorT(..), - mapErrorT, - module Control.Monad, - module Control.Monad.Fix, - module Control.Monad.Trans, - ) where - -import Prelude - -import Control.Monad -import Control.Monad.Fix -import Control.Monad.Trans -import Control.Monad.Reader -import Control.Monad.Writer -import Control.Monad.State -import Control.Monad.RWS -import Control.Monad.Cont - -import System.IO - --- --------------------------------------------------------------------------- --- class MonadError --- --- throws an exception inside the monad and thus interrupts --- normal execution order, until an error handler is reached} --- --- catches an exception inside the monad (that was previously --- thrown by throwError - -class Error a where - noMsg :: a - strMsg :: String -> a - - noMsg = strMsg "" - strMsg _ = noMsg - -instance Error [Char] where - noMsg = "" - strMsg = id - -instance Error IOError where - strMsg = userError - -class (Monad m) => MonadError e m | m -> e where - throwError :: e -> m a - catchError :: m a -> (e -> m a) -> m a - -instance MonadPlus IO where - mzero = ioError (userError "mzero") - m `mplus` n = m `catch` \_ -> n - -instance MonadError IOError IO where - throwError = ioError - catchError = catch - --- --------------------------------------------------------------------------- --- Our parameterizable error monad - -instance Functor (Either e) where - fmap _ (Left l) = Left l - fmap f (Right r) = Right (f r) - -instance (Error e) => Monad (Either e) where - return = Right - Left l >>= _ = Left l - Right r >>= k = k r - fail msg = Left (strMsg msg) - -instance (Error e) => MonadPlus (Either e) where - mzero = Left noMsg - Left _ `mplus` n = n - m `mplus` _ = m - -instance (Error e) => MonadFix (Either e) where - mfix f = let - a = f $ case a of - Right r -> r - _ -> error "empty mfix argument" - in a - -instance (Error e) => MonadError e (Either e) where - throwError = Left - Left l `catchError` h = h l - Right r `catchError` _ = Right r - --- --------------------------------------------------------------------------- --- Our parameterizable error monad, with an inner monad - -newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) } - --- The ErrorT Monad structure is parameterized over two things: --- * e - The error type. --- * m - The inner monad. - --- Here are some examples of use: --- --- type ErrorWithIO e a = ErrorT e IO a --- ==> ErrorT (IO (Either e a)) --- --- type ErrorAndStateWithIO e s a = ErrorT e (StateT s IO) a --- ==> ErrorT (StateT s IO (Either e a)) --- ==> ErrorT (StateT (s -> IO (Either e a,s))) --- - -instance (Monad m) => Functor (ErrorT e m) where - fmap f m = ErrorT $ do - a <- runErrorT m - case a of - Left l -> return (Left l) - Right r -> return (Right (f r)) - -instance (Monad m, Error e) => Monad (ErrorT e m) where - return a = ErrorT $ return (Right a) - m >>= k = ErrorT $ do - a <- runErrorT m - case a of - Left l -> return (Left l) - Right r -> runErrorT (k r) - fail msg = ErrorT $ return (Left (strMsg msg)) - -instance (Monad m, Error e) => MonadPlus (ErrorT e m) where - mzero = ErrorT $ return (Left noMsg) - m `mplus` n = ErrorT $ do - a <- runErrorT m - case a of - Left _ -> runErrorT n - Right r -> return (Right r) - -instance (MonadFix m, Error e) => MonadFix (ErrorT e m) where - mfix f = ErrorT $ mfix $ \a -> runErrorT $ f $ case a of - Right r -> r - _ -> error "empty mfix argument" - -instance (Monad m, Error e) => MonadError e (ErrorT e m) where - throwError l = ErrorT $ return (Left l) - m `catchError` h = ErrorT $ do - a <- runErrorT m - case a of - Left l -> runErrorT (h l) - Right r -> return (Right r) - -instance (Error e) => MonadTrans (ErrorT e) where - lift m = ErrorT $ do - a <- m - return (Right a) - -instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where - liftIO = lift . liftIO - -instance (Error e, MonadReader r m) => MonadReader r (ErrorT e m) where - ask = lift ask - local f m = ErrorT $ local f (runErrorT m) - -instance (Error e, MonadWriter w m) => MonadWriter w (ErrorT e m) where - tell = lift . tell - listen m = ErrorT $ do - (a, w) <- listen (runErrorT m) - return $ case a of - Left l -> Left l - Right r -> Right (r, w) - pass m = ErrorT $ pass $ do - a <- runErrorT m - return $ case a of - Left l -> (Left l, id) - Right (r, f) -> (Right r, f) - -instance (Error e, MonadState s m) => MonadState s (ErrorT e m) where - get = lift get - put = lift . put - -instance (Error e, MonadCont m) => MonadCont (ErrorT e m) where - callCC f = ErrorT $ - callCC $ \c -> - runErrorT (f (\a -> ErrorT $ c (Right a))) - -mapErrorT :: (m (Either e a) -> n (Either e' b)) -> ErrorT e m a -> ErrorT e' n b -mapErrorT f m = ErrorT $ f (runErrorT m) - --- --------------------------------------------------------------------------- --- MonadError instances for other monad transformers - -instance (MonadError e m) => MonadError e (ReaderT r m) where - throwError = lift . throwError - m `catchError` h = ReaderT $ \r -> runReaderT m r - `catchError` \e -> runReaderT (h e) r - -instance (Monoid w, MonadError e m) => MonadError e (WriterT w m) where - throwError = lift . throwError - m `catchError` h = WriterT $ runWriterT m - `catchError` \e -> runWriterT (h e) - -instance (MonadError e m) => MonadError e (StateT s m) where - throwError = lift . throwError - m `catchError` h = StateT $ \s -> runStateT m s - `catchError` \e -> runStateT (h e) s - -instance (Monoid w, MonadError e m) => MonadError e (RWST r w s m) where - throwError = lift . throwError - m `catchError` h = RWST $ \r s -> runRWST m r s - `catchError` \e -> runRWST (h e) r s diff --git a/Control/Monad/Identity.hs b/Control/Monad/Identity.hs deleted file mode 100644 index 4fb5e35..0000000 --- a/Control/Monad/Identity.hs +++ /dev/null @@ -1,60 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Identity --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : portable --- --- The Identity monad. --- --- Inspired by the paper --- /Functional Programming with Overloading and --- Higher-Order Polymorphism/, --- Mark P Jones () --- Advanced School of Functional Programming, 1995. --- ------------------------------------------------------------------------------ - -module Control.Monad.Identity ( - Identity(..), - module Control.Monad, - module Control.Monad.Fix, - ) where - -import Prelude - -import Control.Monad -import Control.Monad.Fix - --- --------------------------------------------------------------------------- --- Identity wrapper --- --- Abstraction for wrapping up a object. --- If you have an monadic function, say: --- --- example :: Int -> IdentityMonad Int --- example x = return (x*x) --- --- you can "run" it, using --- --- Main> runIdentity (example 42) --- 1764 :: Int - -newtype Identity a = Identity { runIdentity :: a } - --- --------------------------------------------------------------------------- --- Identity instances for Functor and Monad - -instance Functor Identity where - fmap f m = Identity (f (runIdentity m)) - -instance Monad Identity where - return a = Identity a - m >>= k = k (runIdentity m) - -instance MonadFix Identity where - mfix f = Identity (fix (runIdentity . f)) diff --git a/Control/Monad/List.hs b/Control/Monad/List.hs deleted file mode 100644 index 9acb29c..0000000 --- a/Control/Monad/List.hs +++ /dev/null @@ -1,84 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.List --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : non-portable (multi-parameter type classes) --- --- The List monad. --- ------------------------------------------------------------------------------ - -module Control.Monad.List ( - ListT(..), - mapListT, - module Control.Monad, - module Control.Monad.Trans, - ) where - -import Prelude - -import Control.Monad -import Control.Monad.Trans -import Control.Monad.Reader -import Control.Monad.State -import Control.Monad.Cont -import Control.Monad.Error - --- --------------------------------------------------------------------------- --- Our parameterizable list monad, with an inner monad - -newtype ListT m a = ListT { runListT :: m [a] } - -instance (Monad m) => Functor (ListT m) where - fmap f m = ListT $ do - a <- runListT m - return (map f a) - -instance (Monad m) => Monad (ListT m) where - return a = ListT $ return [a] - m >>= k = ListT $ do - a <- runListT m - b <- mapM (runListT . k) a - return (concat b) - fail _ = ListT $ return [] - -instance (Monad m) => MonadPlus (ListT m) where - mzero = ListT $ return [] - m `mplus` n = ListT $ do - a <- runListT m - b <- runListT n - return (a ++ b) - -instance MonadTrans ListT where - lift m = ListT $ do - a <- m - return [a] - -instance (MonadIO m) => MonadIO (ListT m) where - liftIO = lift . liftIO - -instance (MonadReader s m) => MonadReader s (ListT m) where - ask = lift ask - local f m = ListT $ local f (runListT m) - -instance (MonadState s m) => MonadState s (ListT m) where - get = lift get - put = lift . put - -instance (MonadCont m) => MonadCont (ListT m) where - callCC f = ListT $ - callCC $ \c -> - runListT (f (\a -> ListT $ c [a])) - -instance (MonadError e m) => MonadError e (ListT m) where - throwError = lift . throwError - m `catchError` h = ListT $ runListT m - `catchError` \e -> runListT (h e) - -mapListT :: (m [a] -> n [b]) -> ListT m a -> ListT n b -mapListT f m = ListT $ f (runListT m) diff --git a/Control/Monad/RWS.hs b/Control/Monad/RWS.hs deleted file mode 100644 index 36c9d5c..0000000 --- a/Control/Monad/RWS.hs +++ /dev/null @@ -1,161 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.RWS --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : non-portable (multi-param classes, functional dependencies) --- --- Declaration of the MonadRWS class. --- --- Inspired by the paper --- /Functional Programming with Overloading and --- Higher-Order Polymorphism/, --- Mark P Jones () --- Advanced School of Functional Programming, 1995. ------------------------------------------------------------------------------ - -module Control.Monad.RWS ( - RWS(..), - evalRWS, - execRWS, - mapRWS, - withRWS, - RWST(..), - evalRWST, - execRWST, - mapRWST, - withRWST, - module Control.Monad.Reader, - module Control.Monad.Writer, - module Control.Monad.State, - ) where - -import Prelude - -import Control.Monad -import Control.Monad.Fix -import Control.Monad.Trans -import Control.Monad.Reader -import Control.Monad.Writer -import Control.Monad.State -import Data.Monoid - -newtype RWS r w s a = RWS { runRWS :: r -> s -> (a, s, w) } - -instance Functor (RWS r w s) where - fmap f m = RWS $ \r s -> let - (a, s', w) = runRWS m r s - in (f a, s', w) - -instance (Monoid w) => Monad (RWS r w s) where - return a = RWS $ \_ s -> (a, s, mempty) - m >>= k = RWS $ \r s -> let - (a, s', w) = runRWS m r s - (b, s'', w') = runRWS (k a) r s' - in (b, s'', w `mappend` w') - -instance (Monoid w) => MonadFix (RWS r w s) where - mfix f = RWS $ \r s -> let (a, s', w) = runRWS (f a) r s in (a, s', w) - -instance (Monoid w) => MonadReader r (RWS r w s) where - ask = RWS $ \r s -> (r, s, mempty) - local f m = RWS $ \r s -> runRWS m (f r) s - -instance (Monoid w) => MonadWriter w (RWS r w s) where - tell w = RWS $ \_ s -> ((), s, w) - listen m = RWS $ \r s -> let - (a, s', w) = runRWS m r s - in ((a, w), s', w) - pass m = RWS $ \r s -> let - ((a, f), s', w) = runRWS m r s - in (a, s', f w) - -instance (Monoid w) => MonadState s (RWS r w s) where - get = RWS $ \_ s -> (s, s, mempty) - put s = RWS $ \_ _ -> ((), s, mempty) - - -evalRWS :: RWS r w s a -> r -> s -> (a, w) -evalRWS m r s = let - (a, _, w) = runRWS m r s - in (a, w) - -execRWS :: RWS r w s a -> r -> s -> (s, w) -execRWS m r s = let - (_, s', w) = runRWS m r s - in (s', w) - -mapRWS :: ((a, s, w) -> (b, s, w')) -> RWS r w s a -> RWS r w' s b -mapRWS f m = RWS $ \r s -> f (runRWS m r s) - -withRWS :: (r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a -withRWS f m = RWS $ \r s -> uncurry (runRWS m) (f r s) - - -newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) } - -instance (Monad m) => Functor (RWST r w s m) where - fmap f m = RWST $ \r s -> do - (a, s', w) <- runRWST m r s - return (f a, s', w) - -instance (Monoid w, Monad m) => Monad (RWST r w s m) where - return a = RWST $ \_ s -> return (a, s, mempty) - m >>= k = RWST $ \r s -> do - (a, s', w) <- runRWST m r s - (b, s'',w') <- runRWST (k a) r s' - return (b, s'', w `mappend` w') - fail msg = RWST $ \_ _ -> fail msg - -instance (Monoid w, MonadPlus m) => MonadPlus (RWST r w s m) where - mzero = RWST $ \_ _ -> mzero - m `mplus` n = RWST $ \r s -> runRWST m r s `mplus` runRWST n r s - -instance (Monoid w, MonadFix m) => MonadFix (RWST r w s m) where - mfix f = RWST $ \r s -> mfix $ \ ~(a, _, _) -> runRWST (f a) r s - -instance (Monoid w, Monad m) => MonadReader r (RWST r w s m) where - ask = RWST $ \r s -> return (r, s, mempty) - local f m = RWST $ \r s -> runRWST m (f r) s - -instance (Monoid w, Monad m) => MonadWriter w (RWST r w s m) where - tell w = RWST $ \_ s -> return ((),s,w) - listen m = RWST $ \r s -> do - (a, s', w) <- runRWST m r s - return ((a, w), s', w) - pass m = RWST $ \r s -> do - ((a, f), s', w) <- runRWST m r s - return (a, s', f w) - -instance (Monoid w, Monad m) => MonadState s (RWST r w s m) where - get = RWST $ \_ s -> return (s, s, mempty) - put s = RWST $ \_ _ -> return ((), s, mempty) - -instance (Monoid w) => MonadTrans (RWST r w s) where - lift m = RWST $ \_ s -> do - a <- m - return (a, s, mempty) - -instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where - liftIO = lift . liftIO - - -evalRWST :: (Monad m) => RWST r w s m a -> r -> s -> m (a, w) -evalRWST m r s = do - (a, _, w) <- runRWST m r s - return (a, w) - -execRWST :: (Monad m) => RWST r w s m a -> r -> s -> m (s, w) -execRWST m r s = do - (_, s', w) <- runRWST m r s - return (s', w) - -mapRWST :: (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b -mapRWST f m = RWST $ \r s -> f (runRWST m r s) - -withRWST :: (r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a -withRWST f m = RWST $ \r s -> uncurry (runRWST m) (f r s) diff --git a/Control/Monad/Reader.hs b/Control/Monad/Reader.hs deleted file mode 100644 index 51415d3..0000000 --- a/Control/Monad/Reader.hs +++ /dev/null @@ -1,138 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Reader --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : non-portable (multi-param classes, functional dependencies) --- --- Declaration of the Monoid class,and instances for list and functions --- --- Inspired by the paper --- /Functional Programming with Overloading and --- Higher-Order Polymorphism/, --- Mark P Jones () --- Advanced School of Functional Programming, 1995. ------------------------------------------------------------------------------ - -module Control.Monad.Reader ( - MonadReader(..), - asks, - Reader(..), - mapReader, - withReader, - ReaderT(..), - mapReaderT, - withReaderT, - module Control.Monad, - module Control.Monad.Fix, - module Control.Monad.Trans, - ) where - -import Prelude - -import Control.Monad -import Control.Monad.Fix -import Control.Monad.Trans - --- ---------------------------------------------------------------------------- --- class MonadReader --- asks for the internal (non-mutable) state. - -class (Monad m) => MonadReader r m | m -> r where - ask :: m r - local :: (r -> r) -> m a -> m a - --- This allows you to provide a projection function. - -asks :: (MonadReader r m) => (r -> a) -> m a -asks f = do - r <- ask - return (f r) - --- ---------------------------------------------------------------------------- --- The partially applied function type is a simple reader monad - -instance Functor ((->) r) where - fmap = (.) - -instance Monad ((->) r) where - return = const - m >>= k = \r -> k (m r) r - -instance MonadFix ((->) r) where - mfix f = \r -> let a = f a r in a - -instance MonadReader r ((->) r) where - ask = id - local f m = m . f - --- --------------------------------------------------------------------------- --- Our parameterizable reader monad - -newtype Reader r a = Reader { runReader :: r -> a } - -instance Functor (Reader r) where - fmap f m = Reader $ \r -> f (runReader m r) - -instance Monad (Reader r) where - return a = Reader $ \_ -> a - m >>= k = Reader $ \r -> runReader (k (runReader m r)) r - -instance MonadFix (Reader r) where - mfix f = Reader $ \r -> let a = runReader (f a) r in a - -instance MonadReader r (Reader r) where - ask = Reader id - local f m = Reader $ runReader m . f - -mapReader :: (a -> b) -> Reader r a -> Reader r b -mapReader f m = Reader $ f . runReader m - --- This is a more general version of local. - -withReader :: (r' -> r) -> Reader r a -> Reader r' a -withReader f m = Reader $ runReader m . f - --- --------------------------------------------------------------------------- --- Our parameterizable reader monad, with an inner monad - -newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a } - -instance (Monad m) => Functor (ReaderT r m) where - fmap f m = ReaderT $ \r -> do - a <- runReaderT m r - return (f a) - -instance (Monad m) => Monad (ReaderT r m) where - return a = ReaderT $ \_ -> return a - m >>= k = ReaderT $ \r -> do - a <- runReaderT m r - runReaderT (k a) r - fail msg = ReaderT $ \_ -> fail msg - -instance (MonadPlus m) => MonadPlus (ReaderT r m) where - mzero = ReaderT $ \_ -> mzero - m `mplus` n = ReaderT $ \r -> runReaderT m r `mplus` runReaderT n r - -instance (MonadFix m) => MonadFix (ReaderT r m) where - mfix f = ReaderT $ \r -> mfix $ \a -> runReaderT (f a) r - -instance (Monad m) => MonadReader r (ReaderT r m) where - ask = ReaderT return - local f m = ReaderT $ \r -> runReaderT m (f r) - -instance MonadTrans (ReaderT r) where - lift m = ReaderT $ \_ -> m - -instance (MonadIO m) => MonadIO (ReaderT r m) where - liftIO = lift . liftIO - -mapReaderT :: (m a -> n b) -> ReaderT w m a -> ReaderT w n b -mapReaderT f m = ReaderT $ f . runReaderT m - -withReaderT :: (r' -> r) -> ReaderT r m a -> ReaderT r' m a -withReaderT f m = ReaderT $ runReaderT m . f diff --git a/Control/Monad/State.hs b/Control/Monad/State.hs deleted file mode 100644 index 3fec375..0000000 --- a/Control/Monad/State.hs +++ /dev/null @@ -1,331 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.State --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : non-portable (multi-param classes, functional dependencies) --- --- State monads. --- --- This module is inspired by the paper --- /Functional Programming with Overloading and --- Higher-Order Polymorphism/, --- Mark P Jones () --- Advanced School of Functional Programming, 1995. --- --- See below for examples. - ------------------------------------------------------------------------------ - -module Control.Monad.State ( - -- * MonadState class - MonadState(..), - modify, - gets, - -- * The State Monad - State(..), - evalState, - execState, - mapState, - withState, - -- * The StateT Monad - StateT(..), - evalStateT, - execStateT, - mapStateT, - withStateT, - module Control.Monad, - module Control.Monad.Fix, - module Control.Monad.Trans, - -- * Examples - -- $examples - ) where - -import Prelude - -import Control.Monad -import Control.Monad.Fix -import Control.Monad.Trans -import Control.Monad.Reader -import Control.Monad.Writer - --- --------------------------------------------------------------------------- --- | /get/ returns the state from the internals of the monad. --- --- /put/ replaces the state inside the monad. - -class (Monad m) => MonadState s m | m -> s where - get :: m s - put :: s -> m () - --- | Monadic state transformer. --- --- Maps an old state to a new state inside a state monad. --- The old state is thrown away. --- --- > Main> :t modify ((+1) :: Int -> Int) --- > modify (...) :: (MonadState Int a) => a () --- --- This says that @modify (+1)@ acts over any --- Monad that is a member of the @MonadState@ class, --- with an @Int@ state. - -modify :: (MonadState s m) => (s -> s) -> m () -modify f = do - s <- get - put (f s) - --- | Gets specific component of the state, using a projection function --- supplied. - -gets :: (MonadState s m) => (s -> a) -> m a -gets f = do - s <- get - return (f s) - --- --------------------------------------------------------------------------- --- | A parameterizable state monad where /s/ is the type of the state --- to carry and /a/ is the type of the /return value/. - -newtype State s a = State { runState :: s -> (a, s) } - --- The State Monad structure is parameterized over just the state. - -instance Functor (State s) where - fmap f m = State $ \s -> let - (a, s') = runState m s - in (f a, s') - -instance Monad (State s) where - return a = State $ \s -> (a, s) - m >>= k = State $ \s -> let - (a, s') = runState m s - in runState (k a) s' - -instance MonadFix (State s) where - mfix f = State $ \s -> let (a, s') = runState (f a) s in (a, s') - -instance MonadState s (State s) where - get = State $ \s -> (s, s) - put s = State $ \_ -> ((), s) - --- |Evaluate this state monad with the given initial state,throwing --- away the final state. Very much like @fst@ composed with --- @runstate@. - -evalState :: State s a -- ^The state to evaluate - -> s -- ^An initial value - -> a -- ^The return value of the state application -evalState m s = fst (runState m s) - --- |Execute this state and return the new state, throwing away the --- return value. Very much like @snd@ composed with --- @runstate@. - -execState :: State s a -- ^The state to evaluate - -> s -- ^An initial value - -> s -- ^The new state -execState m s = snd (runState m s) - --- |Map a stateful computation from one (return value, state) pair to --- another. For instance, to convert numberTree from a function that --- returns a tree to a function that returns the sum of the numbered --- tree (see the Examples section for numberTree and sumTree) you may --- write: --- --- > sumNumberedTree :: (Eq a) => Tree a -> State (Table a) Int --- > sumNumberedTree = mapState (\ (t, tab) -> (sumTree t, tab)) . numberTree - -mapState :: ((a, s) -> (b, s)) -> State s a -> State s b -mapState f m = State $ f . runState m - --- |Apply this function to this state and return the resulting state. -withState :: (s -> s) -> State s a -> State s a -withState f m = State $ runState m . f - --- --------------------------------------------------------------------------- --- | A parameterizable state monad for encapsulating an inner --- monad. --- --- The StateT Monad structure is parameterized over two things: --- --- * s - The state. --- --- * m - The inner monad. --- --- Here are some examples of use: --- --- (Parser from ParseLib with Hugs) --- --- > type Parser a = StateT String [] a --- > ==> StateT (String -> [(a,String)]) --- --- For example, item can be written as: --- --- > item = do (x:xs) <- get --- > put xs --- > return x --- > --- > type BoringState s a = StateT s Indentity a --- > ==> StateT (s -> Identity (a,s)) --- > --- > type StateWithIO s a = StateT s IO a --- > ==> StateT (s -> IO (a,s)) --- > --- > type StateWithErr s a = StateT s Maybe a --- > ==> StateT (s -> Maybe (a,s)) - -newtype StateT s m a = StateT { runStateT :: s -> m (a,s) } - -instance (Monad m) => Functor (StateT s m) where - fmap f m = StateT $ \s -> do - (x, s') <- runStateT m s - return (f x, s') - -instance (Monad m) => Monad (StateT s m) where - return a = StateT $ \s -> return (a, s) - m >>= k = StateT $ \s -> do - (a, s') <- runStateT m s - runStateT (k a) s' - fail str = StateT $ \_ -> fail str - -instance (MonadPlus m) => MonadPlus (StateT s m) where - mzero = StateT $ \_ -> mzero - m `mplus` n = StateT $ \s -> runStateT m s `mplus` runStateT n s - -instance (MonadFix m) => MonadFix (StateT s m) where - mfix f = StateT $ \s -> mfix $ \ ~(a, _) -> runStateT (f a) s - -instance (Monad m) => MonadState s (StateT s m) where - get = StateT $ \s -> return (s, s) - put s = StateT $ \_ -> return ((), s) - -instance MonadTrans (StateT s) where - lift m = StateT $ \s -> do - a <- m - return (a, s) - -instance (MonadIO m) => MonadIO (StateT s m) where - liftIO = lift . liftIO - -instance (MonadReader r m) => MonadReader r (StateT s m) where - ask = lift ask - local f m = StateT $ \s -> local f (runStateT m s) - -instance (MonadWriter w m) => MonadWriter w (StateT s m) where - tell = lift . tell - listen m = StateT $ \s -> do - ((a, s'), w) <- listen (runStateT m s) - return ((a, w), s') - pass m = StateT $ \s -> pass $ do - ((a, f), s') <- runStateT m s - return ((a, s'), f) - --- |Similar to 'evalState' -evalStateT :: (Monad m) => StateT s m a -> s -> m a -evalStateT m s = do - (a, _) <- runStateT m s - return a - --- |Similar to 'execState' -execStateT :: (Monad m) => StateT s m a -> s -> m s -execStateT m s = do - (_, s') <- runStateT m s - return s' - --- |Similar to 'mapState' -mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b -mapStateT f m = StateT $ f . runStateT m - --- |Similar to 'withState' -withStateT :: (s -> s) -> StateT s m a -> StateT s m a -withStateT f m = StateT $ runStateT m . f - --- --------------------------------------------------------------------------- --- MonadState instances for other monad transformers - -instance (MonadState s m) => MonadState s (ReaderT r m) where - get = lift get - put = lift . put - -instance (Monoid w, MonadState s m) => MonadState s (WriterT w m) where - get = lift get - put = lift . put - --- --------------------------------------------------------------------------- --- $examples --- A function to increment a counter. Taken from the paper --- /Generalising Monads to Arrows/, John --- Hughes (), November 1998: --- --- > tick :: State Int Int --- > tick = do n <- get --- > put (n+1) --- > return n --- --- Add one to the given number using the state monad: --- --- > plusOne :: Int -> Int --- > plusOne n = execState tick n --- --- A contrived addition example. Works only with positive numbers: --- --- > plus :: Int -> Int -> Int --- > plus n x = execState (sequence $ replicate n tick) x --- --- An example from /The Craft of Functional Programming/, Simon --- Thompson (), --- Addison-Wesley 1999: \"Given an arbitrary tree, transform it to a --- tree of integers in which the original elements are replaced by --- natural numbers, starting from 0. The same element has to be --- replaced by the same number at every occurrence, and when we meet --- an as-yet-unvisited element we have to find a 'new' number to match --- it with:\" --- --- > data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show, Eq) --- > type Table a = [a] --- --- > numberTree :: Eq a => Tree a -> State (Table a) (Tree Int) --- > numberTree Nil = return Nil --- > numberTree (Node x t1 t2) --- > = do num <- numberNode x --- > nt1 <- numberTree t1 --- > nt2 <- numberTree t2 --- > return (Node num nt1 nt2) --- > where --- > numberNode :: Eq a => a -> State (Table a) Int --- > numberNode x --- > = do table <- get --- > (newTable, newPos) <- return (nNode x table) --- > put newTable --- > return newPos --- > nNode:: (Eq a) => a -> Table a -> (Table a, Int) --- > nNode x table --- > = case (findIndexInList (== x) table) of --- > Nothing -> (table ++ [x], length table) --- > Just i -> (table, i) --- > findIndexInList :: (a -> Bool) -> [a] -> Maybe Int --- > findIndexInList = findIndexInListHelp 0 --- > findIndexInListHelp _ _ [] = Nothing --- > findIndexInListHelp count f (h:t) --- > = if (f h) --- > then Just count --- > else findIndexInListHelp (count+1) f t --- --- numTree applies numberTree with an initial state: --- --- > numTree :: (Eq a) => Tree a -> Tree Int --- > numTree t = evalState (numberTree t) [] --- --- > testTree = Node "Zero" (Node "One" (Node "Two" Nil Nil) (Node "One" (Node "Zero" Nil Nil) Nil)) Nil --- > numTree testTree => Node 0 (Node 1 (Node 2 Nil Nil) (Node 1 (Node 0 Nil Nil) Nil)) Nil --- --- sumTree is a little helper function that does not use the State monad: --- --- > sumTree :: (Num a) => Tree a -> a --- > sumTree Nil = 0 --- > sumTree (Node e t1 t2) = e + (sumTree t1) + (sumTree t2) diff --git a/Control/Monad/Trans.hs b/Control/Monad/Trans.hs deleted file mode 100644 index 8ef979d..0000000 --- a/Control/Monad/Trans.hs +++ /dev/null @@ -1,44 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Trans --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : portable --- --- The MonadTrans class. --- --- Inspired by the paper --- /Functional Programming with Overloading and --- Higher-Order Polymorphism/, --- Mark P Jones () --- Advanced School of Functional Programming, 1995. ------------------------------------------------------------------------------ - -module Control.Monad.Trans ( - MonadTrans(..), - MonadIO(..), - ) where - -import Prelude - -import System.IO - --- --------------------------------------------------------------------------- --- MonadTrans class --- --- Monad to facilitate stackable Monads. --- Provides a way of digging into an outer --- monad, giving access to (lifting) the inner monad. - -class MonadTrans t where - lift :: Monad m => m a -> t m a - -class (Monad m) => MonadIO m where - liftIO :: IO a -> m a - -instance MonadIO IO where - liftIO = id diff --git a/Control/Monad/Writer.hs b/Control/Monad/Writer.hs deleted file mode 100644 index de66eb4..0000000 --- a/Control/Monad/Writer.hs +++ /dev/null @@ -1,165 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Writer --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : non-portable (multi-param classes, functional dependencies) --- --- The MonadWriter class. --- --- Inspired by the paper --- /Functional Programming with Overloading and --- Higher-Order Polymorphism/, --- Mark P Jones () --- Advanced School of Functional Programming, 1995. ------------------------------------------------------------------------------ - -module Control.Monad.Writer ( - MonadWriter(..), - listens, - censor, - Writer(..), - execWriter, - mapWriter, - WriterT(..), - execWriterT, - mapWriterT, - module Control.Monad, - module Control.Monad.Fix, - module Control.Monad.Trans, - module Data.Monoid, - ) where - -import Prelude - -import Control.Monad -import Control.Monad.Fix -import Control.Monad.Trans -import Control.Monad.Reader -import Data.Monoid - --- --------------------------------------------------------------------------- --- MonadWriter class --- --- tell is like tell on the MUD's it shouts to monad --- what you want to be heard. The monad carries this 'packet' --- upwards, merging it if needed (hence the Monoid requirement)} --- --- listen listens to a monad acting, and returns what the monad "said". --- --- pass lets you provide a writer transformer which changes internals of --- the written object. - -class (Monoid w, Monad m) => MonadWriter w m | m -> w where - tell :: w -> m () - listen :: m a -> m (a, w) - pass :: m (a, w -> w) -> m a - -listens :: (MonadWriter w m) => (w -> b) -> m a -> m (a, b) -listens f m = do - (a, w) <- listen m - return (a, f w) - -censor :: (MonadWriter w m) => (w -> w) -> m a -> m a -censor f m = pass $ do - a <- m - return (a, f) - --- --------------------------------------------------------------------------- --- Our parameterizable writer monad - -newtype Writer w a = Writer { runWriter :: (a, w) } - - -instance Functor (Writer w) where - fmap f m = Writer $ let (a, w) = runWriter m in (f a, w) - -instance (Monoid w) => Monad (Writer w) where - return a = Writer (a, mempty) - m >>= k = Writer $ let - (a, w) = runWriter m - (b, w') = runWriter (k a) - in (b, w `mappend` w') - -instance (Monoid w) => MonadFix (Writer w) where - mfix m = Writer $ let (a, w) = runWriter (m a) in (a, w) - -instance (Monoid w) => MonadWriter w (Writer w) where - tell w = Writer ((), w) - listen m = Writer $ let (a, w) = runWriter m in ((a, w), w) - pass m = Writer $ let ((a, f), w) = runWriter m in (a, f w) - - -execWriter :: Writer w a -> w -execWriter m = snd (runWriter m) - -mapWriter :: ((a, w) -> (b, w')) -> Writer w a -> Writer w' b -mapWriter f m = Writer $ f (runWriter m) - --- --------------------------------------------------------------------------- --- Our parameterizable writer monad, with an inner monad - -newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } - - -instance (Monad m) => Functor (WriterT w m) where - fmap f m = WriterT $ do - (a, w) <- runWriterT m - return (f a, w) - -instance (Monoid w, Monad m) => Monad (WriterT w m) where - return a = WriterT $ return (a, mempty) - m >>= k = WriterT $ do - (a, w) <- runWriterT m - (b, w') <- runWriterT (k a) - return (b, w `mappend` w') - fail msg = WriterT $ fail msg - -instance (Monoid w, MonadPlus m) => MonadPlus (WriterT w m) where - mzero = WriterT mzero - m `mplus` n = WriterT $ runWriterT m `mplus` runWriterT n - -instance (Monoid w, MonadFix m) => MonadFix (WriterT w m) where - mfix m = WriterT $ mfix $ \ ~(a, _) -> runWriterT (m a) - -instance (Monoid w, Monad m) => MonadWriter w (WriterT w m) where - tell w = WriterT $ return ((), w) - listen m = WriterT $ do - (a, w) <- runWriterT m - return ((a, w), w) - pass m = WriterT $ do - ((a, f), w) <- runWriterT m - return (a, f w) - -instance (Monoid w) => MonadTrans (WriterT w) where - lift m = WriterT $ do - a <- m - return (a, mempty) - -instance (Monoid w, MonadIO m) => MonadIO (WriterT w m) where - liftIO = lift . liftIO - -instance (Monoid w, MonadReader r m) => MonadReader r (WriterT w m) where - ask = lift ask - local f m = WriterT $ local f (runWriterT m) - - -execWriterT :: Monad m => WriterT w m a -> m w -execWriterT m = do - (_, w) <- runWriterT m - return w - -mapWriterT :: (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b -mapWriterT f m = WriterT $ f (runWriterT m) - --- --------------------------------------------------------------------------- --- MonadWriter instances for other monad transformers - -instance (MonadWriter w m) => MonadWriter w (ReaderT r m) where - tell = lift . tell - listen m = ReaderT $ \w -> listen (runReaderT m w) - pass m = ReaderT $ \w -> pass (runReaderT m w) diff --git a/Makefile.nhc98 b/Makefile.nhc98 index 508655c..bacf69c 100644 --- a/Makefile.nhc98 +++ b/Makefile.nhc98 @@ -9,7 +9,7 @@ SRCS = \ Data/Ratio.hs Data/Set.hs Data/Tuple.hs Data/Word.hs Data/Array.hs \ Data/HashTable.hs Data/Typeable.hs Data/Dynamic.hs \ Data/Monoid.hs Data/Queue.hs Data/Tree.hs \ - Control/Monad.hs Control/Monad/Fix.hs Control/Monad/Trans.hs \ + Control/Monad.hs Control/Monad/Fix.hs \ Control/Arrow.hs Debug/Trace.hs \ NHC/SizedTypes.hs \ System/IO.hs System/IO/Error.hs System/IO/Unsafe.hs \ @@ -27,7 +27,6 @@ SRCS = \ Text/Read.hs Text/Show.hs Text/Show/Functions.hs # [Data/Dynamic.hs] Data/Generics.hs Data/STRef.hs Data/Unique.hs -# Control/Monad/Identity.hs # Debug/QuickCheck.hs # System/CPUTime.hsc System/Time.hsc # System/Mem.hs System/Mem/StableName.hs System/Mem/Weak.hs @@ -59,8 +58,6 @@ $(OBJDIR)/System/Random.$O: $(OBJDIR)/Data/Char.$O $(OBJDIR)/Data/IORef.$O \ $(OBJDIR)/System/IO/Unsafe.$O $(OBJDIR)/Foreign/Ptr.$O $(OBJDIR)/Debug/Trace.$O: $(OBJDIR)/System/IO.$O $(OBJDIR)/System/IO/Unsafe.$O $(OBJDIR)/Control/Monad/Fix.$O: $(OBJDIR)/System/IO.$O -$(OBJDIR)/Control/Monad/Identity.$O: $(OBJDIR)/Control/Monad.$O \ - $(OBJDIR)/Control/Monad/Fix.$O $(OBJDIR)/Foreign/Marshal/Alloc.$O: $(OBJDIR)/Data/Maybe.$O \ $(OBJDIR)/Foreign/Ptr.$O $(OBJDIR)/Foreign/Storable.$O \ $(OBJDIR)/Foreign/C/Types.$O @@ -87,8 +84,6 @@ System/IO.$C: System/IO/Error.$C System/Random.$C: Data/Char.$C Data/IORef.$C System/IO/Unsafe.$C Debug/Trace.$C: System/IO.$C System/IO/Unsafe.$C Control/Monad/Fix.$C: System/IO.$C -Control/Monad/Identity.$C: Control/Monad.$C Control/Monad/Fix.$C -Control/Monad/Trans.$C: System/IO.$C Foreign/Marshal/Alloc.$C: Data/Maybe.$C Foreign/Ptr.$C Foreign/Storable.$C \ Foreign/C/Types.$C Foreign/Marshal/Array.$C: Control/Monad.$C Foreign/Ptr.$C Foreign/Storable.$C \ -- 1.7.10.4