mtl (empty) → 1.0
raw patch · 12 files changed
+1393/−0 lines, 12 filesdep +basebuild-type:Customsetup-changed
Dependencies added: base
Files
- Control/Monad/Cont.hs +123/−0
- Control/Monad/Error.hs +221/−0
- Control/Monad/Identity.hs +60/−0
- Control/Monad/List.hs +87/−0
- Control/Monad/RWS.hs +161/−0
- Control/Monad/Reader.hs +129/−0
- Control/Monad/State.hs +338/−0
- Control/Monad/Trans.hs +44/−0
- Control/Monad/Writer.hs +172/−0
- LICENSE +31/−0
- Setup.hs +2/−0
- mtl.cabal +25/−0
+ Control/Monad/Cont.hs view
@@ -0,0 +1,123 @@+{-# OPTIONS -fallow-undecidable-instances #-}+-- Search for -fallow-undecidable-instances to see why this is needed++-----------------------------------------------------------------------------+-- |+-- 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++-- Needs -fallow-undecidable-instances+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))++-- Needs -fallow-undecidable-instances+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
+ Control/Monad/Error.hs view
@@ -0,0 +1,221 @@+{-# OPTIONS -fallow-undecidable-instances #-}+-- Needed for the same reasons as in Reader, State etc++-----------------------------------------------------------------------------+-- |+-- Module : Control.Monad.Error+-- Copyright : (c) Michael Weber <michael.weber@post.rwth-aachen.de>, 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 <mailto:michael.weber@post.rwth-aachen.de>,+-- inspired by the Haskell Monad Template Library from+-- Andy Gill (<http://www.cse.ogi.edu/~andy/>)+--+-----------------------------------------------------------------------------++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 Control.Monad.Instances ()+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 (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
+ Control/Monad/Identity.hs view
@@ -0,0 +1,60 @@+-----------------------------------------------------------------------------+-- |+-- 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 (<http://www.cse.ogi.edu/~mpj/>)+-- 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))
+ Control/Monad/List.hs view
@@ -0,0 +1,87 @@+{-# OPTIONS -fallow-undecidable-instances #-}+-- Needed for the same reasons as in Reader, State etc++-----------------------------------------------------------------------------+-- |+-- 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)
+ Control/Monad/RWS.hs view
@@ -0,0 +1,161 @@+-----------------------------------------------------------------------------+-- |+-- 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 (<http://www.cse.ogi.edu/~mpj/>)+-- 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)
+ Control/Monad/Reader.hs view
@@ -0,0 +1,129 @@+-----------------------------------------------------------------------------+-- |+-- 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 (<http://www.cse.ogi.edu/~mpj/>)+-- 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+import Control.Monad.Instances ()++-- ----------------------------------------------------------------------------+-- 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 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
+ Control/Monad/State.hs view
@@ -0,0 +1,338 @@+{-# OPTIONS -fallow-undecidable-instances #-}+-- Search for -fallow-undecidable-instances to see why this is needed++-----------------------------------------------------------------------------+-- |+-- 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 (<http://www.cse.ogi.edu/~mpj/>)+-- 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++-- Needs -fallow-undecidable-instances+instance (MonadReader r m) => MonadReader r (StateT s m) where+ ask = lift ask+ local f m = StateT $ \s -> local f (runStateT m s)++-- Needs -fallow-undecidable-instances+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++-- Needs -fallow-undecidable-instances+instance (MonadState s m) => MonadState s (ReaderT r m) where+ get = lift get+ put = lift . put++-- Needs -fallow-undecidable-instances+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 (<http://www.math.chalmers.se/~rjmh/>), 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 (<http://www.cs.kent.ac.uk/people/staff/sjt/>),+-- 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)
+ Control/Monad/Trans.hs view
@@ -0,0 +1,44 @@+-----------------------------------------------------------------------------+-- |+-- 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 (<http://www.cse.ogi.edu/~mpj/>)+-- 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
+ Control/Monad/Writer.hs view
@@ -0,0 +1,172 @@+{-# OPTIONS -fallow-undecidable-instances #-}+-- Search for -fallow-undecidable-instances to see why this is needed++-----------------------------------------------------------------------------+-- |+-- 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 (<http://www.cse.ogi.edu/~mpj/>)+-- 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++-- This instance needs -fallow-undecidable-instances, because +-- it does not satisfy the coverage condition+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++-- This instance needs -fallow-undecidable-instances, because +-- it does not satisfy the coverage condition+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)
+ LICENSE view
@@ -0,0 +1,31 @@+The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow. +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ mtl.cabal view
@@ -0,0 +1,25 @@+name: mtl+version: 1.0+license: BSD3+license-file: LICENSE+author: Andy Gill+maintainer: libraries@haskell.org+category: Control+synopsis: Monad transformer library+description:+ A monad transformer library, inspired by the paper "Functional+ Programming with Overloading and Higher-Order Polymorphism",+ by Mark P Jones (<http://www.cse.ogi.edu/~mpj/>), Advanced School+ of Functional Programming, 1995.+exposed-modules:+ Control.Monad.Error,+ Control.Monad.Cont,+ Control.Monad.Identity,+ Control.Monad.List,+ Control.Monad.RWS,+ Control.Monad.Reader,+ Control.Monad.State,+ Control.Monad.Trans,+ Control.Monad.Writer+build-depends: base+extensions: MultiParamTypeClasses, FunctionalDependencies