From 618e77f3efb1f30d4c65cc06008554cc67dcd045 Mon Sep 17 00:00:00 2001 From: Ian Lynagh <igloo@earth.li> Date: Sat, 3 Mar 2007 15:22:21 +0000 Subject: [PATCH] Rejig mtl; trac proposal #1127 Moved the MonadFoo classes to Control.Monad.Foo.Class. Put the instances consistently in the module which defines the type they give an instance for. Made the existing transformers lazy to match the existing monads, and put them in Control.Monad.Foo.Lazy. Also added Control.Monad.Foo.Strict with strict monads and transformers. Control.Monad.Foo still exports what it used to. Created a MonadRWS class. Made the MonadWriter w (ErrorT e m) instance strict to match everything else. --- Control/Monad/Cont.hs | 109 +++++------ Control/Monad/Cont/Class.hs | 24 +++ Control/Monad/Error.hs | 251 ++++++++++--------------- Control/Monad/Error/Class.hs | 93 ++++++++++ Control/Monad/Identity.hs | 28 +-- Control/Monad/List.hs | 92 +++++----- Control/Monad/RWS.hs | 166 +---------------- Control/Monad/RWS/Class.hs | 35 ++++ Control/Monad/RWS/Lazy.hs | 179 ++++++++++++++++++ Control/Monad/RWS/Strict.hs | 175 ++++++++++++++++++ Control/Monad/Reader.hs | 161 ++++++++-------- Control/Monad/Reader/Class.hs | 42 +++++ Control/Monad/State.hs | 327 +-------------------------------- Control/Monad/State/Class.hs | 62 +++++++ Control/Monad/State/Lazy.hs | 300 ++++++++++++++++++++++++++++++ Control/Monad/State/Strict.hs | 299 ++++++++++++++++++++++++++++++ Control/Monad/Trans.hs | 24 +-- Control/Monad/Writer.hs | 159 +--------------- Control/Monad/Writer/Class.hs | 58 ++++++ Control/Monad/Writer/Lazy.hs | 150 +++++++++++++++ Control/Monad/Writer/Strict.hs | 152 +++++++++++++++ LICENSE | 8 +- Makefile | 12 +- mtl.cabal | 58 +++--- package.conf.in | 55 +++--- prologue.txt | 2 +- 26 files changed, 1979 insertions(+), 1042 deletions(-) create mode 100644 Control/Monad/Cont/Class.hs create mode 100644 Control/Monad/Error/Class.hs create mode 100644 Control/Monad/RWS/Class.hs create mode 100644 Control/Monad/RWS/Lazy.hs create mode 100644 Control/Monad/RWS/Strict.hs create mode 100644 Control/Monad/Reader/Class.hs create mode 100644 Control/Monad/State/Class.hs create mode 100644 Control/Monad/State/Lazy.hs create mode 100644 Control/Monad/State/Strict.hs create mode 100644 Control/Monad/Writer/Class.hs create mode 100644 Control/Monad/Writer/Lazy.hs create mode 100644 Control/Monad/Writer/Strict.hs diff --git a/Control/Monad/Cont.hs b/Control/Monad/Cont.hs index b8d907d..8bad751 100644 --- a/Control/Monad/Cont.hs +++ b/Control/Monad/Cont.hs @@ -6,7 +6,7 @@ -- 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) @@ -16,103 +16,84 @@ ----------------------------------------------------------------------------- module Control.Monad.Cont ( - MonadCont(..), - Cont(..), - mapCont, - withCont, - ContT(..), - mapContT, - withContT, - module Control.Monad, - module Control.Monad.Trans + module Control.Monad.Cont.Class, + Cont(..), + mapCont, + withCont, + ContT(..), + mapContT, + withContT, + module Control.Monad, + module Control.Monad.Trans, ) where import Control.Monad +import Control.Monad.Cont.Class +import Control.Monad.RWS.Class +import Control.Monad.Reader.Class +import Control.Monad.State.Class import Control.Monad.Trans -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 +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 + -- --------------------------------------------------------------------------- -- Our parameterizable continuation monad, with an inner monad newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r } +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 + instance (Monad m) => Functor (ContT r m) where - fmap f m = ContT $ \c -> runContT m (c . f) + 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) + 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 + callCC f = ContT $ \c -> runContT (f (\a -> ContT $ \_ -> c a)) c + +-- --------------------------------------------------------------------------- +-- Instances for other mtl transformers instance MonadTrans (ContT r) where - lift m = ContT (m >>=) + lift m = ContT (m >>=) instance (MonadIO m) => MonadIO (ContT r m) where - liftIO = lift . liftIO + 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)) + 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 + get = lift get + put = lift . put -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/Cont/Class.hs b/Control/Monad/Cont/Class.hs new file mode 100644 index 0000000..b8787d5 --- /dev/null +++ b/Control/Monad/Cont/Class.hs @@ -0,0 +1,24 @@ +{-# OPTIONS -fallow-undecidable-instances #-} +-- Search for -fallow-undecidable-instances to see why this is needed + +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.Cont.Class +-- 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 monad class +-- +----------------------------------------------------------------------------- + +module Control.Monad.Cont.Class ( + MonadCont(..), + ) where + +class (Monad m) => MonadCont m where + callCC :: ((a -> m b) -> m a) -> m a + diff --git a/Control/Monad/Error.hs b/Control/Monad/Error.hs index 58d3c0b..703e4f4 100644 --- a/Control/Monad/Error.hs +++ b/Control/Monad/Error.hs @@ -35,13 +35,12 @@ The Error monad (also called the Exception monad). 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 + module Control.Monad.Error.Class, + ErrorT(..), + mapErrorT, + module Control.Monad, + module Control.Monad.Fix, + module Control.Monad.Trans, -- * Example 1: Custom Error Data Type -- $customErrorExample @@ -50,99 +49,51 @@ module Control.Monad.Error ( ) where import Control.Monad +import Control.Monad.Cont.Class +import Control.Monad.Error.Class import Control.Monad.Fix +import Control.Monad.RWS.Class +import Control.Monad.Reader.Class +import Control.Monad.State.Class import Control.Monad.Trans -import Control.Monad.RWS -import Control.Monad.Cont +import Control.Monad.Writer.Class import Control.Monad.Instances () import System.IO --- | An exception to be thrown. --- An instance must redefine at least one of 'noMsg', 'strMsg'. -class Error a where - -- | Creates an exception without a message. - -- Default implementation is @'strMsg' \"\"@. - noMsg :: a - -- | Creates an exception with a message. - -- Default implementation is 'noMsg'. - strMsg :: String -> a - - noMsg = strMsg "" - strMsg _ = noMsg - --- | A string can be thrown as an error. -instance Error String where - noMsg = "" - strMsg = id - -instance Error IOError where - strMsg = userError - -{- | -The strategy of combining computations that can throw exceptions -by bypassing bound functions -from the point an exception is thrown to the point that it is handled. - -Is parameterized over the type of error information and -the monad type constructor. -It is common to use @'Data.Either' String@ as the monad type constructor -for an error monad in which error descriptions take the form of strings. -In that case and many other common cases the resulting monad is already defined -as an instance of the 'MonadError' class. -You can also define your own error type and\/or use a monad type constructor -other than @'Data.Either' String@ or @'Data.Either' IOError@. -In these cases you will have to explicitly define instances of the 'Error' -and\/or 'MonadError' classes. --} -class (Monad m) => MonadError e m | m -> e where - -- | Is used within a monadic computation to begin exception processing. - throwError :: e -> m a - - {- | - A handler function to handle previous errors and return to normal execution. - A common idiom is: - - > do { action1; action2; action3 } `catchError` handler - - where the @action@ functions can call 'throwError'. - Note that @handler@ and the do-block must have the same return type. - -} - catchError :: m a -> (e -> m a) -> m a - instance MonadPlus IO where - mzero = ioError (userError "mzero") - m `mplus` n = m `catch` \_ -> n + mzero = ioError (userError "mzero") + m `mplus` n = m `catch` \_ -> n instance MonadError IOError IO where - throwError = ioError - catchError = catch + 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) + 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 + 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 + 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 + throwError = Left + Left l `catchError` h = h l + Right r `catchError` _ = Right r {- | The error monad transformer. It can be used to add error handling to other @@ -168,102 +119,86 @@ Here are some examples of use: newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e 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) + 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)) + 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)) + 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) + 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" + 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) + 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) + +-- --------------------------------------------------------------------------- +-- Instances for other mtl transformers instance (Error e) => MonadTrans (ErrorT e) where - lift m = ErrorT $ do - a <- m - return (Right a) + 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) + liftIO = lift . liftIO -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, MonadCont m) => MonadCont (ErrorT e m) where + callCC f = ErrorT $ + callCC $ \c -> + runErrorT (f (\a -> ErrorT $ c (Right a))) -instance (Error e, MonadState s m) => MonadState s (ErrorT e m) where - get = lift get - put = lift . put +instance (Error e, MonadRWS r w s m) => MonadRWS r w s (ErrorT e m) -instance (Error e, MonadCont m) => MonadCont (ErrorT e m) where - callCC f = ErrorT $ - callCC $ \c -> - runErrorT (f (\a -> ErrorT $ c (Right a))) +instance (Error e, MonadReader r m) => MonadReader r (ErrorT e m) where + ask = lift ask + local f m = ErrorT $ local f (runErrorT m) -mapErrorT :: (m (Either e a) -> n (Either e' b)) -> ErrorT e m a -> ErrorT e' n b -mapErrorT f m = ErrorT $ f (runErrorT m) +instance (Error e, MonadState s m) => MonadState s (ErrorT e m) where + get = lift get + put = lift . put --- --------------------------------------------------------------------------- --- 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 +instance (Error e, MonadWriter w m) => MonadWriter w (ErrorT e m) where + tell = lift . tell + listen m = ErrorT $ do + (a, w) <- listen (runErrorT m) + case a of + Left l -> return $ Left l + Right r -> return $ Right (r, w) + pass m = ErrorT $ pass $ do + a <- runErrorT m + case a of + Left l -> return (Left l, id) + Right (r, f) -> return (Right r, f) {- $customErrorExample Here is an example that demonstrates the use of a custom 'Error' data type with diff --git a/Control/Monad/Error/Class.hs b/Control/Monad/Error/Class.hs new file mode 100644 index 0000000..dcd71d2 --- /dev/null +++ b/Control/Monad/Error/Class.hs @@ -0,0 +1,93 @@ +{-# OPTIONS -fallow-undecidable-instances #-} +-- Needed for the same reasons as in Reader, State etc + +{- | +Module : Control.Monad.Error.Class +Copyright : (c) Michael Weber <michael.weber@post.rwth-aachen.de> 2001, + (c) Jeff Newbern 2003-2006, + (c) Andriy Palamarchuk 2006 +License : BSD-style (see the file libraries/base/LICENSE) + +Maintainer : libraries@haskell.org +Stability : experimental +Portability : non-portable (multi-parameter type classes) + +[Computation type:] Computations which may fail or throw exceptions. + +[Binding strategy:] Failure records information about the cause\/location +of the failure. Failure values bypass the bound function, +other values are used as inputs to the bound function. + +[Useful for:] Building computations from sequences of functions that may fail +or using exception handling to structure error handling. + +[Zero and plus:] Zero is represented by an empty error and the plus operation +executes its second argument if the first fails. + +[Example type:] @'Data.Either' String a@ + +The Error monad (also called the Exception 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.Class ( + Error(..), + MonadError(..), + ) where + +-- | An exception to be thrown. +-- An instance must redefine at least one of 'noMsg', 'strMsg'. +class Error a where + -- | Creates an exception without a message. + -- Default implementation is @'strMsg' \"\"@. + noMsg :: a + -- | Creates an exception with a message. + -- Default implementation is 'noMsg'. + strMsg :: String -> a + + noMsg = strMsg "" + strMsg _ = noMsg + +-- | A string can be thrown as an error. +instance Error String where + noMsg = "" + strMsg = id + +instance Error IOError where + strMsg = userError + +{- | +The strategy of combining computations that can throw exceptions +by bypassing bound functions +from the point an exception is thrown to the point that it is handled. + +Is parameterized over the type of error information and +the monad type constructor. +It is common to use @'Data.Either' String@ as the monad type constructor +for an error monad in which error descriptions take the form of strings. +In that case and many other common cases the resulting monad is already defined +as an instance of the 'MonadError' class. +You can also define your own error type and\/or use a monad type constructor +other than @'Data.Either' String@ or @'Data.Either' IOError@. +In these cases you will have to explicitly define instances of the 'Error' +and\/or 'MonadError' classes. +-} +class (Monad m) => MonadError e m | m -> e where + -- | Is used within a monadic computation to begin exception processing. + throwError :: e -> m a + + {- | + A handler function to handle previous errors and return to normal execution. + A common idiom is: + + > do { action1; action2; action3 } `catchError` handler + + where the @action@ functions can call 'throwError'. + Note that @handler@ and the do-block must have the same return type. + -} + catchError :: m a -> (e -> m a) -> m a + diff --git a/Control/Monad/Identity.hs b/Control/Monad/Identity.hs index e2614a9..de0a8d8 100644 --- a/Control/Monad/Identity.hs +++ b/Control/Monad/Identity.hs @@ -1,9 +1,9 @@ {- | Module : Control.Monad.Identity Copyright : (c) Andy Gill 2001, - (c) Oregon Graduate Institute of Science and Technology 2001, - (c) Jeff Newbern 2003-2006, - (c) Andriy Palamarchuk 2006 + (c) Oregon Graduate Institute of Science and Technology 2001, + (c) Jeff Newbern 2003-2006, + (c) Andriy Palamarchuk 2006 License : BSD-style (see the file libraries/base/LICENSE) Maintainer : libraries@haskell.org @@ -33,16 +33,16 @@ version of that monad. Inspired by the paper /Functional Programming with Overloading and - Higher-Order Polymorphism/, + Higher-Order Polymorphism/, Mark P Jones (<http://www.cse.ogi.edu/~mpj/>) - Advanced School of Functional Programming, 1995. + Advanced School of Functional Programming, 1995. -} module Control.Monad.Identity ( - Identity(..), + Identity(..), - module Control.Monad, - module Control.Monad.Fix + module Control.Monad, + module Control.Monad.Fix, ) where import Control.Monad @@ -51,10 +51,10 @@ import Control.Monad.Fix {- | Identity wrapper. Abstraction for wrapping up a object. If you have an monadic function, say: - + > example :: Int -> Identity Int > example x = return (x*x) - + you can \"run\" it, using > Main> runIdentity (example 42) @@ -85,11 +85,11 @@ newtype Identity a = Identity { runIdentity :: a } -- Identity instances for Functor and Monad instance Functor Identity where - fmap f m = Identity (f (runIdentity m)) + fmap f m = Identity (f (runIdentity m)) instance Monad Identity where - return a = Identity a - m >>= k = k (runIdentity m) + return a = Identity a + m >>= k = k (runIdentity m) instance MonadFix Identity where - mfix f = Identity (fix (runIdentity . f)) + mfix f = Identity (fix (runIdentity . f)) diff --git a/Control/Monad/List.hs b/Control/Monad/List.hs index 7d04b74..ac7c8cb 100644 --- a/Control/Monad/List.hs +++ b/Control/Monad/List.hs @@ -5,9 +5,9 @@ -- | -- Module : Control.Monad.List -- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 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) @@ -17,69 +17,73 @@ ----------------------------------------------------------------------------- module Control.Monad.List ( - ListT(..), - mapListT, - module Control.Monad, - module Control.Monad.Trans + ListT(..), + mapListT, + module Control.Monad, + module Control.Monad.Trans, ) where import Control.Monad +import Control.Monad.Cont.Class +import Control.Monad.Error.Class +import Control.Monad.Reader.Class +import Control.Monad.State.Class 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] } +mapListT :: (m [a] -> n [b]) -> ListT m a -> ListT n b +mapListT f m = ListT $ f (runListT m) + instance (Monad m) => Functor (ListT m) where - fmap f m = ListT $ do - a <- runListT m - return (map f a) + 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 [] + 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) + mzero = ListT $ return [] + m `mplus` n = ListT $ do + a <- runListT m + b <- runListT n + return (a ++ b) + +-- --------------------------------------------------------------------------- +-- Instances for other mtl transformers instance MonadTrans ListT where - lift m = ListT $ do - a <- m - return [a] + 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 + liftIO = lift . liftIO instance (MonadCont m) => MonadCont (ListT m) where - callCC f = ListT $ - callCC $ \c -> - runListT (f (\a -> ListT $ c [a])) + 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) + throwError = lift . throwError + m `catchError` h = ListT $ runListT m + `catchError` \e -> runListT (h e) + +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 -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 index 2159cbc..8c1966a 100644 --- a/Control/Monad/RWS.hs +++ b/Control/Monad/RWS.hs @@ -2,173 +2,25 @@ -- | -- Module : Control.Monad.RWS -- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 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. +-- 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, - module Control.Monad.Fix, - module Control.Monad.Trans, - module Data.Monoid, - module Control.Monad.Reader, - module Control.Monad.Writer, - module Control.Monad.State + module Control.Monad.RWS.Lazy ) where -import Control.Monad -import Control.Monad.Fix -import Control.Monad.Trans -import Data.Monoid - --- To avoid warnings, only import what is unique to the module in question. -import Control.Monad.Reader ( - MonadReader(..), asks, - Reader(..), mapReader, withReader, - ReaderT(..), mapReaderT, withReaderT ) -import Control.Monad.Writer ( - MonadWriter(..), listens, censor, - Writer(..), execWriter, mapWriter, - WriterT(..), execWriterT, mapWriterT ) -import Control.Monad.State ( - MonadState(..), modify, gets, - State(..), evalState, execState, mapState, withState, - StateT(..), evalStateT, execStateT, mapStateT, withStateT ) - -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) +import Control.Monad.RWS.Lazy -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/RWS/Class.hs b/Control/Monad/RWS/Class.hs new file mode 100644 index 0000000..2020c76 --- /dev/null +++ b/Control/Monad/RWS/Class.hs @@ -0,0 +1,35 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.RWS.Class +-- 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.Class ( + MonadRWS, + module Control.Monad.Reader.Class, + module Control.Monad.State.Class, + module Control.Monad.Writer.Class, + ) where + +import Control.Monad.Reader.Class +import Control.Monad.State.Class +import Control.Monad.Writer.Class +import Data.Monoid + +class (Monoid w, MonadReader r m, MonadWriter w m, MonadState s m) + => MonadRWS r w s m | m -> r, m -> w, m -> s + diff --git a/Control/Monad/RWS/Lazy.hs b/Control/Monad/RWS/Lazy.hs new file mode 100644 index 0000000..a83b88d --- /dev/null +++ b/Control/Monad/RWS/Lazy.hs @@ -0,0 +1,179 @@ +{-# OPTIONS -fallow-undecidable-instances #-} +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.RWS.Lazy +-- 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) +-- +-- Lazy RWS 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.RWS.Lazy ( + RWS(..), + evalRWS, + execRWS, + mapRWS, + withRWS, + RWST(..), + evalRWST, + execRWST, + mapRWST, + withRWST, + module Control.Monad.RWS.Class, + ) where + +import Control.Monad +import Control.Monad.Cont.Class +import Control.Monad.Error.Class +import Control.Monad.Fix +import Control.Monad.RWS.Class +import Control.Monad.Reader.Class +import Control.Monad.State.Class +import Control.Monad.Trans +import Control.Monad.Writer.Class +import Data.Monoid + +newtype RWS r w s a = RWS { runRWS :: r -> s -> (a, s, w) } + +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) + +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) + +instance (Monoid w) => MonadRWS r w s (RWS r w s) + +-- --------------------------------------------------------------------------- +-- Our parameterizable RWS monad, with an inner monad + +newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) } + +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) + +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, Monad m) => MonadRWS r w s (RWST r w s m) + +-- --------------------------------------------------------------------------- +-- Instances for other mtl transformers + +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 + +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 + +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/RWS/Strict.hs b/Control/Monad/RWS/Strict.hs new file mode 100644 index 0000000..e62a1d7 --- /dev/null +++ b/Control/Monad/RWS/Strict.hs @@ -0,0 +1,175 @@ +{-# OPTIONS -fallow-undecidable-instances #-} +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.RWS.Strict +-- 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) +-- +-- Strict RWS 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.RWS.Strict ( + RWS(..), + evalRWS, + execRWS, + mapRWS, + withRWS, + RWST(..), + evalRWST, + execRWST, + mapRWST, + withRWST, + module Control.Monad.RWS.Class, + ) where + +import Control.Monad +import Control.Monad.Cont.Class +import Control.Monad.Error.Class +import Control.Monad.Fix +import Control.Monad.RWS.Class +import Control.Monad.Reader.Class +import Control.Monad.State.Class +import Control.Monad.Trans +import Control.Monad.Writer.Class +import Data.Monoid + +newtype RWS r w s a = RWS { runRWS :: r -> s -> (a, s, w) } + +evalRWS :: RWS r w s a -> r -> s -> (a, w) +evalRWS m r s = case runRWS m r s of + (a, _, w) -> (a, w) + +execRWS :: RWS r w s a -> r -> s -> (s, w) +execRWS m r s = case runRWS m r s of + (_, s', w) -> (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) + +instance Functor (RWS r w s) where + fmap f m = RWS $ \r s -> case runRWS m r s of + (a, s', w) -> (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 -> case runRWS m r s of + (a, s', w) -> + case runRWS (k a) r s' of + (b, s'', w') -> + (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 -> case runRWS m r s of + (a, s', w) -> ((a, w), s', w) + pass m = RWS $ \r s -> case runRWS m r s of + ((a, f), s', w) -> (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) + +instance (Monoid w) => MonadRWS r w s (RWS r w s) + +-- --------------------------------------------------------------------------- +-- Our parameterizable RWS monad, with an inner monad + +newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) } + +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) + +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, Monad m) => MonadRWS r w s (RWST r w s m) + +-- --------------------------------------------------------------------------- +-- Instances for other mtl transformers + +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 + +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 + +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/Reader.hs b/Control/Monad/Reader.hs index 4e17cb7..3959170 100644 --- a/Control/Monad/Reader.hs +++ b/Control/Monad/Reader.hs @@ -1,83 +1,60 @@ +{-# OPTIONS -fallow-undecidable-instances #-} +-- Search for -fallow-undecidable-instances to see why this is needed ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Reader -- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 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 +-- Declaration of the MonadReader 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. +-- 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 + module Control.Monad.Reader.Class, + Reader(..), + mapReader, + withReader, + ReaderT(..), + mapReaderT, + withReaderT, + module Control.Monad, + module Control.Monad.Fix, + module Control.Monad.Trans, + ) where import Control.Monad +import Control.Monad.Cont.Class +import Control.Monad.Error.Class 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) +import Control.Monad.Reader.Class +import Control.Monad.State.Class +import Control.Monad.Trans +import Control.Monad.Writer.Class -- ---------------------------------------------------------------------------- -- The partially applied function type is a simple reader monad instance MonadReader r ((->) r) where - ask = id - local f m = m . f + 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 @@ -86,42 +63,82 @@ mapReader f m = Reader $ f . runReader m withReader :: (r' -> r) -> Reader r a -> Reader r' a withReader f m = Reader $ runReader m . f +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 + -- --------------------------------------------------------------------------- -- Our parameterizable reader monad, with an inner monad newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a } +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 + instance (Monad m) => Functor (ReaderT r m) where - fmap f m = ReaderT $ \r -> do - a <- runReaderT m r - return (f a) + 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 + 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 + 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 + 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) + ask = ReaderT return + local f m = ReaderT $ \r -> runReaderT m (f r) + +-- --------------------------------------------------------------------------- +-- Instances for other mtl transformers instance MonadTrans (ReaderT r) where - lift m = ReaderT $ \_ -> m + lift m = ReaderT $ \_ -> m instance (MonadIO m) => MonadIO (ReaderT r m) where - liftIO = lift . liftIO + liftIO = lift . liftIO + +instance (MonadCont m) => MonadCont (ReaderT r m) where + callCC f = ReaderT $ \r -> + callCC $ \c -> + runReaderT (f (\a -> ReaderT $ \_ -> c a)) r + +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 + +-- Needs -fallow-undecidable-instances +instance (MonadState s m) => MonadState s (ReaderT r m) where + get = lift get + put = lift . put + +-- 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) -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/Reader/Class.hs b/Control/Monad/Reader/Class.hs new file mode 100644 index 0000000..6c9e99e --- /dev/null +++ b/Control/Monad/Reader/Class.hs @@ -0,0 +1,42 @@ +{-# OPTIONS -fallow-undecidable-instances #-} +-- Search for -fallow-undecidable-instances to see why this is needed +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.Reader.Class +-- 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) +-- +-- MonadReader 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.Reader.Class ( + MonadReader(..), + asks, + ) where + +-- ---------------------------------------------------------------------------- +-- 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) + diff --git a/Control/Monad/State.hs b/Control/Monad/State.hs index 92d478b..abe4655 100644 --- a/Control/Monad/State.hs +++ b/Control/Monad/State.hs @@ -1,336 +1,27 @@ -{-# 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 +-- (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. +-- 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. ----------------------------------------------------------------------------- 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 + module Control.Monad.State.Lazy ) where -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') +import Control.Monad.State.Lazy -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) diff --git a/Control/Monad/State/Class.hs b/Control/Monad/State/Class.hs new file mode 100644 index 0000000..b81e8e2 --- /dev/null +++ b/Control/Monad/State/Class.hs @@ -0,0 +1,62 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.State.Class +-- 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) +-- +-- MonadState class. +-- +-- 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. + +----------------------------------------------------------------------------- + +module Control.Monad.State.Class ( + -- * MonadState class + MonadState(..), + modify, + gets, + ) where + +-- --------------------------------------------------------------------------- +-- | /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) + diff --git a/Control/Monad/State/Lazy.hs b/Control/Monad/State/Lazy.hs new file mode 100644 index 0000000..3643c98 --- /dev/null +++ b/Control/Monad/State/Lazy.hs @@ -0,0 +1,300 @@ +{-# OPTIONS -fallow-undecidable-instances #-} +-- Search for -fallow-undecidable-instances to see why this is needed + +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.State.Lazy +-- 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) +-- +-- Lazy 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.Lazy ( + module Control.Monad.State.Class, + -- * 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 Control.Monad +import Control.Monad.Cont.Class +import Control.Monad.Error.Class +import Control.Monad.Fix +import Control.Monad.Reader.Class +import Control.Monad.State.Class +import Control.Monad.Trans +import Control.Monad.Writer.Class + +-- --------------------------------------------------------------------------- +-- | 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) } + +-- |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 + +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) + +-- --------------------------------------------------------------------------- +-- | 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) } + +-- |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 + +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) + +-- --------------------------------------------------------------------------- +-- Instances for other mtl transformers + +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 (MonadCont m) => MonadCont (StateT s m) where + callCC f = StateT $ \s -> + callCC $ \c -> + runStateT (f (\a -> StateT $ \s' -> c (a, s'))) s + +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 + +-- 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) + +-- --------------------------------------------------------------------------- +-- $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) diff --git a/Control/Monad/State/Strict.hs b/Control/Monad/State/Strict.hs new file mode 100644 index 0000000..f918825 --- /dev/null +++ b/Control/Monad/State/Strict.hs @@ -0,0 +1,299 @@ +{-# OPTIONS -fallow-undecidable-instances #-} +-- Search for -fallow-undecidable-instances to see why this is needed + +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.State.Strict +-- 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) +-- +-- Strict 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.Strict ( + module Control.Monad.State.Class, + -- * 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 Control.Monad +import Control.Monad.Cont.Class +import Control.Monad.Error.Class +import Control.Monad.Fix +import Control.Monad.Reader.Class +import Control.Monad.State.Class +import Control.Monad.Trans +import Control.Monad.Writer.Class + +-- --------------------------------------------------------------------------- +-- | 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) } + +-- |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 + + +instance Functor (State s) where + fmap f m = State $ \s -> case runState m s of + (a, s') -> (f a, s') + +instance Monad (State s) where + return a = State $ \s -> (a, s) + m >>= k = State $ \s -> case runState m s of + (a, s') -> 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) + +-- --------------------------------------------------------------------------- +-- | 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) } + +-- |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 + +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) + +-- --------------------------------------------------------------------------- +-- Instances for other mtl transformers + +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 (MonadCont m) => MonadCont (StateT s m) where + callCC f = StateT $ \s -> + callCC $ \c -> + runStateT (f (\a -> StateT $ \s' -> c (a, s'))) s + +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 + +-- 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) + +-- --------------------------------------------------------------------------- +-- $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) diff --git a/Control/Monad/Trans.hs b/Control/Monad/Trans.hs index e89809d..207227d 100644 --- a/Control/Monad/Trans.hs +++ b/Control/Monad/Trans.hs @@ -2,25 +2,25 @@ -- | -- Module : Control.Monad.Trans -- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 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. +-- 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(..), + MonadTrans(..), + MonadIO(..), ) where import System.IO @@ -33,10 +33,10 @@ import System.IO -- monad, giving access to (lifting) the inner monad. class MonadTrans t where - lift :: Monad m => m a -> t m a + lift :: Monad m => m a -> t m a class (Monad m) => MonadIO m where - liftIO :: IO a -> m a + liftIO :: IO a -> m a instance MonadIO IO where - liftIO = id + liftIO = id diff --git a/Control/Monad/Writer.hs b/Control/Monad/Writer.hs index 381faa8..81318bc 100644 --- a/Control/Monad/Writer.hs +++ b/Control/Monad/Writer.hs @@ -5,166 +5,25 @@ -- | -- Module : Control.Monad.Writer -- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 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://web.cecs.pdx.edu/~mpj/pubs/springschool.html>) --- Advanced School of Functional Programming, 1995. +-- Inspired by the paper +-- /Functional Programming with Overloading and +-- Higher-Order Polymorphism/, +-- Mark P Jones (<http://web.cecs.pdx.edu/~mpj/pubs/springschool.html>) +-- 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 + module Control.Monad.Writer.Lazy ) where -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 +import Control.Monad.Writer.Lazy --- 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) diff --git a/Control/Monad/Writer/Class.hs b/Control/Monad/Writer/Class.hs new file mode 100644 index 0000000..278aa37 --- /dev/null +++ b/Control/Monad/Writer/Class.hs @@ -0,0 +1,58 @@ +{-# OPTIONS -fallow-undecidable-instances #-} +-- Search for -fallow-undecidable-instances to see why this is needed + +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.Writer.Class +-- 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://web.cecs.pdx.edu/~mpj/pubs/springschool.html>) +-- Advanced School of Functional Programming, 1995. +----------------------------------------------------------------------------- + +module Control.Monad.Writer.Class ( + MonadWriter(..), + listens, + censor, + ) where + +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) + diff --git a/Control/Monad/Writer/Lazy.hs b/Control/Monad/Writer/Lazy.hs new file mode 100644 index 0000000..9206f7b --- /dev/null +++ b/Control/Monad/Writer/Lazy.hs @@ -0,0 +1,150 @@ +{-# OPTIONS -fallow-undecidable-instances #-} +-- Search for -fallow-undecidable-instances to see why this is needed + +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.Writer.Lazy +-- 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) +-- +-- Lazy writer monads. +-- +-- Inspired by the paper +-- /Functional Programming with Overloading and +-- Higher-Order Polymorphism/, +-- Mark P Jones (<http://web.cecs.pdx.edu/~mpj/pubs/springschool.html>) +-- Advanced School of Functional Programming, 1995. +----------------------------------------------------------------------------- + +module Control.Monad.Writer.Lazy ( + module Control.Monad.Writer.Class, + Writer(..), + execWriter, + mapWriter, + WriterT(..), + execWriterT, + mapWriterT, + module Control.Monad, + module Control.Monad.Fix, + module Control.Monad.Trans, + module Data.Monoid, + ) where + +import Control.Monad +import Control.Monad.Cont.Class +import Control.Monad.Error.Class +import Control.Monad.Fix +import Control.Monad.Reader.Class +import Control.Monad.State.Class +import Control.Monad.Trans +import Control.Monad.Writer.Class +import Data.Monoid + +-- --------------------------------------------------------------------------- +-- Our parameterizable writer monad + +newtype Writer w a = Writer { runWriter :: (a, 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) + +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) + +-- --------------------------------------------------------------------------- +-- Our parameterizable writer monad, with an inner monad + +newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } + +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) + +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) + +-- --------------------------------------------------------------------------- +-- Instances for other mtl transformers + +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, MonadCont m) => MonadCont (WriterT w m) where + callCC f = WriterT $ + callCC $ \c -> + runWriterT (f (\a -> WriterT $ c (a, mempty))) + +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) + +-- 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) + +-- Needs -fallow-undecidable-instances +instance (Monoid w, MonadState s m) => MonadState s (WriterT w m) where + get = lift get + put = lift . put + diff --git a/Control/Monad/Writer/Strict.hs b/Control/Monad/Writer/Strict.hs new file mode 100644 index 0000000..3ab100c --- /dev/null +++ b/Control/Monad/Writer/Strict.hs @@ -0,0 +1,152 @@ +{-# OPTIONS -fallow-undecidable-instances #-} +-- Search for -fallow-undecidable-instances to see why this is needed + +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.Writer.Strict +-- 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) +-- +-- Strict writer monads. +-- +-- Inspired by the paper +-- /Functional Programming with Overloading and +-- Higher-Order Polymorphism/, +-- Mark P Jones (<http://web.cecs.pdx.edu/~mpj/pubs/springschool.html>) +-- Advanced School of Functional Programming, 1995. +----------------------------------------------------------------------------- + +module Control.Monad.Writer.Strict ( + module Control.Monad.Writer.Class, + Writer(..), + execWriter, + mapWriter, + WriterT(..), + execWriterT, + mapWriterT, + module Control.Monad, + module Control.Monad.Fix, + module Control.Monad.Trans, + module Data.Monoid, + ) where + +import Control.Monad +import Control.Monad.Cont.Class +import Control.Monad.Error.Class +import Control.Monad.Fix +import Control.Monad.Reader.Class +import Control.Monad.State.Class +import Control.Monad.Trans +import Control.Monad.Writer.Class +import Data.Monoid + +-- --------------------------------------------------------------------------- +-- Our parameterizable writer monad + +newtype Writer w a = Writer { runWriter :: (a, 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) + +instance Functor (Writer w) where + fmap f m = Writer $ case runWriter m of + (a, w) -> (f a, w) + +instance (Monoid w) => Monad (Writer w) where + return a = Writer (a, mempty) + m >>= k = Writer $ case runWriter m of + (a, w) -> case runWriter (k a) of + (b, w') -> (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 $ case runWriter m of + (a, w) -> ((a, w), w) + pass m = Writer $ case runWriter m of + ((a, f), w) -> (a, f w) + +-- --------------------------------------------------------------------------- +-- Our parameterizable writer monad, with an inner monad + +newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } + +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) + +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) + +-- --------------------------------------------------------------------------- +-- Instances for other mtl transformers + +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, MonadCont m) => MonadCont (WriterT w m) where + callCC f = WriterT $ + callCC $ \c -> + runWriterT (f (\a -> WriterT $ c (a, mempty))) + +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) + +-- 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) + +-- Needs -fallow-undecidable-instances +instance (Monoid w, MonadState s m) => MonadState s (WriterT w m) where + get = lift get + put = lift . put + diff --git a/LICENSE b/LICENSE index 4ec14bf..92337b9 100644 --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ The Glasgow Haskell Compiler License -Copyright 2004, The University Court of the University of Glasgow. +Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without @@ -8,14 +8,14 @@ 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. +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, diff --git a/Makefile b/Makefile index b9e197c..82643f3 100644 --- a/Makefile +++ b/Makefile @@ -1,10 +1,16 @@ TOP=.. include $(TOP)/mk/boilerplate.mk -SUBDIRS = +SUBDIRS = -ALL_DIRS = \ - Control/Monad +ALL_DIRS = \ + Control/Monad \ + Control/Monad/Cont \ + Control/Monad/Error \ + Control/Monad/RWS \ + Control/Monad/Reader \ + Control/Monad/State \ + Control/Monad/Writer PACKAGE = mtl VERSION = 1.0 diff --git a/mtl.cabal b/mtl.cabal index 56ffb94..964ad31 100644 --- a/mtl.cabal +++ b/mtl.cabal @@ -1,26 +1,38 @@ -name: mtl -version: 1.0 -license: BSD3 -license-file: LICENSE -author: Andy Gill -maintainer: libraries@haskell.org -category: Control -synopsis: Monad transformer library +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. -ghc-options: -Wall + 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. +ghc-options: -Wall 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 + Control.Monad.Cont + Control.Monad.Cont.Class + Control.Monad.Error + Control.Monad.Error.Class + Control.Monad.Identity + Control.Monad.List + Control.Monad.RWS + Control.Monad.RWS.Class + Control.Monad.RWS.Lazy + Control.Monad.RWS.Strict + Control.Monad.Reader + Control.Monad.Reader.Class + Control.Monad.State + Control.Monad.State.Class + Control.Monad.State.Lazy + Control.Monad.State.Strict + Control.Monad.Trans + Control.Monad.Writer + Control.Monad.Writer.Class + Control.Monad.Writer.Lazy + Control.Monad.Writer.Strict +build-depends: base extensions: MultiParamTypeClasses, FunctionalDependencies diff --git a/package.conf.in b/package.conf.in index 1289fcd..cbc9d08 100644 --- a/package.conf.in +++ b/package.conf.in @@ -1,33 +1,44 @@ -name: PACKAGE -version: VERSION -license: BSD3 -maintainer: libraries@haskell.org -exposed: True +name: PACKAGE +version: VERSION +license: BSD3 +maintainer: libraries@haskell.org +exposed: True 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 - + Control.Monad.Cont, + Control.Monad.Cont.Class, + Control.Monad.Error, + Control.Monad.Error.Class, + Control.Monad.Identity, + Control.Monad.List, + Control.Monad.RWS, + Control.Monad.RWS.Class, + Control.Monad.RWS.Lazy, + Control.Monad.RWS.Strict, + Control.Monad.Reader, + Control.Monad.Reader.Class, + Control.Monad.State, + Control.Monad.State.Class, + Control.Monad.State.Lazy, + Control.Monad.State.Strict, + Control.Monad.Trans, + Control.Monad.Writer, + Control.Monad.Writer.Class, + Control.Monad.Writer.Lazy, + Control.Monad.Writer.Strict hidden-modules: -import-dirs: IMPORT_DIR -library-dirs: LIB_DIR -hs-libraries: "HSmtl" +import-dirs: IMPORT_DIR +library-dirs: LIB_DIR +hs-libraries: "HSmtl" extra-libraries: include-dirs: -includes: -depends: base +includes: +depends: base hugs-options: cc-options: ld-options: framework-dirs: frameworks: -haddock-interfaces: HADDOCK_IFACE -haddock-html: HTML_DIR +haddock-interfaces: HADDOCK_IFACE +haddock-html: HTML_DIR diff --git a/prologue.txt b/prologue.txt index 6896b64..8028045 100644 --- a/prologue.txt +++ b/prologue.txt @@ -1,4 +1,4 @@ A monad transformer library, inspired by the paper -/Functional Programming with Overloading and Higher-Order Polymorphism/, +/Functional Programming with Overloading and Higher-Order Polymorphism/, Mark P Jones (<http://www.cse.ogi.edu/~mpj/>) Advanced School of Functional Programming, 1995. -- GitLab