diff --git a/Control/Monad/Cont.hs b/Control/Monad/Cont.hs --- a/Control/Monad/Cont.hs +++ b/Control/Monad/Cont.hs @@ -1,58 +1,103 @@ {-# OPTIONS -fallow-undecidable-instances #-} -- Search for -fallow-undecidable-instances to see why this is needed ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Cont --- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : non-portable (multi-parameter type classes) --- --- Continuation monads. --- ------------------------------------------------------------------------------ +{- | +Module : Control.Monad.Cont +Copyright : (c) The University of Glasgow 2001, + (c) Jeff Newbern 2003-2007, + (c) Andriy Palamarchuk 2007 +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 can be interrupted and resumed. + +[Binding strategy:] Binding a function to a monadic value creates +a new continuation which uses the function as the continuation of the monadic +computation. + +[Useful for:] Complex control structures, error handling, +and creating co-routines. + +[Zero and plus:] None. + +[Example type:] @'Cont' r a@ + +The Continuation monad represents computations in continuation-passing style +(CPS). +In continuation-passing style function result is not returned, +but instead is passed to another function, +received as a parameter (continuation). +Computations are built up from sequences +of nested continuations, terminated by a final continuation (often @id@) +which produces the final result. +Since continuations are functions which represent the future of a computation, +manipulation of the continuation functions can achieve complex manipulations +of the future of the computation, +such as interrupting a computation in the middle, aborting a portion +of a computation, restarting a computation, and interleaving execution of +computations. +The Continuation monad adapts CPS to the structure of a monad. + +Before using the Continuation monad, be sure that you have +a firm understanding of continuation-passing style +and that continuations represent the best solution to your particular +design problem. +Many algorithms which require continuations in other languages do not require +them in Haskell, due to Haskell's lazy semantics. +Abuse of the Continuation monad can produce code that is impossible +to understand and maintain. +-} + module Control.Monad.Cont ( - MonadCont(..), - Cont(..), - mapCont, - withCont, - ContT(..), - mapContT, - withContT, - module Control.Monad, - module Control.Monad.Trans, - ) where + module Control.Monad.Cont.Class, + Cont(..), + mapCont, + withCont, + ContT(..), + mapContT, + withContT, + module Control.Monad, + module Control.Monad.Trans, + -- * Example 1: Simple Continuation Usage + -- $simpleContExample -import Prelude + -- * Example 2: Using @callCC@ + -- $callCCExample + + -- * Example 3: Using @ContT@ Monad Transformer + -- $ContTExample + ) where import Control.Monad +import Control.Monad.Cont.Class +import Control.Monad.Reader.Class +import Control.Monad.State.Class import Control.Monad.Trans -import Control.Monad.Reader -import Control.Monad.Writer -import Control.Monad.State -import Control.Monad.RWS -class (Monad m) => MonadCont m where - callCC :: ((a -> m b) -> m a) -> m a +{- | +Continuation monad. +@Cont r a@ is a CPS computation that produces an intermediate result +of type @a@ within a CPS computation whose final result type is @r@. --- --------------------------------------------------------------------------- --- Our parameterizable continuation monad +The @return@ function simply creates a continuation which passes the value on. -newtype Cont r a = Cont { runCont :: (a -> r) -> r } +The @>>=@ operator adds the bound function into the continuation chain. +-} +newtype Cont r a = Cont { -instance Functor (Cont r) where - fmap f m = Cont $ \c -> runCont m (c . f) + {- | Runs a CPS computation, returns its result after applying + the final continuation to it. + Parameters: -instance Monad (Cont r) where - return a = Cont ($ a) - m >>= k = Cont $ \c -> runCont m $ \a -> runCont (k a) c + * a continuation computation (@Cont@). -instance MonadCont (Cont r) where - callCC f = Cont $ \c -> runCont (f (\a -> Cont $ \_ -> c a)) c + * the final continuation, which produces the final result (often @id@). + -} + runCont :: (a -> r) -> r +} mapCont :: (r -> r) -> Cont r a -> Cont r a mapCont f m = Cont $ f . runCont m @@ -60,64 +105,142 @@ withCont :: ((b -> r) -> (a -> r)) -> Cont r a -> Cont r b withCont f m = Cont $ runCont m . f --- --------------------------------------------------------------------------- --- Our parameterizable continuation monad, with an inner monad +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 + +{- | +The continuation monad transformer. +Can be used to add continuation handling to other monads. +-} 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 + get = lift get + put = lift . put --- ----------------------------------------------------------------------------- --- MonadCont instances for other monad transformers +{- $simpleContExample +Calculating length of a list continuation-style: -instance (MonadCont m) => MonadCont (ReaderT r m) where - callCC f = ReaderT $ \r -> - callCC $ \c -> - runReaderT (f (\a -> ReaderT $ \_ -> c a)) r +>calculateLength :: [a] -> Cont r Int +>calculateLength l = return (length l) -instance (MonadCont m) => MonadCont (StateT s m) where - callCC f = StateT $ \s -> - callCC $ \c -> - runStateT (f (\a -> StateT $ \s' -> c (a, s'))) s +Here we use @calculateLength@ by making it to pass its result to @print@: -instance (Monoid w, MonadCont m) => MonadCont (WriterT w m) where - callCC f = WriterT $ - callCC $ \c -> - runWriterT (f (\a -> WriterT $ c (a, mempty))) +>main = do +> runCont (calculateLength "123") print +> -- result: 3 -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 +It is possible to chain 'Cont' blocks with @>>=@. -mapContT :: (m r -> m r) -> ContT r m a -> ContT r m a -mapContT f m = ContT $ f . runContT m +>double :: Int -> Cont r Int +>double n = return (n * 2) +> +>main = do +> runCont (calculateLength "123" >>= double) print +> -- result: 6 +-} -withContT :: ((b -> m r) -> (a -> m r)) -> ContT r m a -> ContT r m b -withContT f m = ContT $ runContT m . f +{- $callCCExample +This example gives a taste of how escape continuations work, shows a typical +pattern for their usage. + +>-- Returns a string depending on the length of the name parameter. +>-- If the provided string is empty, returns an error. +>-- Otherwise, returns a welcome message. +>whatsYourName :: String -> String +>whatsYourName name = +> (`runCont` id) $ do -- 1 +> response <- callCC $ \exit -> do -- 2 +> validateName name exit -- 3 +> return $ "Welcome, " ++ name ++ "!" -- 4 +> return response -- 5 +> +>validateName name exit = do +> when (null name) (exit "You forgot to tell me your name!") + +Here is what this example does: + +(1) Runs an anonymous 'Cont' block and extracts value from it with +@(\`runCont\` id)@. Here @id@ is the continuation, passed to the @Cont@ block. + +(1) Binds @response@ to the result of the following 'callCC' block, +binds @exit@ to the continuation. + +(1) Validates @name@. +This approach illustrates advantage of using 'callCC' over @return@. +We pass the continuation to @validateName@, +and interrupt execution of the @Cont@ block from /inside/ of @validateName@. + +(1) Returns the welcome message from the @callCC@ block. +This line is not executed if @validateName@ fails. + +(1) Returns from the @Cont@ block. +-} + +{-$ContTExample +'ContT' can be used to add continuation handling to other monads. +Here is an example how to combine it with @IO@ monad: + +>import Control.Monad.Cont +>import System.IO +> +>main = do +> hSetBuffering stdout NoBuffering +> runContT (callCC askString) reportResult +> +>askString :: (String -> ContT () IO String) -> ContT () IO String +>askString next = do +> liftIO $ putStrLn "Please enter a string" +> s <- liftIO $ getLine +> next s +> +>reportResult :: String -> IO () +>reportResult s = do +> putStrLn ("You entered: " ++ s) + +Action @askString@ requests user to enter a string, +and passes it to the continuation. +@askString@ takes as a parameter a continuation taking a string parameter, +and returning @IO ()@. +Compare its signature to 'runContT' definition. +-} diff --git a/Control/Monad/Cont/Class.hs b/Control/Monad/Cont/Class.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Cont/Class.hs @@ -0,0 +1,78 @@ +{-# 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, + (c) Jeff Newbern 2003-2007, + (c) Andriy Palamarchuk 2007 +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 can be interrupted and resumed. + +[Binding strategy:] Binding a function to a monadic value creates +a new continuation which uses the function as the continuation of the monadic +computation. + +[Useful for:] Complex control structures, error handling, +and creating co-routines. + +[Zero and plus:] None. + +[Example type:] @'Cont' r a@ + +The Continuation monad represents computations in continuation-passing style +(CPS). +In continuation-passing style function result is not returned, +but instead is passed to another function, +received as a parameter (continuation). +Computations are built up from sequences +of nested continuations, terminated by a final continuation (often @id@) +which produces the final result. +Since continuations are functions which represent the future of a computation, +manipulation of the continuation functions can achieve complex manipulations +of the future of the computation, +such as interrupting a computation in the middle, aborting a portion +of a computation, restarting a computation, and interleaving execution of +computations. +The Continuation monad adapts CPS to the structure of a monad. + +Before using the Continuation monad, be sure that you have +a firm understanding of continuation-passing style +and that continuations represent the best solution to your particular +design problem. +Many algorithms which require continuations in other languages do not require +them in Haskell, due to Haskell's lazy semantics. +Abuse of the Continuation monad can produce code that is impossible +to understand and maintain. +-} + +module Control.Monad.Cont.Class ( + MonadCont(..), + ) where + +class (Monad m) => MonadCont m where + {- | @callCC@ (call-with-current-continuation) + calls a function with the current continuation as its argument. + Provides an escape continuation mechanism for use with Continuation monads. + Escape continuations allow to abort the current computation and return + a value immediately. + They achieve a similar effect to 'Control.Monad.Error.throwError' + and 'Control.Monad.Error.catchError' + within an 'Control.Monad.Error.Error' monad. + Advantage of this function over calling @return@ is that it makes + the continuation explicit, + allowing more flexibility and better control + (see examples in "Control.Monad.Cont"). + + The standard idiom used with @callCC@ is to provide a lambda-expression + to name the continuation. Then calling the named continuation anywhere + within its scope will escape from the computation, + even if it is many layers deep within nested computations. + -} + callCC :: ((a -> m b) -> m a) -> m a + diff --git a/Control/Monad/Error.hs b/Control/Monad/Error.hs --- a/Control/Monad/Error.hs +++ b/Control/Monad/Error.hs @@ -1,221 +1,290 @@ {-# OPTIONS -fallow-undecidable-instances #-} -- Needed for the same reasons as in Reader, State etc ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Error --- Copyright : (c) Michael Weber , 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : non-portable (multi-parameter type classes) --- --- The Error monad. --- --- Rendered by Michael Weber , --- inspired by the Haskell Monad Template Library from --- Andy Gill () --- ------------------------------------------------------------------------------ +{- | +Module : Control.Monad.Error +Copyright : (c) Michael Weber 2001, + (c) Jeff Newbern 2003-2006, + (c) Andriy Palamarchuk 2006 +License : BSD-style (see the file libraries/base/LICENSE) -module Control.Monad.Error ( - Error(..), - MonadError(..), - ErrorT(..), - mapErrorT, - module Control.Monad, - module Control.Monad.Fix, - module Control.Monad.Trans, - ) where +Maintainer : libraries@haskell.org +Stability : experimental +Portability : non-portable (multi-parameter type classes) -import Prelude +[Computation type:] Computations which may fail or throw exceptions. -import Control.Monad -import Control.Monad.Fix -import Control.Monad.Trans -import Control.Monad.Reader -import Control.Monad.Writer -import Control.Monad.State -import Control.Monad.RWS -import Control.Monad.Cont +[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. -import Control.Monad.Instances () -import System.IO +[Useful for:] Building computations from sequences of functions that may fail +or using exception handling to structure error handling. --- --------------------------------------------------------------------------- --- class MonadError --- --- throws an exception inside the monad and thus interrupts --- normal execution order, until an error handler is reached} --- --- catches an exception inside the monad (that was previously --- thrown by throwError +[Zero and plus:] Zero is represented by an empty error and the plus operation +executes its second argument if the first fails. -class Error a where - noMsg :: a - strMsg :: String -> a +[Example type:] @'Data.Either' String a@ - noMsg = strMsg "" - strMsg _ = noMsg +The Error monad (also called the Exception monad). +-} -instance Error [Char] where - noMsg = "" - strMsg = id +{- + Rendered by Michael Weber , + inspired by the Haskell Monad Template Library from + Andy Gill () +-} +module Control.Monad.Error ( + 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 -instance Error IOError where - strMsg = userError + -- * Example 2: Using ErrorT Monad Transformer + -- $ErrorTExample + ) where -class (Monad m) => MonadError e m | m -> e where - throwError :: e -> m a - catchError :: m a -> (e -> m a) -> m a +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 Control.Monad.Instances () +import System.IO + 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 --- --------------------------------------------------------------------------- --- Our parameterizable error monad, with an inner monad +{- | +The error monad transformer. It can be used to add error handling to other +monads. -newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) } +The @ErrorT@ Monad structure is parameterized over two things: --- The ErrorT Monad structure is parameterized over two things: --- * e - The error type. --- * m - The inner monad. + * e - The error type. --- Here are some examples of use: --- --- type ErrorWithIO e a = ErrorT e IO a --- ==> ErrorT (IO (Either e a)) --- --- type ErrorAndStateWithIO e s a = ErrorT e (StateT s IO) a --- ==> ErrorT (StateT s IO (Either e a)) --- ==> ErrorT (StateT (s -> IO (Either e a,s))) --- + * m - The inner monad. +Here are some examples of use: + +> -- wraps IO action that can throw an error e +> type ErrorWithIO e a = ErrorT e IO a +> ==> ErrorT (IO (Either e a)) +> +> -- IO monad wrapped in StateT inside of ErrorT +> type ErrorAndStateWithIO e s a = ErrorT e (StateT s IO) a +> ==> ErrorT (StateT s IO (Either e a)) +> ==> ErrorT (StateT (s -> IO (Either e a,s))) +-} + +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 + liftIO = lift . liftIO -instance (Error e, MonadReader r m) => MonadReader r (ErrorT e m) where - ask = lift ask - local f m = ErrorT $ local f (runErrorT m) +instance (Error e, MonadCont m) => MonadCont (ErrorT e m) where + callCC f = ErrorT $ + callCC $ \c -> + runErrorT (f (\a -> ErrorT $ c (Right a))) -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, MonadRWS r w s m) => MonadRWS r w s (ErrorT e m) -instance (Error e, MonadState s m) => MonadState s (ErrorT e m) where - get = lift get - put = lift . put +instance (Error e, MonadReader r m) => MonadReader r (ErrorT e m) where + ask = lift ask + local f m = ErrorT $ local f (runErrorT m) -instance (Error e, 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 -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, 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) --- --------------------------------------------------------------------------- --- MonadError instances for other monad transformers +{- $customErrorExample +Here is an example that demonstrates the use of a custom 'Error' data type with +the 'throwError' and 'catchError' exception mechanism from 'MonadError'. +The example throws an exception if the user enters an empty string +or a string longer than 5 characters. Otherwise it prints length of the string. -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 +>-- This is the type to represent length calculation error. +>data LengthError = EmptyString -- Entered string was empty. +> | StringTooLong Int -- A string is longer than 5 characters. +> -- Records a length of the string. +> | OtherError String -- Other error, stores the problem description. +> +>-- We make LengthError an instance of the Error class +>-- to be able to throw it as an exception. +>instance Error LengthError where +> noMsg = OtherError "A String Error!" +> strMsg s = OtherError s +> +>-- Converts LengthError to a readable message. +>instance Show LengthError where +> show EmptyString = "The string was empty!" +> show (StringTooLong len) = +> "The length of the string (" ++ (show len) ++ ") is bigger than 5!" +> show (OtherError msg) = msg +> +>-- For our monad type constructor, we use Either LengthError +>-- which represents failure using Left LengthError +>-- or a successful result of type a using Right a. +>type LengthMonad = Either LengthError +> +>main = do +> putStrLn "Please enter a string:" +> s <- getLine +> reportResult (calculateLength s) +> +>-- Wraps length calculation to catch the errors. +>-- Returns either length of the string or an error. +>calculateLength :: String -> LengthMonad Int +>calculateLength s = (calculateLengthOrFail s) `catchError` Left +> +>-- Attempts to calculate length and throws an error if the provided string is +>-- empty or longer than 5 characters. +>-- The processing is done in Either monad. +>calculateLengthOrFail :: String -> LengthMonad Int +>calculateLengthOrFail [] = throwError EmptyString +>calculateLengthOrFail s | len > 5 = throwError (StringTooLong len) +> | otherwise = return len +> where len = length s +> +>-- Prints result of the string length calculation. +>reportResult :: LengthMonad Int -> IO () +>reportResult (Right len) = putStrLn ("The length of the string is " ++ (show len)) +>reportResult (Left e) = putStrLn ("Length calculation failed with error: " ++ (show e)) +-} -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) +{- $ErrorTExample +@'ErrorT'@ monad transformer can be used to add error handling to another monad. +Here is an example how to combine it with an @IO@ monad: -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 +>import Control.Monad.Error +> +>-- An IO monad which can return String failure. +>-- It is convenient to define the monad type of the combined monad, +>-- especially if we combine more monad transformers. +>type LengthMonad = ErrorT String IO +> +>main = do +> -- runErrorT removes the ErrorT wrapper +> r <- runErrorT calculateLength +> reportResult r +> +>-- Asks user for a non-empty string and returns its length. +>-- Throws an error if user enters an empty string. +>calculateLength :: LengthMonad Int +>calculateLength = do +> -- all the IO operations have to be lifted to the IO monad in the monad stack +> liftIO $ putStrLn "Please enter a non-empty string: " +> s <- liftIO getLine +> if null s +> then throwError "The string was empty!" +> else return $ length s +> +>-- Prints result of the string length calculation. +>reportResult :: Either String Int -> IO () +>reportResult (Right len) = putStrLn ("The length of the string is " ++ (show len)) +>reportResult (Left e) = putStrLn ("Length calculation failed with error: " ++ (show e)) +-} -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/Error/Class.hs b/Control/Monad/Error/Class.hs new file mode 100644 --- /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 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 , + inspired by the Haskell Monad Template Library from + Andy Gill () +-} +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 --- a/Control/Monad/Identity.hs +++ b/Control/Monad/Identity.hs @@ -1,60 +1,95 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Identity --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : portable --- --- The Identity monad. --- --- Inspired by the paper --- /Functional Programming with Overloading and --- Higher-Order Polymorphism/, --- Mark P Jones () --- Advanced School of Functional Programming, 1995. --- ------------------------------------------------------------------------------ +{- | +Module : Control.Monad.Identity +Copyright : (c) Andy Gill 2001, + (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 +Stability : experimental +Portability : portable + +[Computation type:] Simple function application. + +[Binding strategy:] The bound function is applied to the input value. +@'Identity' x >>= f == 'Identity' (f x)@ + +[Useful for:] Monads can be derived from monad transformers applied to the +'Identity' monad. + +[Zero and plus:] None. + +[Example type:] @'Identity' a@ + +The @Identity@ monad is a monad that does not embody any computational strategy. +It simply applies the bound function to its input without any modification. +Computationally, there is no reason to use the @Identity@ monad +instead of the much simpler act of simply applying functions to their arguments. +The purpose of the @Identity@ monad is its fundamental role in the theory +of monad transformers. +Any monad transformer applied to the @Identity@ monad yields a non-transformer +version of that monad. + + Inspired by the paper + /Functional Programming with Overloading and + Higher-Order Polymorphism/, + Mark P Jones () + Advanced School of Functional Programming, 1995. +-} + module Control.Monad.Identity ( - Identity(..), - module Control.Monad, - module Control.Monad.Fix, - ) where + Identity(..), -import Prelude + module Control.Monad, + module Control.Monad.Fix, + ) where import Control.Monad import Control.Monad.Fix --- --------------------------------------------------------------------------- --- Identity wrapper --- --- Abstraction for wrapping up a object. --- If you have an monadic function, say: --- --- example :: Int -> IdentityMonad Int --- example x = return (x*x) --- --- you can "run" it, using --- --- Main> runIdentity (example 42) --- 1764 :: Int +{- | 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) +> 1764 :: Int + +A typical use of the Identity monad is to derive a monad +from a monad transformer. + +@ +-- derive the 'Control.Monad.State.State' monad using the 'Control.Monad.State.StateT' monad transformer +type 'Control.Monad.State.State' s a = 'Control.Monad.State.StateT' s 'Identity' a +@ + +The @'runIdentity'@ label is used in the type definition because it follows +a style of monad definition that explicitly represents monad values as +computations. In this style, a monadic computation is built up using the monadic +operators and then the value of the computation is extracted +using the @run******@ function. +Because the @Identity@ monad does not do any computation, its definition +is trivial. +For a better example of this style of monad, +see the @'Control.Monad.State.State'@ monad. +-} + 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 --- 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,71 +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 Prelude - 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) -mapListT :: (m [a] -> n [b]) -> ListT m a -> ListT n b -mapListT f m = ListT $ f (runListT m) +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 + diff --git a/Control/Monad/RWS.hs b/Control/Monad/RWS.hs --- a/Control/Monad/RWS.hs +++ b/Control/Monad/RWS.hs @@ -2,160 +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 () --- Advanced School of Functional Programming, 1995. +-- Inspired by the paper +-- /Functional Programming with Overloading and +-- Higher-Order Polymorphism/, +-- Mark P Jones () +-- Advanced School of Functional Programming, 1995. ----------------------------------------------------------------------------- module Control.Monad.RWS ( - RWS(..), - evalRWS, - execRWS, - mapRWS, - withRWS, - RWST(..), - evalRWST, - execRWST, - mapRWST, - withRWST, - module Control.Monad.Reader, - module Control.Monad.Writer, - module Control.Monad.State, + module Control.Monad.RWS.Lazy ) where -import Prelude - -import Control.Monad -import Control.Monad.Fix -import Control.Monad.Trans -import Control.Monad.Reader -import Control.Monad.Writer -import Control.Monad.State -import Data.Monoid - -newtype RWS r w s a = RWS { runRWS :: r -> s -> (a, s, w) } - -instance Functor (RWS r w s) where - fmap f m = RWS $ \r s -> let - (a, s', w) = runRWS m r s - in (f a, s', w) - -instance (Monoid w) => Monad (RWS r w s) where - return a = RWS $ \_ s -> (a, s, mempty) - m >>= k = RWS $ \r s -> let - (a, s', w) = runRWS m r s - (b, s'', w') = runRWS (k a) r s' - in (b, s'', w `mappend` w') - -instance (Monoid w) => MonadFix (RWS r w s) where - mfix f = RWS $ \r s -> let (a, s', w) = runRWS (f a) r s in (a, s', w) - -instance (Monoid w) => MonadReader r (RWS r w s) where - ask = RWS $ \r s -> (r, s, mempty) - local f m = RWS $ \r s -> runRWS m (f r) s - -instance (Monoid w) => MonadWriter w (RWS r w s) where - tell w = RWS $ \_ s -> ((), s, w) - listen m = RWS $ \r s -> let - (a, s', w) = runRWS m r s - in ((a, w), s', w) - pass m = RWS $ \r s -> let - ((a, f), s', w) = runRWS m r s - in (a, s', f w) - -instance (Monoid w) => MonadState s (RWS r w s) where - get = RWS $ \_ s -> (s, s, mempty) - put s = RWS $ \_ _ -> ((), s, mempty) - - -evalRWS :: RWS r w s a -> r -> s -> (a, w) -evalRWS m r s = let - (a, _, w) = runRWS m r s - in (a, w) - -execRWS :: RWS r w s a -> r -> s -> (s, w) -execRWS m r s = let - (_, s', w) = runRWS m r s - in (s', w) - -mapRWS :: ((a, s, w) -> (b, s, w')) -> RWS r w s a -> RWS r w' s b -mapRWS f m = RWS $ \r s -> f (runRWS m r s) - -withRWS :: (r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a -withRWS f m = RWS $ \r s -> uncurry (runRWS m) (f r s) - - -newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) } - -instance (Monad m) => Functor (RWST r w s m) where - fmap f m = RWST $ \r s -> do - (a, s', w) <- runRWST m r s - return (f a, s', w) - -instance (Monoid w, Monad m) => Monad (RWST r w s m) where - return a = RWST $ \_ s -> return (a, s, mempty) - m >>= k = RWST $ \r s -> do - (a, s', w) <- runRWST m r s - (b, s'',w') <- runRWST (k a) r s' - return (b, s'', w `mappend` w') - fail msg = RWST $ \_ _ -> fail msg - -instance (Monoid w, MonadPlus m) => MonadPlus (RWST r w s m) where - mzero = RWST $ \_ _ -> mzero - m `mplus` n = RWST $ \r s -> runRWST m r s `mplus` runRWST n r s - -instance (Monoid w, MonadFix m) => MonadFix (RWST r w s m) where - mfix f = RWST $ \r s -> mfix $ \ ~(a, _, _) -> runRWST (f a) r s - -instance (Monoid w, Monad m) => MonadReader r (RWST r w s m) where - ask = RWST $ \r s -> return (r, s, mempty) - local f m = RWST $ \r s -> runRWST m (f r) s - -instance (Monoid w, Monad m) => MonadWriter w (RWST r w s m) where - tell w = RWST $ \_ s -> return ((),s,w) - listen m = RWST $ \r s -> do - (a, s', w) <- runRWST m r s - return ((a, w), s', w) - pass m = RWST $ \r s -> do - ((a, f), s', w) <- runRWST m r s - return (a, s', f w) - -instance (Monoid w, Monad m) => MonadState s (RWST r w s m) where - get = RWST $ \_ s -> return (s, s, mempty) - put s = RWST $ \_ _ -> return ((), s, mempty) - -instance (Monoid w) => MonadTrans (RWST r w s) where - lift m = RWST $ \_ s -> do - a <- m - return (a, s, mempty) - -instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where - liftIO = lift . liftIO - - -evalRWST :: (Monad m) => RWST r w s m a -> r -> s -> m (a, w) -evalRWST m r s = do - (a, _, w) <- runRWST m r s - return (a, w) - -execRWST :: (Monad m) => RWST r w s m a -> r -> s -> m (s, w) -execRWST m r s = do - (_, s', w) <- runRWST m r s - return (s', w) - -mapRWST :: (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b -mapRWST f m = RWST $ \r s -> f (runRWST m r s) +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 --- /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 () +-- 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 --- /dev/null +++ b/Control/Monad/RWS/Lazy.hs @@ -0,0 +1,183 @@ +{-# 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 () +-- 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, + 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.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 --- /dev/null +++ b/Control/Monad/RWS/Strict.hs @@ -0,0 +1,179 @@ +{-# 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 () +-- 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, + 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.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 --- a/Control/Monad/Reader.hs +++ b/Control/Monad/Reader.hs @@ -1,129 +1,258 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Reader --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : non-portable (multi-param classes, functional dependencies) --- --- Declaration of the Monoid class,and instances for list and functions --- --- Inspired by the paper --- /Functional Programming with Overloading and --- Higher-Order Polymorphism/, --- Mark P Jones () --- Advanced School of Functional Programming, 1995. ------------------------------------------------------------------------------ +{-# OPTIONS -fallow-undecidable-instances #-} +{- | +Module : Control.Monad.Reader +Copyright : (c) Andy Gill 2001, + (c) Oregon Graduate Institute of Science and Technology 2001, + (c) Jeff Newbern 2003-2007, + (c) Andriy Palamarchuk 2007 +License : BSD-style (see the file libraries/base/LICENSE) -module Control.Monad.Reader ( - MonadReader(..), - asks, - Reader(..), - mapReader, - withReader, - ReaderT(..), - mapReaderT, - withReaderT, - module Control.Monad, - module Control.Monad.Fix, - module Control.Monad.Trans, - ) where +Maintainer : libraries@haskell.org +Stability : experimental +Portability : non-portable (multi-param classes, functional dependencies) -import Prelude +[Computation type:] Computations which read values from a shared environment. -import Control.Monad -import Control.Monad.Fix -import Control.Monad.Trans -import Control.Monad.Instances () +[Binding strategy:] Monad values are functions from the environment to a value. +The bound function is applied to the bound value, and both have access +to the shared environment. --- ---------------------------------------------------------------------------- --- class MonadReader --- asks for the internal (non-mutable) state. +[Useful for:] Maintaining variable bindings, or other shared environment. -class (Monad m) => MonadReader r m | m -> r where - ask :: m r - local :: (r -> r) -> m a -> m a +[Zero and plus:] None. --- This allows you to provide a projection function. +[Example type:] @'Reader' [(String,Value)] a@ -asks :: (MonadReader r m) => (r -> a) -> m a -asks f = do - r <- ask - return (f r) +The 'Reader' monad (also called the Environment monad). +Represents a computation, which can read values from +a shared environment, pass values from function to function, +and execute sub-computations in a modified environment. +Using 'Reader' monad for such computations is often clearer and easier +than using the 'Control.Monad.State.State' monad. + Inspired by the paper + /Functional Programming with Overloading and + Higher-Order Polymorphism/, + Mark P Jones () + Advanced School of Functional Programming, 1995. +-} + +module Control.Monad.Reader ( + module Control.Monad.Reader.Class, + Reader(..), + mapReader, + withReader, + ReaderT(..), + mapReaderT, + withReaderT, + module Control.Monad, + module Control.Monad.Fix, + module Control.Monad.Trans, + -- * Example 1: Simple Reader Usage + -- $simpleReaderExample + + -- * Example 2: Modifying Reader Content With @local@ + -- $localExample + + -- * Example 3: @ReaderT@ Monad Transformer + -- $ReaderTExample + ) where + +import Control.Monad +import Control.Monad.Cont.Class +import Control.Monad.Error.Class +import Control.Monad.Fix +import Control.Monad.Instances () +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 - --- --------------------------------------------------------------------------- --- Our parameterizable reader monad + ask = id + local f m = m . f -newtype Reader r a = Reader { runReader :: r -> a } +{- | +The parameterizable reader monad. -instance Functor (Reader r) where - fmap f m = Reader $ \r -> f (runReader m r) +The @return@ function creates a @Reader@ that ignores the environment, +and produces the given value. -instance Monad (Reader r) where - return a = Reader $ \_ -> a - m >>= k = Reader $ \r -> runReader (k (runReader m r)) r +The binding operator @>>=@ produces a @Reader@ that uses the environment +to extract the value its left-hand side, +and then applies the bound function to that value in the same environment. +-} +newtype Reader r a = Reader { + {- | + Runs @Reader@ and extracts the final value from it. + To extract the value apply @(runReader reader)@ to an environment value. + Parameters: -instance MonadFix (Reader r) where - mfix f = Reader $ \r -> let a = runReader (f a) r in a + * A @Reader@ to run. -instance MonadReader r (Reader r) where - ask = Reader id - local f m = Reader $ runReader m . f + * An initial environment. + -} + runReader :: r -> a +} mapReader :: (a -> b) -> Reader r a -> Reader r b mapReader f m = Reader $ f . runReader m --- This is a more general version of local. +-- | A more general version of 'local'. withReader :: (r' -> r) -> Reader r a -> Reader r' a withReader f m = Reader $ runReader m . f --- --------------------------------------------------------------------------- --- Our parameterizable reader monad, with an inner monad +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 + +{- | +The reader monad transformer. +Can be used to add environment reading functionality to other monads. +-} 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 -mapReaderT :: (m a -> n b) -> ReaderT w m a -> ReaderT w n b -mapReaderT f m = ReaderT $ f . runReaderT m +instance (MonadCont m) => MonadCont (ReaderT r m) where + callCC f = ReaderT $ \r -> + callCC $ \c -> + runReaderT (f (\a -> ReaderT $ \_ -> c a)) r -withReaderT :: (r' -> r) -> ReaderT r m a -> ReaderT r' m a -withReaderT f m = ReaderT $ runReaderT m . f +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) + +{- $simpleReaderExample + +In this example the @Reader@ monad provides access to variable bindings. +Bindings are a 'Map' of integer variables. +The variable @count@ contains number of variables in the bindings. +You can see how to run a Reader monad and retrieve data from it +with 'runReader', how to access the Reader data with 'ask' and 'asks'. + +> type Bindings = Map String Int; +> +>-- Returns True if the "count" variable contains correct bindings size. +>isCountCorrect :: Bindings -> Bool +>isCountCorrect bindings = runReader calc_isCountCorrect bindings +> +>-- The Reader monad, which implements this complicated check. +>calc_isCountCorrect :: Reader Bindings Bool +>calc_isCountCorrect = do +> count <- asks (lookupVar "count") +> bindings <- ask +> return (count == (Map.size bindings)) +> +>-- The selector function to use with 'asks'. +>-- Returns value of the variable with specified name. +>lookupVar :: String -> Bindings -> Int +>lookupVar name bindings = fromJust (Map.lookup name bindings) +> +>sampleBindings = Map.fromList [("count",3), ("1",1), ("b",2)] +> +>main = do +> putStr $ "Count is correct for bindings " ++ (show sampleBindings) ++ ": "; +> putStrLn $ show (isCountCorrect sampleBindings); +-} + +{- $localExample + +Shows how to modify Reader content with 'local'. + +>calculateContentLen :: Reader String Int +>calculateContentLen = do +> content <- ask +> return (length content); +> +>-- Calls calculateContentLen after adding a prefix to the Reader content. +>calculateModifiedContentLen :: Reader String Int +>calculateModifiedContentLen = local ("Prefix " ++) calculateContentLen +> +>main = do +> let s = "12345"; +> let modifiedLen = runReader calculateModifiedContentLen s +> let len = runReader calculateContentLen s +> putStrLn $ "Modified 's' length: " ++ (show modifiedLen) +> putStrLn $ "Original 's' length: " ++ (show len) +-} + +{- $ReaderTExample + +Now you are thinking: 'Wow, what a great monad! I wish I could use +Reader functionality in MyFavoriteComplexMonad!'. Don't worry. +This can be easy done with the 'ReaderT' monad transformer. +This example shows how to combine @ReaderT@ with the IO monad. + +>-- The Reader/IO combined monad, where Reader stores a string. +>printReaderContent :: ReaderT String IO () +>printReaderContent = do +> content <- ask +> liftIO $ putStrLn ("The Reader Content: " ++ content) +> +>main = do +> runReaderT printReaderContent "Some Content" +-} diff --git a/Control/Monad/Reader/Class.hs b/Control/Monad/Reader/Class.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Reader/Class.hs @@ -0,0 +1,74 @@ +{-# OPTIONS -fallow-undecidable-instances #-} +{- | +Module : Control.Monad.Reader.Class +Copyright : (c) Andy Gill 2001, + (c) Oregon Graduate Institute of Science and Technology 2001, + (c) Jeff Newbern 2003-2007, + (c) Andriy Palamarchuk 2007 +License : BSD-style (see the file libraries/base/LICENSE) + +Maintainer : libraries@haskell.org +Stability : experimental +Portability : non-portable (multi-param classes, functional dependencies) + +[Computation type:] Computations which read values from a shared environment. + +[Binding strategy:] Monad values are functions from the environment to a value. +The bound function is applied to the bound value, and both have access +to the shared environment. + +[Useful for:] Maintaining variable bindings, or other shared environment. + +[Zero and plus:] None. + +[Example type:] @'Reader' [(String,Value)] a@ + +The 'Reader' monad (also called the Environment monad). +Represents a computation, which can read values from +a shared environment, pass values from function to function, +and execute sub-computations in a modified environment. +Using 'Reader' monad for such computations is often clearer and easier +than using the 'Control.Monad.State.State' monad. + + Inspired by the paper + /Functional Programming with Overloading and + Higher-Order Polymorphism/, + Mark P Jones () + Advanced School of Functional Programming, 1995. +-} + +module Control.Monad.Reader.Class ( + MonadReader(..), + asks, + ) where + +{- | +See examples in "Control.Monad.Reader". +Note, the partially applied function type @(->) r@ is a simple reader monad. +See the @instance@ declaration below. +-} +class (Monad m) => MonadReader r m | m -> r where + -- | Retrieves the monad environment. + ask :: m r + {- | Executes a computation in a modified environment. Parameters: + + * The function to modify the environment. + + * @Reader@ to run. + + * The resulting @Reader@. + -} + local :: (r -> r) -> m a -> m a + +{- | +Retrieves a function of the current environment. Parameters: + +* The selector function to apply to the environment. + +See an example in "Control.Monad.Reader". +-} +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 --- a/Control/Monad/State.hs +++ b/Control/Monad/State.hs @@ -1,338 +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 () --- 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 () +-- 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 Prelude - -import Control.Monad -import Control.Monad.Fix -import Control.Monad.Trans -import Control.Monad.Reader -import Control.Monad.Writer - --- --------------------------------------------------------------------------- --- | /get/ returns the state from the internals of the monad. --- --- /put/ replaces the state inside the monad. - -class (Monad m) => MonadState s m | m -> s where - get :: m s - put :: s -> m () - --- | Monadic state transformer. --- --- Maps an old state to a new state inside a state monad. --- The old state is thrown away. --- --- > Main> :t modify ((+1) :: Int -> Int) --- > modify (...) :: (MonadState Int a) => a () --- --- This says that @modify (+1)@ acts over any --- Monad that is a member of the @MonadState@ class, --- with an @Int@ state. - -modify :: (MonadState s m) => (s -> s) -> m () -modify f = do - s <- get - put (f s) - --- | Gets specific component of the state, using a projection function --- supplied. - -gets :: (MonadState s m) => (s -> a) -> m a -gets f = do - s <- get - return (f s) - --- --------------------------------------------------------------------------- --- | A parameterizable state monad where /s/ is the type of the state --- to carry and /a/ is the type of the /return value/. - -newtype State s a = State { runState :: s -> (a, s) } - --- The State Monad structure is parameterized over just the state. - -instance Functor (State s) where - fmap f m = State $ \s -> let - (a, s') = runState m s - in (f a, s') - -instance Monad (State s) where - return a = State $ \s -> (a, s) - m >>= k = State $ \s -> let - (a, s') = runState m s - in runState (k a) s' - -instance MonadFix (State s) where - mfix f = State $ \s -> let (a, s') = runState (f a) s in (a, s') - -instance MonadState s (State s) where - get = State $ \s -> (s, s) - put s = State $ \_ -> ((), s) - --- |Evaluate this state monad with the given initial state,throwing --- away the final state. Very much like @fst@ composed with --- @runstate@. - -evalState :: State s a -- ^The state to evaluate - -> s -- ^An initial value - -> a -- ^The return value of the state application -evalState m s = fst (runState m s) - --- |Execute this state and return the new state, throwing away the --- return value. Very much like @snd@ composed with --- @runstate@. - -execState :: State s a -- ^The state to evaluate - -> s -- ^An initial value - -> s -- ^The new state -execState m s = snd (runState m s) - --- |Map a stateful computation from one (return value, state) pair to --- another. For instance, to convert numberTree from a function that --- returns a tree to a function that returns the sum of the numbered --- tree (see the Examples section for numberTree and sumTree) you may --- write: --- --- > sumNumberedTree :: (Eq a) => Tree a -> State (Table a) Int --- > sumNumberedTree = mapState (\ (t, tab) -> (sumTree t, tab)) . numberTree - -mapState :: ((a, s) -> (b, s)) -> State s a -> State s b -mapState f m = State $ f . runState m - --- |Apply this function to this state and return the resulting state. -withState :: (s -> s) -> State s a -> State s a -withState f m = State $ runState m . f - --- --------------------------------------------------------------------------- --- | A parameterizable state monad for encapsulating an inner --- monad. --- --- The StateT Monad structure is parameterized over two things: --- --- * s - The state. --- --- * m - The inner monad. --- --- Here are some examples of use: --- --- (Parser from ParseLib with Hugs) --- --- > type Parser a = StateT String [] a --- > ==> StateT (String -> [(a,String)]) --- --- For example, item can be written as: --- --- > item = do (x:xs) <- get --- > put xs --- > return x --- > --- > type BoringState s a = StateT s Indentity a --- > ==> StateT (s -> Identity (a,s)) --- > --- > type StateWithIO s a = StateT s IO a --- > ==> StateT (s -> IO (a,s)) --- > --- > type StateWithErr s a = StateT s Maybe a --- > ==> StateT (s -> Maybe (a,s)) - -newtype StateT s m a = StateT { runStateT :: s -> m (a,s) } - -instance (Monad m) => Functor (StateT s m) where - fmap f m = StateT $ \s -> do - (x, s') <- runStateT m s - return (f x, s') - -instance (Monad m) => Monad (StateT s m) where - return a = StateT $ \s -> return (a, s) - m >>= k = StateT $ \s -> do - (a, s') <- runStateT m s - runStateT (k a) s' - fail str = StateT $ \_ -> fail str - -instance (MonadPlus m) => MonadPlus (StateT s m) where - mzero = StateT $ \_ -> mzero - m `mplus` n = StateT $ \s -> runStateT m s `mplus` runStateT n s - -instance (MonadFix m) => MonadFix (StateT s m) where - mfix f = StateT $ \s -> mfix $ \ ~(a, _) -> runStateT (f a) s - -instance (Monad m) => MonadState s (StateT s m) where - get = StateT $ \s -> return (s, s) - put s = StateT $ \_ -> return ((), s) - -instance MonadTrans (StateT s) where - lift m = StateT $ \s -> do - a <- m - return (a, s) - -instance (MonadIO m) => MonadIO (StateT s m) where - liftIO = lift . liftIO - --- Needs -fallow-undecidable-instances -instance (MonadReader r m) => MonadReader r (StateT s m) where - ask = lift ask - local f m = StateT $ \s -> local f (runStateT m s) - --- Needs -fallow-undecidable-instances -instance (MonadWriter w m) => MonadWriter w (StateT s m) where - tell = lift . tell - listen m = StateT $ \s -> do - ((a, s'), w) <- listen (runStateT m s) - return ((a, w), s') - pass m = StateT $ \s -> pass $ do - ((a, f), s') <- runStateT m s - return ((a, s'), f) - --- |Similar to 'evalState' -evalStateT :: (Monad m) => StateT s m a -> s -> m a -evalStateT m s = do - (a, _) <- runStateT m s - return a - --- |Similar to 'execState' -execStateT :: (Monad m) => StateT s m a -> s -> m s -execStateT m s = do - (_, s') <- runStateT m s - return s' - --- |Similar to 'mapState' -mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b -mapStateT f m = StateT $ f . runStateT m - --- |Similar to 'withState' -withStateT :: (s -> s) -> StateT s m a -> StateT s m a -withStateT f m = StateT $ runStateT m . f - --- --------------------------------------------------------------------------- --- MonadState instances for other monad transformers - --- Needs -fallow-undecidable-instances -instance (MonadState s m) => MonadState s (ReaderT r m) where - get = lift get - put = lift . put - --- Needs -fallow-undecidable-instances -instance (Monoid w, MonadState s m) => MonadState s (WriterT w m) where - get = lift get - put = lift . put +import Control.Monad.State.Lazy --- --------------------------------------------------------------------------- --- $examples --- A function to increment a counter. Taken from the paper --- /Generalising Monads to Arrows/, John --- Hughes (), November 1998: --- --- > tick :: State Int Int --- > tick = do n <- get --- > put (n+1) --- > return n --- --- Add one to the given number using the state monad: --- --- > plusOne :: Int -> Int --- > plusOne n = execState tick n --- --- A contrived addition example. Works only with positive numbers: --- --- > plus :: Int -> Int -> Int --- > plus n x = execState (sequence $ replicate n tick) x --- --- An example from /The Craft of Functional Programming/, Simon --- Thompson (), --- Addison-Wesley 1999: \"Given an arbitrary tree, transform it to a --- tree of integers in which the original elements are replaced by --- natural numbers, starting from 0. The same element has to be --- replaced by the same number at every occurrence, and when we meet --- an as-yet-unvisited element we have to find a \'new\' number to match --- it with:\" --- --- > data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show, Eq) --- > type Table a = [a] --- --- > numberTree :: Eq a => Tree a -> State (Table a) (Tree Int) --- > numberTree Nil = return Nil --- > numberTree (Node x t1 t2) --- > = do num <- numberNode x --- > nt1 <- numberTree t1 --- > nt2 <- numberTree t2 --- > return (Node num nt1 nt2) --- > where --- > numberNode :: Eq a => a -> State (Table a) Int --- > numberNode x --- > = do table <- get --- > (newTable, newPos) <- return (nNode x table) --- > put newTable --- > return newPos --- > nNode:: (Eq a) => a -> Table a -> (Table a, Int) --- > nNode x table --- > = case (findIndexInList (== x) table) of --- > Nothing -> (table ++ [x], length table) --- > Just i -> (table, i) --- > findIndexInList :: (a -> Bool) -> [a] -> Maybe Int --- > findIndexInList = findIndexInListHelp 0 --- > findIndexInListHelp _ _ [] = Nothing --- > findIndexInListHelp count f (h:t) --- > = if (f h) --- > then Just count --- > else findIndexInListHelp (count+1) f t --- --- numTree applies numberTree with an initial state: --- --- > numTree :: (Eq a) => Tree a -> Tree Int --- > numTree t = evalState (numberTree t) [] --- --- > testTree = Node "Zero" (Node "One" (Node "Two" Nil Nil) (Node "One" (Node "Zero" Nil Nil) Nil)) Nil --- > numTree testTree => Node 0 (Node 1 (Node 2 Nil Nil) (Node 1 (Node 0 Nil Nil) Nil)) Nil --- --- sumTree is a little helper function that does not use the State monad: --- --- > sumTree :: (Num a) => Tree a -> a --- > sumTree Nil = 0 --- > sumTree (Node e t1 t2) = e + (sumTree t1) + (sumTree t2) diff --git a/Control/Monad/State/Class.hs b/Control/Monad/State/Class.hs new file mode 100644 --- /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 () +-- 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 --- /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 () +-- 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 (), November 1998: +-- +-- > tick :: State Int Int +-- > tick = do n <- get +-- > put (n+1) +-- > return n +-- +-- Add one to the given number using the state monad: +-- +-- > plusOne :: Int -> Int +-- > plusOne n = execState tick n +-- +-- A contrived addition example. Works only with positive numbers: +-- +-- > plus :: Int -> Int -> Int +-- > plus n x = execState (sequence $ replicate n tick) x +-- +-- An example from /The Craft of Functional Programming/, Simon +-- Thompson (), +-- Addison-Wesley 1999: \"Given an arbitrary tree, transform it to a +-- tree of integers in which the original elements are replaced by +-- natural numbers, starting from 0. The same element has to be +-- replaced by the same number at every occurrence, and when we meet +-- an as-yet-unvisited element we have to find a \'new\' number to match +-- it with:\" +-- +-- > data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show, Eq) +-- > type Table a = [a] +-- +-- > numberTree :: Eq a => Tree a -> State (Table a) (Tree Int) +-- > numberTree Nil = return Nil +-- > numberTree (Node x t1 t2) +-- > = do num <- numberNode x +-- > nt1 <- numberTree t1 +-- > nt2 <- numberTree t2 +-- > return (Node num nt1 nt2) +-- > where +-- > numberNode :: Eq a => a -> State (Table a) Int +-- > numberNode x +-- > = do table <- get +-- > (newTable, newPos) <- return (nNode x table) +-- > put newTable +-- > return newPos +-- > nNode:: (Eq a) => a -> Table a -> (Table a, Int) +-- > nNode x table +-- > = case (findIndexInList (== x) table) of +-- > Nothing -> (table ++ [x], length table) +-- > Just i -> (table, i) +-- > findIndexInList :: (a -> Bool) -> [a] -> Maybe Int +-- > findIndexInList = findIndexInListHelp 0 +-- > findIndexInListHelp _ _ [] = Nothing +-- > findIndexInListHelp count f (h:t) +-- > = if (f h) +-- > then Just count +-- > else findIndexInListHelp (count+1) f t +-- +-- numTree applies numberTree with an initial state: +-- +-- > numTree :: (Eq a) => Tree a -> Tree Int +-- > numTree t = evalState (numberTree t) [] +-- +-- > testTree = Node "Zero" (Node "One" (Node "Two" Nil Nil) (Node "One" (Node "Zero" Nil Nil) Nil)) Nil +-- > numTree testTree => Node 0 (Node 1 (Node 2 Nil Nil) (Node 1 (Node 0 Nil Nil) Nil)) Nil +-- +-- sumTree is a little helper function that does not use the State monad: +-- +-- > sumTree :: (Num a) => Tree a -> a +-- > sumTree Nil = 0 +-- > sumTree (Node e t1 t2) = e + (sumTree t1) + (sumTree t2) diff --git a/Control/Monad/State/Strict.hs b/Control/Monad/State/Strict.hs new file mode 100644 --- /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 () +-- 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 (), November 1998: +-- +-- > tick :: State Int Int +-- > tick = do n <- get +-- > put (n+1) +-- > return n +-- +-- Add one to the given number using the state monad: +-- +-- > plusOne :: Int -> Int +-- > plusOne n = execState tick n +-- +-- A contrived addition example. Works only with positive numbers: +-- +-- > plus :: Int -> Int -> Int +-- > plus n x = execState (sequence $ replicate n tick) x +-- +-- An example from /The Craft of Functional Programming/, Simon +-- Thompson (), +-- Addison-Wesley 1999: \"Given an arbitrary tree, transform it to a +-- tree of integers in which the original elements are replaced by +-- natural numbers, starting from 0. The same element has to be +-- replaced by the same number at every occurrence, and when we meet +-- an as-yet-unvisited element we have to find a \'new\' number to match +-- it with:\" +-- +-- > data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show, Eq) +-- > type Table a = [a] +-- +-- > numberTree :: Eq a => Tree a -> State (Table a) (Tree Int) +-- > numberTree Nil = return Nil +-- > numberTree (Node x t1 t2) +-- > = do num <- numberNode x +-- > nt1 <- numberTree t1 +-- > nt2 <- numberTree t2 +-- > return (Node num nt1 nt2) +-- > where +-- > numberNode :: Eq a => a -> State (Table a) Int +-- > numberNode x +-- > = do table <- get +-- > (newTable, newPos) <- return (nNode x table) +-- > put newTable +-- > return newPos +-- > nNode:: (Eq a) => a -> Table a -> (Table a, Int) +-- > nNode x table +-- > = case (findIndexInList (== x) table) of +-- > Nothing -> (table ++ [x], length table) +-- > Just i -> (table, i) +-- > findIndexInList :: (a -> Bool) -> [a] -> Maybe Int +-- > findIndexInList = findIndexInListHelp 0 +-- > findIndexInListHelp _ _ [] = Nothing +-- > findIndexInListHelp count f (h:t) +-- > = if (f h) +-- > then Just count +-- > else findIndexInListHelp (count+1) f t +-- +-- numTree applies numberTree with an initial state: +-- +-- > numTree :: (Eq a) => Tree a -> Tree Int +-- > numTree t = evalState (numberTree t) [] +-- +-- > testTree = Node "Zero" (Node "One" (Node "Two" Nil Nil) (Node "One" (Node "Zero" Nil Nil) Nil)) Nil +-- > numTree testTree => Node 0 (Node 1 (Node 2 Nil Nil) (Node 1 (Node 0 Nil Nil) Nil)) Nil +-- +-- sumTree is a little helper function that does not use the State monad: +-- +-- > sumTree :: (Num a) => Tree a -> a +-- > sumTree Nil = 0 +-- > sumTree (Node e t1 t2) = e + (sumTree t1) + (sumTree t2) diff --git a/Control/Monad/Trans.hs b/Control/Monad/Trans.hs --- a/Control/Monad/Trans.hs +++ b/Control/Monad/Trans.hs @@ -2,29 +2,27 @@ -- | -- 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 () --- Advanced School of Functional Programming, 1995. +-- Inspired by the paper +-- /Functional Programming with Overloading and +-- Higher-Order Polymorphism/, +-- Mark P Jones () +-- Advanced School of Functional Programming, 1995. ----------------------------------------------------------------------------- module Control.Monad.Trans ( - MonadTrans(..), - MonadIO(..), + MonadTrans(..), + MonadIO(..), ) where -import Prelude - import System.IO -- --------------------------------------------------------------------------- @@ -35,10 +33,10 @@ -- 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 --- a/Control/Monad/Writer.hs +++ b/Control/Monad/Writer.hs @@ -5,168 +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 () --- Advanced School of Functional Programming, 1995. +-- Inspired by the paper +-- /Functional Programming with Overloading and +-- Higher-Order Polymorphism/, +-- Mark P Jones () +-- Advanced School of Functional Programming, 1995. ----------------------------------------------------------------------------- module Control.Monad.Writer ( - MonadWriter(..), - listens, - censor, - Writer(..), - execWriter, - mapWriter, - WriterT(..), - execWriterT, - mapWriterT, - module Control.Monad, - module Control.Monad.Fix, - module Control.Monad.Trans, - module Data.Monoid, + module Control.Monad.Writer.Lazy ) where -import Prelude - -import Control.Monad -import Control.Monad.Fix -import Control.Monad.Trans -import Control.Monad.Reader -import Data.Monoid - --- --------------------------------------------------------------------------- --- MonadWriter class --- --- tell is like tell on the MUD's it shouts to monad --- what you want to be heard. The monad carries this 'packet' --- upwards, merging it if needed (hence the Monoid requirement)} --- --- listen listens to a monad acting, and returns what the monad "said". --- --- pass lets you provide a writer transformer which changes internals of --- the written object. - -class (Monoid w, Monad m) => MonadWriter w m | m -> w where - tell :: w -> m () - listen :: m a -> m (a, w) - pass :: m (a, w -> w) -> m a - -listens :: (MonadWriter w m) => (w -> b) -> m a -> m (a, b) -listens f m = do - (a, w) <- listen m - return (a, f w) - -censor :: (MonadWriter w m) => (w -> w) -> m a -> m a -censor f m = pass $ do - a <- m - return (a, f) - --- --------------------------------------------------------------------------- --- Our parameterizable writer monad - -newtype Writer w a = Writer { runWriter :: (a, w) } - - -instance Functor (Writer w) where - fmap f m = Writer $ let (a, w) = runWriter m in (f a, w) - -instance (Monoid w) => Monad (Writer w) where - return a = Writer (a, mempty) - m >>= k = Writer $ let - (a, w) = runWriter m - (b, w') = runWriter (k a) - in (b, w `mappend` w') - -instance (Monoid w) => MonadFix (Writer w) where - mfix m = Writer $ let (a, w) = runWriter (m a) in (a, w) - -instance (Monoid w) => MonadWriter w (Writer w) where - tell w = Writer ((), w) - listen m = Writer $ let (a, w) = runWriter m in ((a, w), w) - pass m = Writer $ let ((a, f), w) = runWriter m in (a, f w) - - -execWriter :: Writer w a -> w -execWriter m = snd (runWriter m) - -mapWriter :: ((a, w) -> (b, w')) -> Writer w a -> Writer w' b -mapWriter f m = Writer $ f (runWriter m) - --- --------------------------------------------------------------------------- --- Our parameterizable writer monad, with an inner monad - -newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } - - -instance (Monad m) => Functor (WriterT w m) where - fmap f m = WriterT $ do - (a, w) <- runWriterT m - return (f a, w) - -instance (Monoid w, Monad m) => Monad (WriterT w m) where - return a = WriterT $ return (a, mempty) - m >>= k = WriterT $ do - (a, w) <- runWriterT m - (b, w') <- runWriterT (k a) - return (b, w `mappend` w') - fail msg = WriterT $ fail msg - -instance (Monoid w, MonadPlus m) => MonadPlus (WriterT w m) where - mzero = WriterT mzero - m `mplus` n = WriterT $ runWriterT m `mplus` runWriterT n - -instance (Monoid w, MonadFix m) => MonadFix (WriterT w m) where - mfix m = WriterT $ mfix $ \ ~(a, _) -> runWriterT (m a) - -instance (Monoid w, Monad m) => MonadWriter w (WriterT w m) where - tell w = WriterT $ return ((), w) - listen m = WriterT $ do - (a, w) <- runWriterT m - return ((a, w), w) - pass m = WriterT $ do - ((a, f), w) <- runWriterT m - return (a, f w) - -instance (Monoid w) => MonadTrans (WriterT w) where - lift m = WriterT $ do - a <- m - return (a, mempty) - -instance (Monoid w, MonadIO m) => MonadIO (WriterT w m) where - liftIO = lift . liftIO - --- This instance needs -fallow-undecidable-instances, because --- it does not satisfy the coverage condition -instance (Monoid w, MonadReader r m) => MonadReader r (WriterT w m) where - ask = lift ask - local f m = WriterT $ local f (runWriterT m) - - -execWriterT :: Monad m => WriterT w m a -> m w -execWriterT m = do - (_, w) <- runWriterT m - return w - -mapWriterT :: (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b -mapWriterT f m = WriterT $ f (runWriterT m) - --- --------------------------------------------------------------------------- --- MonadWriter instances for other monad transformers +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 --- /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 () +-- 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 --- /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 () +-- 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 --- /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 () +-- 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 --- 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 @@ - 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/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,6 @@ +module Main (main) where + import Distribution.Simple + +main :: IO () main = defaultMain diff --git a/mtl.cabal b/mtl.cabal --- a/mtl.cabal +++ b/mtl.cabal @@ -1,25 +1,43 @@ -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.1.0.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 (), Advanced School - of Functional Programming, 1995. + A monad transformer library, inspired by the paper "Functional + Programming with Overloading and Higher-Order Polymorphism", + by Mark P Jones (), + Advanced School of Functional Programming, 1995. +build-type: Simple +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 -extensions: MultiParamTypeClasses, FunctionalDependencies + 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, + FlexibleInstances, + TypeSynonymInstances +