monads-tf-0.1.0.1/0000755000000000000000000000000012025430717011726 5ustar0000000000000000monads-tf-0.1.0.1/Setup.hs0000644000000000000000000000005612025430717013363 0ustar0000000000000000import Distribution.Simple main = defaultMain monads-tf-0.1.0.1/LICENSE0000644000000000000000000000310712025430717012734 0ustar0000000000000000The Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. monads-tf-0.1.0.1/monads-tf.cabal0000644000000000000000000000260212025430717014602 0ustar0000000000000000name: monads-tf version: 0.1.0.1 license: BSD3 license-file: LICENSE author: Andy Gill maintainer: Ross Paterson category: Control synopsis: Monad classes, using type families description: Monad classes using type families, with instances for various monad transformers, inspired by the paper /Functional Programming with Overloading and Higher-Order Polymorphism/, by Mark P Jones, in /Advanced School of Functional Programming/, 1995 (). . This package is almost a compatible replacement for the @mtl-tf@ package. build-type: Simple cabal-version: >= 1.2.3 library exposed-modules: 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 < 6, transformers >= 0.2.0.0 && < 0.4 extensions: FlexibleContexts TypeFamilies monads-tf-0.1.0.1/Control/0000755000000000000000000000000012025430717013346 5ustar0000000000000000monads-tf-0.1.0.1/Control/Monad/0000755000000000000000000000000012025430717014404 5ustar0000000000000000monads-tf-0.1.0.1/Control/Monad/List.hs0000644000000000000000000000127212025430717015655 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Control.Monad.List -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : portable -- -- The List monad. -- ----------------------------------------------------------------------------- module Control.Monad.List ( ListT(..), mapListT, module Control.Monad, module Control.Monad.Trans, ) where import Control.Monad import Control.Monad.Trans import Control.Monad.Trans.List monads-tf-0.1.0.1/Control/Monad/State.hs0000644000000000000000000000155212025430717016023 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Control.Monad.State -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : non-portable (type families) -- -- 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. ----------------------------------------------------------------------------- module Control.Monad.State ( module Control.Monad.State.Lazy ) where import Control.Monad.State.Lazy monads-tf-0.1.0.1/Control/Monad/Reader.hs0000644000000000000000000001076612025430717016154 0ustar0000000000000000{- | 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 LICENSE) Maintainer : ross@soi.city.ac.uk Stability : experimental Portability : non-portable (type families) [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 ( -- * MonadReader class MonadReader(..), asks, -- * The Reader monad Reader, runReader, mapReader, withReader, -- * The ReaderT monad transformer 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.Reader.Class import Control.Monad.Trans.Reader ( Reader, runReader, mapReader, withReader, ReaderT(..), mapReaderT, withReaderT) import Control.Monad.Trans import Control.Monad import Control.Monad.Fix {- $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" -} monads-tf-0.1.0.1/Control/Monad/Error.hs0000644000000000000000000001227512025430717016040 0ustar0000000000000000{- | Module : Control.Monad.Error Copyright : (c) Michael Weber 2001, (c) Jeff Newbern 2003-2006, (c) Andriy Palamarchuk 2006 License : BSD-style (see the file LICENSE) Maintainer : ross@soi.city.ac.uk Stability : experimental Portability : non-portable (type families) [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 ( -- * Monads with error handling MonadError(..), Error, -- * The ErrorT monad transformer ErrorT(..), mapErrorT, module Control.Monad, module Control.Monad.Fix, module Control.Monad.Trans, -- * Example 1: Custom Error Data Type -- $customErrorExample -- * Example 2: Using ErrorT Monad Transformer -- $ErrorTExample ) where import Control.Monad.Error.Class import Control.Monad.Trans import Control.Monad.Trans.Error (ErrorT(..), mapErrorT) import Control.Monad import Control.Monad.Fix import Control.Monad.Instances () {- $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. >-- 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)) -} {- $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: >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)) -} monads-tf-0.1.0.1/Control/Monad/Cont.hs0000644000000000000000000001211112025430717015637 0ustar0000000000000000{- | 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 LICENSE) Maintainer : ross@soi.city.ac.uk Stability : experimental Portability : non-portable (type families) [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 class MonadCont(..), -- * The Cont monad Cont, runCont, mapCont, withCont, -- * The ContT monad transformer ContT(..), mapContT, withContT, module Control.Monad, module Control.Monad.Trans, -- * Example 1: Simple Continuation Usage -- $simpleContExample -- * Example 2: Using @callCC@ -- $callCCExample -- * Example 3: Using @ContT@ Monad Transformer -- $ContTExample ) where import Control.Monad.Cont.Class import Control.Monad.Trans import Control.Monad.Trans.Cont import Control.Monad {- $simpleContExample Calculating length of a list continuation-style: >calculateLength :: [a] -> Cont r Int >calculateLength l = return (length l) Here we use @calculateLength@ by making it to pass its result to @print@: >main = do > runCont (calculateLength "123") print > -- result: 3 It is possible to chain 'Cont' blocks with @>>=@. >double :: Int -> Cont r Int >double n = return (n * 2) > >main = do > runCont (calculateLength "123" >>= double) print > -- result: 6 -} {- $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 'Control.Monad.Cont.Class.callCC' block, binds @exit@ to the continuation. (1) Validates @name@. This approach illustrates advantage of using 'Control.Monad.Cont.Class.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 'Control.Monad.Cont.Class.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. -} monads-tf-0.1.0.1/Control/Monad/Trans.hs0000644000000000000000000000245712025430717016037 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Trans -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : portable -- -- Classes for monad transformers. -- -- A monad transformer makes new monad out of an existing monad, such -- that computations of the old monad may be embedded in the new one. -- To construct a monad with a desired set of features, one typically -- starts with a base monad, such as @Identity@, @[]@ or 'IO', and -- applies a sequence of monad transformers. -- -- Most monad transformer modules include the special case of applying the -- transformer to @Identity@. For example, @State s@ is an abbreviation -- for @StateT s Identity@. -- -- Each monad transformer also comes with an operation @run@/XXX/ to -- unwrap the transformer, exposing a computation of the inner monad. ----------------------------------------------------------------------------- module Control.Monad.Trans ( module Control.Monad.Trans.Class, module Control.Monad.IO.Class ) where import Control.Monad.IO.Class import Control.Monad.Trans.Class monads-tf-0.1.0.1/Control/Monad/Writer.hs0000644000000000000000000000157712025430717016226 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Writer -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : non-portable (type families) -- -- 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 ( module Control.Monad.Writer.Lazy ) where import Control.Monad.Writer.Lazy monads-tf-0.1.0.1/Control/Monad/RWS.hs0000644000000000000000000000155212025430717015416 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Control.Monad.RWS -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : non-portable (type families) -- -- 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 ( module Control.Monad.RWS.Lazy ) where import Control.Monad.RWS.Lazy monads-tf-0.1.0.1/Control/Monad/Identity.hs0000644000000000000000000000242512025430717016534 0ustar0000000000000000{- | 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 LICENSE) Maintainer : ross@soi.city.ac.uk 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. -} module Control.Monad.Identity ( module Data.Functor.Identity ) where import Data.Functor.Identity monads-tf-0.1.0.1/Control/Monad/Reader/0000755000000000000000000000000012025430717015606 5ustar0000000000000000monads-tf-0.1.0.1/Control/Monad/Reader/Class.hs0000644000000000000000000001237412025430717017216 0ustar0000000000000000{- | 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 LICENSE) Maintainer : ross@soi.city.ac.uk Stability : experimental Portability : non-portable (type families) [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 import Control.Monad.Trans.Cont as Cont import Control.Monad.Trans.Error import Control.Monad.Trans.Identity import Control.Monad.Trans.List import Control.Monad.Trans.Maybe import Control.Monad.Trans.Reader (ReaderT) import qualified Control.Monad.Trans.Reader as ReaderT (ask, local) import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS (RWST, ask, local) import qualified Control.Monad.Trans.RWS.Strict as StrictRWS (RWST, ask, local) import Control.Monad.Trans.State.Lazy as Lazy import Control.Monad.Trans.State.Strict as Strict import Control.Monad.Trans.Writer.Lazy as Lazy import Control.Monad.Trans.Writer.Strict as Strict import Control.Monad.Trans import Control.Monad import Data.Monoid -- ---------------------------------------------------------------------------- -- class MonadReader -- asks for the internal (non-mutable) state. -- | 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 m where type EnvType m -- | Retrieves the monad environment. ask :: m (EnvType m) -- | Executes a computation in a modified environment. local :: (EnvType m -> EnvType m) -- ^ The function to modify the environment. -> m a -- ^ @Reader@ to run in the modified environment. -> m a -- | Retrieves a function of the current environment. asks :: (MonadReader m) => (EnvType m -> a) -- ^ The selector function to apply to the environment. -> m a asks f = do r <- ask return (f r) -- ---------------------------------------------------------------------------- -- The partially applied function type is a simple reader monad instance MonadReader ((->) r) where type EnvType ((->) r) = r ask = id local f m = m . f instance (Monad m) => MonadReader (ReaderT r m) where type EnvType (ReaderT r m) = r ask = ReaderT.ask local = ReaderT.local instance (Monoid w, Monad m) => MonadReader (LazyRWS.RWST r w s m) where type EnvType (LazyRWS.RWST r w s m) = r ask = LazyRWS.ask local = LazyRWS.local instance (Monoid w, Monad m) => MonadReader (StrictRWS.RWST r w s m) where type EnvType (StrictRWS.RWST r w s m) = r ask = StrictRWS.ask local = StrictRWS.local -- --------------------------------------------------------------------------- -- Instances for other mtl transformers instance (MonadReader m) => MonadReader (ContT r m) where type EnvType (ContT r m) = EnvType m ask = lift ask local = Cont.liftLocal ask local instance (Error e, MonadReader m) => MonadReader (ErrorT e m) where type EnvType (ErrorT e m) = EnvType m ask = lift ask local = mapErrorT . local instance (MonadReader m) => MonadReader (IdentityT m) where type EnvType (IdentityT m) = EnvType m ask = lift ask local = mapIdentityT . local instance (MonadReader m) => MonadReader (ListT m) where type EnvType (ListT m) = EnvType m ask = lift ask local = mapListT . local instance (MonadReader m) => MonadReader (MaybeT m) where type EnvType (MaybeT m) = EnvType m ask = lift ask local = mapMaybeT . local instance (MonadReader m) => MonadReader (Lazy.StateT s m) where type EnvType (Lazy.StateT s m) = EnvType m ask = lift ask local = Lazy.mapStateT . local instance (MonadReader m) => MonadReader (Strict.StateT s m) where type EnvType (Strict.StateT s m) = EnvType m ask = lift ask local = Strict.mapStateT . local instance (Monoid w, MonadReader m) => MonadReader (Lazy.WriterT w m) where type EnvType (Lazy.WriterT w m) = EnvType m ask = lift ask local = Lazy.mapWriterT . local instance (Monoid w, MonadReader m) => MonadReader (Strict.WriterT w m) where type EnvType (Strict.WriterT w m) = EnvType m ask = lift ask local = Strict.mapWriterT . local monads-tf-0.1.0.1/Control/Monad/State/0000755000000000000000000000000012025430717015464 5ustar0000000000000000monads-tf-0.1.0.1/Control/Monad/State/Class.hs0000644000000000000000000001054512025430717017072 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : non-portable (type families) -- -- 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(..), modify, gets, ) where import Control.Monad.Trans (lift) import Control.Monad.Trans.Cont import Control.Monad.Trans.Error import Control.Monad.Trans.Identity import Control.Monad.Trans.List import Control.Monad.Trans.Maybe import Control.Monad.Trans.Reader import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS (RWST, get, put) import qualified Control.Monad.Trans.RWS.Strict as StrictRWS (RWST, get, put) import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT, get, put) import qualified Control.Monad.Trans.State.Strict as Strict (StateT, get, put) import Control.Monad.Trans.Writer.Lazy as Lazy import Control.Monad.Trans.Writer.Strict as Strict import Control.Monad import Data.Monoid -- --------------------------------------------------------------------------- -- | /get/ returns the state from the internals of the monad. -- -- /put/ replaces the state inside the monad. class (Monad m) => MonadState m where type StateType m get :: m (StateType m) put :: StateType m -> 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 m) => (StateType m -> StateType m) -> m () modify f = do s <- get put (f s) -- | Gets specific component of the state, using a projection function -- supplied. gets :: (MonadState m) => (StateType m -> a) -> m a gets f = do s <- get return (f s) instance (Monad m) => MonadState (Lazy.StateT s m) where type StateType (Lazy.StateT s m) = s get = Lazy.get put = Lazy.put instance (Monad m) => MonadState (Strict.StateT s m) where type StateType (Strict.StateT s m) = s get = Strict.get put = Strict.put instance (Monad m, Monoid w) => MonadState (LazyRWS.RWST r w s m) where type StateType (LazyRWS.RWST r w s m) = s get = LazyRWS.get put = LazyRWS.put instance (Monad m, Monoid w) => MonadState (StrictRWS.RWST r w s m) where type StateType (StrictRWS.RWST r w s m) = s get = StrictRWS.get put = StrictRWS.put -- --------------------------------------------------------------------------- -- Instances for other mtl transformers instance (MonadState m) => MonadState (ContT r m) where type StateType (ContT r m) = StateType m get = lift get put = lift . put instance (Error e, MonadState m) => MonadState (ErrorT e m) where type StateType (ErrorT e m) = StateType m get = lift get put = lift . put instance (MonadState m) => MonadState (IdentityT m) where type StateType (IdentityT m) = StateType m get = lift get put = lift . put instance (MonadState m) => MonadState (ListT m) where type StateType (ListT m) = StateType m get = lift get put = lift . put instance (MonadState m) => MonadState (MaybeT m) where type StateType (MaybeT m) = StateType m get = lift get put = lift . put instance (MonadState m) => MonadState (ReaderT r m) where type StateType (ReaderT r m) = StateType m get = lift get put = lift . put instance (Monoid w, MonadState m) => MonadState (Lazy.WriterT w m) where type StateType (Lazy.WriterT w m) = StateType m get = lift get put = lift . put instance (Monoid w, MonadState m) => MonadState (Strict.WriterT w m) where type StateType (Strict.WriterT w m) = StateType m get = lift get put = lift . put monads-tf-0.1.0.1/Control/Monad/State/Strict.hs0000644000000000000000000001042612025430717017273 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : non-portable (type families) -- -- 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. ----------------------------------------------------------------------------- module Control.Monad.State.Strict ( -- * MonadState class MonadState(..), modify, gets, -- * The State monad State, runState, evalState, execState, mapState, withState, -- * The StateT monad transformer StateT(..), evalStateT, execStateT, mapStateT, withStateT, module Control.Monad, module Control.Monad.Fix, module Control.Monad.Trans, -- * Examples -- $examples ) where import Control.Monad.State.Class import Control.Monad.Trans import Control.Monad.Trans.State.Strict (State, runState, evalState, execState, mapState, withState, StateT(..), evalStateT, execStateT, mapStateT, withStateT) import Control.Monad import Control.Monad.Fix -- --------------------------------------------------------------------------- -- $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) monads-tf-0.1.0.1/Control/Monad/State/Lazy.hs0000644000000000000000000001041612025430717016741 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : non-portable (type families) -- -- 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. ----------------------------------------------------------------------------- module Control.Monad.State.Lazy ( -- * MonadState class MonadState(..), modify, gets, -- * The State monad State, runState, evalState, execState, mapState, withState, -- * The StateT monad transformer StateT(..), evalStateT, execStateT, mapStateT, withStateT, module Control.Monad, module Control.Monad.Fix, module Control.Monad.Trans, -- * Examples -- $examples ) where import Control.Monad.State.Class import Control.Monad.Trans import Control.Monad.Trans.State.Lazy (State, runState, evalState, execState, mapState, withState, StateT(..), evalStateT, execStateT, mapStateT, withStateT) import Control.Monad import Control.Monad.Fix -- --------------------------------------------------------------------------- -- $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) monads-tf-0.1.0.1/Control/Monad/RWS/0000755000000000000000000000000012025430717015057 5ustar0000000000000000monads-tf-0.1.0.1/Control/Monad/RWS/Class.hs0000644000000000000000000000343212025430717016462 0ustar0000000000000000 ----------------------------------------------------------------------------- -- | -- 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 LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : non-portable (type families) -- -- 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 Control.Monad.Trans.Error(Error, ErrorT) import Control.Monad.Trans.Maybe(MaybeT) import Control.Monad.Trans.Identity(IdentityT) import Control.Monad.Trans.RWS.Lazy as Lazy (RWST) import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST) import Data.Monoid class (Monoid (WriterType m), MonadReader m, MonadWriter m, MonadState m) => MonadRWS m instance (Monoid w, Monad m) => MonadRWS (Lazy.RWST r w s m) instance (Monoid w, Monad m) => MonadRWS (Strict.RWST r w s m) --------------------------------------------------------------------------- -- Instances for other mtl transformers instance (Error e, MonadRWS m) => MonadRWS (ErrorT e m) instance (MonadRWS m) => MonadRWS (IdentityT m) instance (MonadRWS m) => MonadRWS (MaybeT m) monads-tf-0.1.0.1/Control/Monad/RWS/Strict.hs0000644000000000000000000000267312025430717016673 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : non-portable (type families) -- -- 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 ( -- * The RWS monad RWS, runRWS, evalRWS, execRWS, mapRWS, withRWS, -- * The RWST monad transformer RWST(..), evalRWST, execRWST, mapRWST, withRWST, -- * Strict Reader-writer-state monads module Control.Monad.RWS.Class, module Control.Monad, module Control.Monad.Fix, module Control.Monad.Trans, module Data.Monoid, ) where import Control.Monad.RWS.Class import Control.Monad.Trans import Control.Monad.Trans.RWS.Strict ( RWS, runRWS, evalRWS, execRWS, mapRWS, withRWS, RWST(..), evalRWST, execRWST, mapRWST, withRWST) import Control.Monad import Control.Monad.Fix import Data.Monoid monads-tf-0.1.0.1/Control/Monad/RWS/Lazy.hs0000644000000000000000000000266112025430717016337 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : non-portable (type families) -- -- 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 ( -- * The RWS monad RWS, runRWS, evalRWS, execRWS, mapRWS, withRWS, -- * The RWST monad transformer RWST(..), evalRWST, execRWST, mapRWST, withRWST, -- * Lazy Reader-writer-state monads module Control.Monad.RWS.Class, module Control.Monad, module Control.Monad.Fix, module Control.Monad.Trans, module Data.Monoid, ) where import Control.Monad.RWS.Class import Control.Monad.Trans import Control.Monad.Trans.RWS.Lazy ( RWS, runRWS, evalRWS, execRWS, mapRWS, withRWS, RWST(..), evalRWST, execRWST, mapRWST, withRWST) import Control.Monad import Control.Monad.Fix import Data.Monoid monads-tf-0.1.0.1/Control/Monad/Cont/0000755000000000000000000000000012025430717015307 5ustar0000000000000000monads-tf-0.1.0.1/Control/Monad/Cont/Class.hs0000644000000000000000000001162512025430717016715 0ustar0000000000000000{- | 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 LICENSE) Maintainer : ross@soi.city.ac.uk Stability : experimental Portability : non-portable (type families) [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 import Control.Monad.Trans.Cont (ContT) import qualified Control.Monad.Trans.Cont as ContT import Control.Monad.Trans.Error as Error import Control.Monad.Trans.Identity as Identity import Control.Monad.Trans.List as List import Control.Monad.Trans.Maybe as Maybe import Control.Monad.Trans.Reader as Reader import Control.Monad.Trans.RWS.Lazy as LazyRWS import Control.Monad.Trans.RWS.Strict as StrictRWS import Control.Monad.Trans.State.Lazy as LazyState import Control.Monad.Trans.State.Strict as StrictState import Control.Monad.Trans.Writer.Lazy as LazyWriter import Control.Monad.Trans.Writer.Strict as StrictWriter import Control.Monad import Data.Monoid 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 instance MonadCont (ContT r m) where callCC = ContT.callCC -- --------------------------------------------------------------------------- -- Instances for other mtl transformers instance (Error e, MonadCont m) => MonadCont (ErrorT e m) where callCC = Error.liftCallCC callCC instance (MonadCont m) => MonadCont (IdentityT m) where callCC = Identity.liftCallCC callCC instance (MonadCont m) => MonadCont (ListT m) where callCC = List.liftCallCC callCC instance (MonadCont m) => MonadCont (MaybeT m) where callCC = Maybe.liftCallCC callCC instance (MonadCont m) => MonadCont (ReaderT r m) where callCC = Reader.liftCallCC callCC instance (Monoid w, MonadCont m) => MonadCont (LazyRWS.RWST r w s m) where callCC = LazyRWS.liftCallCC' callCC instance (Monoid w, MonadCont m) => MonadCont (StrictRWS.RWST r w s m) where callCC = StrictRWS.liftCallCC' callCC instance (MonadCont m) => MonadCont (LazyState.StateT s m) where callCC = LazyState.liftCallCC' callCC instance (MonadCont m) => MonadCont (StrictState.StateT s m) where callCC = StrictState.liftCallCC' callCC instance (Monoid w, MonadCont m) => MonadCont (LazyWriter.WriterT w m) where callCC = LazyWriter.liftCallCC callCC instance (Monoid w, MonadCont m) => MonadCont (StrictWriter.WriterT w m) where callCC = StrictWriter.liftCallCC callCC monads-tf-0.1.0.1/Control/Monad/Writer/0000755000000000000000000000000012025430717015660 5ustar0000000000000000monads-tf-0.1.0.1/Control/Monad/Writer/Class.hs0000644000000000000000000001113612025430717017263 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : non-portable (type families) -- -- 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 Control.Monad import Control.Monad.Trans.Error as Error import Control.Monad.Trans.Identity as Identity import Control.Monad.Trans.Maybe as Maybe import Control.Monad.Trans.Reader import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS ( RWST, tell, listen, pass) import qualified Control.Monad.Trans.RWS.Strict as StrictRWS ( RWST, tell, listen, pass) import Control.Monad.Trans.State.Lazy as Lazy import Control.Monad.Trans.State.Strict as Strict import qualified Control.Monad.Trans.Writer.Lazy as Lazy ( WriterT, tell, listen, pass) import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT, tell, listen, pass) import Control.Monad.Trans (lift) 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 (WriterType m), Monad m) => MonadWriter m where type WriterType m tell :: WriterType m -> m () listen :: m a -> m (a, WriterType m) pass :: m (a, WriterType m -> WriterType m) -> m a listens :: (MonadWriter m) => (WriterType m -> b) -> m a -> m (a, b) listens f m = do ~(a, w) <- listen m return (a, f w) censor :: (MonadWriter m) => (WriterType m -> WriterType m) -> m a -> m a censor f m = pass $ do a <- m return (a, f) instance (Monoid w, Monad m) => MonadWriter (Lazy.WriterT w m) where type WriterType (Lazy.WriterT w m) = w tell = Lazy.tell listen = Lazy.listen pass = Lazy.pass instance (Monoid w, Monad m) => MonadWriter (Strict.WriterT w m) where type WriterType (Strict.WriterT w m) = w tell = Strict.tell listen = Strict.listen pass = Strict.pass instance (Monoid w, Monad m) => MonadWriter (LazyRWS.RWST r w s m) where type WriterType (LazyRWS.RWST r w s m) = w tell = LazyRWS.tell listen = LazyRWS.listen pass = LazyRWS.pass instance (Monoid w, Monad m) => MonadWriter (StrictRWS.RWST r w s m) where type WriterType (StrictRWS.RWST r w s m) = w tell = StrictRWS.tell listen = StrictRWS.listen pass = StrictRWS.pass -- --------------------------------------------------------------------------- -- Instances for other mtl transformers instance (Error e, MonadWriter m) => MonadWriter (ErrorT e m) where type WriterType (ErrorT e m) = WriterType m tell = lift . tell listen = Error.liftListen listen pass = Error.liftPass pass instance (MonadWriter m) => MonadWriter (IdentityT m) where type WriterType (IdentityT m) = WriterType m tell = lift . tell listen = Identity.mapIdentityT listen pass = Identity.mapIdentityT pass instance (MonadWriter m) => MonadWriter (MaybeT m) where type WriterType (MaybeT m) = WriterType m tell = lift . tell listen = Maybe.liftListen listen pass = Maybe.liftPass pass instance (MonadWriter m) => MonadWriter (ReaderT r m) where type WriterType (ReaderT r m) = WriterType m tell = lift . tell listen = mapReaderT listen pass = mapReaderT pass instance (MonadWriter m) => MonadWriter (Lazy.StateT s m) where type WriterType (Lazy.StateT s m) = WriterType m tell = lift . tell listen = Lazy.liftListen listen pass = Lazy.liftPass pass instance (MonadWriter m) => MonadWriter (Strict.StateT s m) where type WriterType (Strict.StateT s m) = WriterType m tell = lift . tell listen = Strict.liftListen listen pass = Strict.liftPass pass monads-tf-0.1.0.1/Control/Monad/Writer/Strict.hs0000644000000000000000000000266712025430717017477 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : non-portable (type families) -- -- 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 ( -- * MonadWriter class MonadWriter(..), listens, censor, -- * The Writer monad Writer, runWriter, execWriter, mapWriter, -- * The WriterT monad transformer WriterT(..), execWriterT, mapWriterT, module Control.Monad, module Control.Monad.Fix, module Control.Monad.Trans, module Data.Monoid, ) where import Control.Monad.Writer.Class import Control.Monad.Trans import Control.Monad.Trans.Writer.Strict ( Writer, runWriter, execWriter, mapWriter, WriterT(..), execWriterT, mapWriterT) import Control.Monad import Control.Monad.Fix import Data.Monoid monads-tf-0.1.0.1/Control/Monad/Writer/Lazy.hs0000644000000000000000000000265712025430717017145 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : non-portable (type families) -- -- 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 ( -- * MonadWriter class MonadWriter(..), listens, censor, -- * The Writer monad Writer, runWriter, execWriter, mapWriter, -- * The WriterT monad transformer WriterT(..), execWriterT, mapWriterT, module Control.Monad, module Control.Monad.Fix, module Control.Monad.Trans, module Data.Monoid, ) where import Control.Monad.Writer.Class import Control.Monad.Trans import Control.Monad.Trans.Writer.Lazy ( Writer, runWriter, execWriter, mapWriter, WriterT(..), execWriterT, mapWriterT) import Control.Monad import Control.Monad.Fix import Data.Monoid monads-tf-0.1.0.1/Control/Monad/Error/0000755000000000000000000000000012025430717015475 5ustar0000000000000000monads-tf-0.1.0.1/Control/Monad/Error/Class.hs0000644000000000000000000001370012025430717017077 0ustar0000000000000000{- | 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 LICENSE) Maintainer : ross@soi.city.ac.uk Stability : experimental Portability : non-portable (type families) [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:] @'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 import Control.Monad.Trans.Error (Error(..), ErrorT) import qualified Control.Monad.Trans.Error as ErrorT (throwError, catchError) import Control.Monad.Trans.Identity as Identity import Control.Monad.Trans.List as List import Control.Monad.Trans.Maybe as Maybe import Control.Monad.Trans.Reader as Reader import Control.Monad.Trans.RWS.Lazy as LazyRWS import Control.Monad.Trans.RWS.Strict as StrictRWS import Control.Monad.Trans.State.Lazy as LazyState import Control.Monad.Trans.State.Strict as StrictState import Control.Monad.Trans.Writer.Lazy as LazyWriter import Control.Monad.Trans.Writer.Strict as StrictWriter import Control.Monad.Trans import qualified Control.Exception import Control.Monad import Control.Monad.Instances () import Data.Monoid import System.IO {- | 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 m where type ErrorType m -- | Is used within a monadic computation to begin exception processing. throwError :: ErrorType m -> 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 -> (ErrorType m -> m a) -> m a instance MonadError IO where type ErrorType IO = IOError throwError = ioError catchError = Control.Exception.catch -- --------------------------------------------------------------------------- -- Our parameterizable error monad instance (Error e) => MonadError (Either e) where type ErrorType (Either e) = e throwError = Left Left l `catchError` h = h l Right r `catchError` _ = Right r instance (Monad m, Error e) => MonadError (ErrorT e m) where type ErrorType (ErrorT e m) = e throwError = ErrorT.throwError catchError = ErrorT.catchError -- --------------------------------------------------------------------------- -- Instances for other mtl transformers instance (MonadError m) => MonadError (IdentityT m) where type ErrorType (IdentityT m) = ErrorType m throwError = lift . throwError catchError = Identity.liftCatch catchError instance (MonadError m) => MonadError (ListT m) where type ErrorType (ListT m) = ErrorType m throwError = lift . throwError catchError = List.liftCatch catchError instance (MonadError m) => MonadError (MaybeT m) where type ErrorType (MaybeT m) = ErrorType m throwError = lift . throwError catchError = Maybe.liftCatch catchError instance (MonadError m) => MonadError (ReaderT r m) where type ErrorType (ReaderT r m) = ErrorType m throwError = lift . throwError catchError = Reader.liftCatch catchError instance (Monoid w, MonadError m) => MonadError (LazyRWS.RWST r w s m) where type ErrorType (LazyRWS.RWST r w s m) = ErrorType m throwError = lift . throwError catchError = LazyRWS.liftCatch catchError instance (Monoid w, MonadError m) => MonadError (StrictRWS.RWST r w s m) where type ErrorType (StrictRWS.RWST r w s m) = ErrorType m throwError = lift . throwError catchError = StrictRWS.liftCatch catchError instance (MonadError m) => MonadError (LazyState.StateT s m) where type ErrorType (LazyState.StateT s m) = ErrorType m throwError = lift . throwError catchError = LazyState.liftCatch catchError instance (MonadError m) => MonadError (StrictState.StateT s m) where type ErrorType (StrictState.StateT s m) = ErrorType m throwError = lift . throwError catchError = StrictState.liftCatch catchError instance (Monoid w, MonadError m) => MonadError (LazyWriter.WriterT w m) where type ErrorType (LazyWriter.WriterT w m) = ErrorType m throwError = lift . throwError catchError = LazyWriter.liftCatch catchError instance (Monoid w, MonadError m) => MonadError (StrictWriter.WriterT w m) where type ErrorType (StrictWriter.WriterT w m) = ErrorType m throwError = lift . throwError catchError = StrictWriter.liftCatch catchError