a huge commit.
overall changes
1. moved the new monad transformer library to its own branch as simon suggested
2. attempted to integrate it with the make system, which mostly works,
except "make install" tries to add the package _before_ copying the library files to
their location. i don't understand what is going wrong, could someone take a look?
library specific
3. the library is now using the standard "MonadFix" class as sugested by ross.
the instances are defined in each transformer file.
4. moved "Utils.hs" file to a "Private" directory to indicate that programs should not use it
5. removed the file "Types.hs", now the type for each transformer is defined in the relevant file.
6. added a few tests
+++ /dev/null
-module Control.Monad.X.Cont (Cont,runCont,module T) where
-
-import Control.Monad.X.Identity
-import qualified Control.Monad.X.ContT as C
-import Control.Monad.X.Trans as T
-
-type Cont r = C.ContT r Identity
-
-runCont :: Cont a a -> a
-runCont m = runIdentity (C.runCont m)
-
-
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- 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.X.ContT (
- ContT,
- runCont,
- runContT,
- mapContT,
- withContT,
- module T
- ) where
-
-import Prelude (Functor(..),Monad(..),(.),fst,error)
-import Control.Monad(liftM,MonadPlus(..))
-
-import Control.Monad.X.Trans as T
-import Control.Monad.X.Utils
-import Control.Monad.X.Types(ContT(..))
-
-
--- unfiinished
-
-
-instance MonadTrans (ContT r) where
- lift m = C (m >>=)
-
-instance HasBaseMonad m n => HasBaseMonad (ContT r m) n where
- inBase = inBase'
-
-instance (Monad m) => Functor (ContT r m) where
- fmap = liftM
-
-instance (Monad m) => Monad (ContT r m) where
- return = return'
- m >>= k = C (\c -> m $$ (\a -> k a $$ c))
-
-
-runCont :: Monad m => ContT r m r -> m r
-runCont m = m $$ return
-
-runContT = ($$)
-
-mapContT :: (m r -> m r) -> ContT r m a -> ContT r m a
-mapContT f m = C (f . (m $$))
-
-withContT :: ((b -> m r) -> (a -> m r)) -> ContT r m a -> ContT r m b
-withContT f m = C ((m $$) . f)
-
-($$) = unC
-
--- (a -> (e -> m a)) -> e -> m a
-
-instance (MonadReader r' m) => MonadReader r' (ContT r m) where
- ask = ask'
- local f m = C (\k -> do r <- ask
- local f (m $$ (\a -> localSet r (k a))))
-
-
-instance (MonadWriter w m) => MonadWriter w (ContT r m) where
- tell = tell'
- listen = error "listen: continuations after writer not implemenetd (yet?)"
-
-instance (MonadState s m) => MonadState s (ContT r m) where
- get = get'
- put = put'
-
-instance (MonadError e m) => MonadError e (ContT r m) where
- throwError = throwError'
- catchError = catchError2' C ($$)
-
-instance MonadPlus m => MonadPlus (ContT r m) where
- mzero = mzero
- mplus = mplus2' C ($$)
-
-instance (Monad m) => MonadCont (ContT r m) where
- callCC f = C (\c -> f (\a -> C (\_ -> c a)) $$ c)
-
-
-
+++ /dev/null
-module Control.Monad.X.Error (Error, runError, module T) where
-
-import Control.Monad.X.Identity
-import qualified Control.Monad.X.ErrorT as E
-import Control.Monad.X.Trans as T
-
-type Error e = E.ErrorT e Identity
-
-runError :: Error e a -> Either e a
-runError m = runIdentity (E.runError m)
-
-
+++ /dev/null
-module Control.Monad.X.ErrorT (
- ErrorT,
- runError,
- runErrorT,
- mapErrorT,
- module T
- ) where
-
-import Prelude(Functor(..),Monad(..),Either(..),either,(.),id,error)
-
-import Control.Monad(MonadPlus(..),liftM)
-
-import Control.Monad.X.Trans as T
-import Control.Monad.X.Utils
-import Control.Monad.X.Types(ErrorT(..))
-
-
-instance MonadTrans (ErrorT e) where
- lift m = E (liftM Right m)
-
-instance HasBaseMonad m n => HasBaseMonad (ErrorT e m) n where
- inBase = inBase'
-
-instance (Monad m) => Functor (ErrorT e m) where
- fmap = liftM
-
-instance (Monad m) => Monad (ErrorT e m) where
- return = return'
- m >>= k = E (do a <- unE m
- case a of
- Left l -> return (Left l)
- Right r -> unE (k r))
- fail = fail' -- use 'throwErorr' to throw errors.
-
-
---------------------------------------------------------------------------------
-
-runError = unE
-runErrorT = unE
-
-mapErrorT :: (m (Either e a) -> n (Either e' b)) -> ErrorT e m a -> ErrorT e' n b
-mapErrorT f m = E (f (unE m))
-
---------------------------------------------------------------------------------
-
-instance (MonadReader r m) => MonadReader r (ErrorT e m) where
- ask = ask'
- local = local' mapErrorT
-
-instance (MonadWriter w m) => MonadWriter w (ErrorT e m) where
- tell = tell'
- listen = listen1' E unE (\w -> either Left (\r -> Right (r,w)))
-
-instance (MonadState s m) => MonadState s (ErrorT e m) where
- get = get'
- put = put'
-
-instance (Monad m) => MonadError e (ErrorT e m) where
- throwError = E . return . Left
- m `catchError` h = E (do a <- unE m
- case a of
- Left l -> unE (h l)
- Right r -> return (Right r))
-
--- MonadPlus is used for Nondet, these should be moved in the nondet class
-instance MonadPlus m => MonadPlus (ErrorT e m) where
- mzero = mzero'
- mplus = mplus1' E unE
-
--- `findAll` is like catMaybes, it will aways succeed, but will only return
--- results that didn't raise an exception.
--- if all results a required, use handle to turn the failures into (tagged) successes.
-instance MonadNondet m => MonadNondet (ErrorT e m) where
- findAll = mapErrorT (liftM res . findAll)
- where res xs = Right [ x | Right x <- xs ]
- commit = mapErrorT commit
-
-instance MonadResume m => MonadResume (ErrorT e m) where
- delay = mapErrorT delay
- force = mapErrorT force
-
-instance (MonadCont m) => MonadCont (ErrorT e m) where
- callCC = callCC1' E unE Right
-
-
-
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Control.Monad.Fix
--- Copyright : (c) Andy Gill 2001,
--- (c) Oregon Graduate Institute of Science and Technology, 2002
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries@haskell.org
--- Stability : experimental
--- Portability : portable
---
--- A class for monadic (value) recursion and its implementation.
--- For details:
--- Levent Erkök. Value recursion in Monadic Computations.
--- Oregon Graduate Institute, OHSU. Portland, Oregon. October 2002.
--- http://www.cse.ogi.edu/~erkok/rmb/
------------------------------------------------------------------------------
-
-module Control.Monad.X.Fix (
- MonadFix(
- mfix -- :: (a -> m a) -> m a
- ),
- fix -- :: (a -> a) -> a
- ) where
-
-import Prelude
-import System.IO
-import Monad(liftM)
-
-import Control.Monad.X.Trans
-import Control.Monad.X.Identity
-import Control.Monad.X.Types
-import Control.Monad.X.ReaderT
-import Control.Monad.X.WriterT
-import Control.Monad.X.StateT
-import Control.Monad.X.ErrorT
-import Control.Monad.X.NondetT
-
-fix :: (a -> a) -> a
-fix f = let x = f x in x
-
-class (Monad m) => MonadFix m where
- mfix :: (a -> m a) -> m a
-
-
-
-
-instance MonadFix Maybe where
- mfix f = let a = f (unJust a) in a
- where unJust (Just x) = x
-
-instance MonadFix [] where
- mfix f = case fix (f . head) of
- [] -> []
- (x:_) -> x : mfix (tail . f)
-
-instance MonadFix IO where
- mfix = fixIO
-
-instance MonadFix Identity where
- mfix f = return (fix (runIdentity . f))
-
-instance (MonadFix m) => MonadFix (ReaderT r m) where
- mfix f = R (\r -> mfix (\a -> unR (f a) r))
-
-instance (Monoid w, MonadFix m) => MonadFix (WriterT w m) where
- mfix m = W (mfix (\ ~(a, _) -> unW (m a)))
-
-instance (MonadFix m) => MonadFix (StateT s m) where
- mfix f = S (\s -> mfix (\ ~(a, _) -> unS (f a) s))
-
-instance (MonadFix m) => MonadFix (ErrorT e m) where
- mfix f = E (mfix (unE . f . either (error "ErrorT: mfix looped") id))
-
--- is that right?
-instance MonadFix m => MonadFix (NondetT m) where
- mfix f = N (do x <- mfix (unN . f . hd)
- case x of
- Empty -> return Empty
- Cons a _ -> return (Cons a (mfix (tl . f))))
- where hd (Cons a _) = a
- hd _ = error "NondetT: mfix looped (hd)"
- tl m = N (do x <- unN m
- case x of
- Cons _ m -> unN m
- _ -> error "NondetT: mfix looped (tl)")
-
-
-{-
-instance MonadFix m => MonadFix (NondetT m) where
- mfix f = Re (do x <- mfix (unRe . f . hd)
- case x of
- Value a -> return (Value a)
- Delay m -> return (Delay (mfix (tl . f)))
- where hd (Value a) = a
- hd _ = error "ResumeT: mfix looped (hd)"
- tl m = Re (do x <- unRe m
- case x of
-
- Cons _ m -> unN m
- _ -> error "NondetT: mfix looped (tl)")
--}
-
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Control.Monad.Identity
--- Copyright : (c) Andy Gill 2001,
--- (c) Oregon Graduate Institute of Science and Technology, 2001
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries@haskell.org
--- Stability : experimental
--- Portability : portable
---
--- The Identity monad.
---
--- Inspired by the paper
--- /Functional Programming with Overloading and
--- Higher-Order Polymorphism/,
--- Mark P Jones (<http://www.cse.ogi.edu/~mpj/>)
--- Advanced School of Functional Programming, 1995.
---
------------------------------------------------------------------------------
-
-module Control.Monad.X.Identity (
- Identity,
- runIdentity
- ) where
-
-import Prelude(Functor(..),Monad(..))
-import Monad(liftM)
-
-
--- ---------------------------------------------------------------------------
--- 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
-
-
-newtype Identity a = I { unI :: a }
-
-instance Functor Identity where
- fmap = liftM
-
-instance Monad Identity where
- return = I
- m >>= k = k (unI m)
-
-runIdentity = unI
-
+++ /dev/null
-module Monads where
-
--- imports everything in the library
-
-import Control.Monad.X.Reader
-import Control.Monad.X.Writer
-import Control.Monad.X.State
-import Control.Monad.X.Error
-import Control.Monad.X.Nondet
-import Control.Monad.X.Resume
-import Control.Monad.X.Cont
-import Control.Monad.X.Fix
-
+++ /dev/null
-module Control.Monad.X.Nondet (Nondet,runNondet,runNondets,module T) where
-
-import Control.Monad.X.Identity
-import qualified Control.Monad.X.NondetT as N
-import Control.Monad.X.Trans as T
-
-
--- this is simply list
-type Nondet = N.NondetT Identity
-
-runNondet :: Nondet a -> Maybe a
-runNondet m = runIdentity (N.runNondet m)
-
-runNondets :: Nondet a -> [a]
-runNondets m = runIdentity (N.runNondets m)
-
+++ /dev/null
-module Control.Monad.X.NondetT
- (NondetT,
- runNondet,
- runNondets,
- mapNondetT,
- MonadPlus(..),
- module T
- ) where
-
-import Prelude
-import Monad(liftM,MonadPlus(..))
-
-import Control.Monad.X.Trans as T
-import Control.Monad.X.Utils
-import Control.Monad.X.Types(NondetT(..),T(..))
-
-
-instance MonadTrans NondetT where
- lift m = N (liftM single m)
-
-instance Monad m => Functor (NondetT m) where
- fmap = liftM
-
-instance Monad m => Monad (NondetT m) where
- return = return'
- m >>= f = N (do x <- unN m
- case x of
- Empty -> return Empty
- Cons a xs -> unN (mplus (f a) (xs >>= f)))
-
-instance HasBaseMonad m n => HasBaseMonad (NondetT m) n where
- inBase = inBase'
-
-
--- misc functions
-instance Monad m => Functor (T m) where
- fmap f Empty = Empty
- fmap f (Cons a m) = Cons (f a) (fmap f m)
-
-
-single x = Cons x mzero
-
-flatten :: Monad m => T m a -> m [a]
-flatten Empty = return []
-flatten (Cons a m) = liftM (a :) (runNondets m)
-
-
-runNondet m = do t <- unN m
- case t of
- Empty -> return Nothing
- Cons a _ -> return (Just a)
-
-runNondets m = flatten =<< unN m
-
-mapNondetT f (N m) = N (f m)
-
-
--- other features.
-
-instance MonadReader r m => MonadReader r (NondetT m) where
- ask = ask'
- local = local' mapNondetT
-
-instance MonadWriter w m => MonadWriter w (NondetT m) where
- tell = tell'
- listen = listen1' N unN (\w -> fmap (\a -> (a,w)))
-
-instance MonadState s m => MonadState s (NondetT m) where
- get = get'
- put = put'
-
-instance MonadError e m => MonadError e (NondetT m) where
- throwError = throwError'
- catchError = catchError1' N unN
-
-instance Monad m => MonadPlus (NondetT m) where
- mzero = N (return Empty)
- mplus m n = N (do x <- unN m
- case x of
- Empty -> unN n
- Cons a m' -> return (Cons a (mplus m' n)))
-
-instance Monad m => MonadNondet (NondetT m) where
- findAll m = lift (runNondets m)
- commit m = N (do x <- unN m
- case x of
- Empty -> return Empty
- Cons a _ -> return (single a))
-
--- ergh, what does this do?
-instance (MonadCont m) => MonadCont (NondetT m) where
- callCC = callCC1' N unN single
-
-
-
-
-
-
+++ /dev/null
-This is an experimental replacement for the current monad library.
-(at some point the .X. part of the names should disappear)
-
-It is mostly complete, but some more work is needed in places,
-in particular the interaction of continuations with other features.
-also a lot more tests/laws are need. and of course documentation.
-
-Resumptions are very new and not well tested. Also the nonstandard
-morphisms for them are not fixed.
-
-Changes from the original library
-=================================
-
-General:
- * the monads are implemented in terms of the transformers
- - the transformer files end in "T"
- - the monad files have no "T" at the end
- - a monad file defines a type synonym, and redefines the "run" functions.
- * The file Transformers imports all transformers
- * The file Monads imports all monads and fix, and so everything in the library
- (it is note very useful except for compiling the library)
- * Currently there is no ListT, instead we have NondetT,
- which is (kind of) based on what's in Ralf Hinze's
- "Deriving Monad Transformers" paper.
- * there is no RWS transformer
- * NondetT transformer is new
- * ResumeT is new
- * New class HasBaseMonad to perform computations in the "heart" of the monad
- * structural changes in the code
- - tried to capture common patterns in definitions
- - the library is currently in "column" format, i.e.
- a file for a transformer contains:
- - basic instances (Functor, Monad, HasBaseMonad)
- - arbitrary functions (mostly from old library) things like "run" etc.
- - liftings of all features only for this transformer
-
- - the file "Fix" is in "row" format, i.e. it implements "mfix" for all transformers.
- * MonadPlus is used for backtracking and _not_ error handling
- * none of the transformers implement "fail" it is just passed along to the base monad,
- thus: fail x = inBase (fail x)
- - reason for that is that there seems to be no reasonable way to implement it
-
-
-Specific:
-
-Reader: new function runReader (like runReadrT with swapped arguments)
-Writer: * new function runWriter (same as runWriterT)
- * new behavior for "listen": it does not produce any output
- thus: oldListen m = do (a,w) <- listen m
- tell w
- * moved "pass" out of the class (implemented in terms of the other functions)
-State: * new functions runState (like evalState with swapped arguments)
- runStateS (like runStateT with swapped arguments)
-Error: * new function runError (same as runErrorT)
- * removed Error class, now errors can be of any type
- * fail "" does _not_ cause an error to be thrown (see comments above)
- * mzero does _not_ cause an error to be thrown (see comments above)
- * mplus does _not_ handle errors (see comments above)
-Nondet: new
-Resume: new
-Cont: unfinished
- - how to do "local" (current seems reasonable, but deviates from "standard" definitions)
- - how to do "listen"
- - understand better interaction with other control transformers
- (exceptions, resumptions, nondeterminism)
-
-
-People
-======
-
-discussions etc should probably be sent to:
-libraries@haskell.org
-
-author of current version: Iavor S. Diatchki <mailto:diatchki@cse.ogi.edu>
-based upon the original by: Andy Gill <mailto:andy@cse.ogi.edu>
-the ErrorT in the original library was rendered by: Michael Weber <mailto:michael.weber@post.rwth-aachen.de>
-the initial version of the NondetT code in CPS style was from: Andrew J Bromage <mailto:ajb@spamcop.net>
-
-iavor: if i forgot someone (sorry!) please send me email
-
+++ /dev/null
-module Control.Monad.X.Reader (module T, Reader, runReader) where
-
-import Control.Monad.X.Identity
-import qualified Control.Monad.X.ReaderT as R
-import Control.Monad.X.Trans as T
-
-type Reader r = R.ReaderT r Identity
-
-runReader :: r -> Reader r a -> a
-runReader r m = runIdentity (R.runReader r m)
-
-
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- 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)
---
--- The definition of the reader monad transformer.
---
--- Inspired by the paper
--- /Functional Programming with Overloading and
--- Higher-Order Polymorphism/,
--- Mark P Jones (<http://www.cse.ogi.edu/~mpj/>)
--- Advanced School of Functional Programming, 1995.
------------------------------------------------------------------------------
-
-module Control.Monad.X.ReaderT (
- ReaderT,
- runReader,
- runReaderT,
- mapReaderT,
- withReaderT,
- module T,
- ) where
-
-import Prelude (Monad(..),Functor(..),const)
-import Control.Monad (MonadPlus(..),liftM)
-
-import Control.Monad.X.Trans as T
-import Control.Monad.X.Utils
-import Control.Monad.X.Types(ReaderT(..))
-
-
-
--- ---------------------------------------------------------------------------
--- Basic instances
-
-instance MonadTrans (ReaderT r) where
- lift m = R (\_ -> m)
-
-instance HasBaseMonad m n => HasBaseMonad (ReaderT r m) n where
- inBase = inBase'
-
-instance Monad m => Functor (ReaderT r m) where
- fmap = liftM
-
-instance Monad m => Monad (ReaderT r m) where
- fail = fail'
- return = return'
- m >>= f = R (\r -> (m $$ r) >>= (\a -> (f a $$ r)))
-
-
--- some functions
-
--- | Remove a reader layer by providing a specific value for the
--- environment.
-runReader :: r -> ReaderT r m a -> m a
-runReader r m = m $$ r
-
--- | Same as 'runReader' but with the arguments the other way around.
--- For backwards compatability.
-runReaderT :: ReaderT r m a -> r -> m a
-runReaderT = ($$)
-
--- | Apply a function to underlying monad.
--- NOTE: SHOULD THIS BE EXPORTED?
-mapReaderT :: (m a -> n b) -> ReaderT w m a -> ReaderT w n b
-mapReaderT f m = R (\r -> f (m $$ r))
-
--- | A more general version of 'local' when the reader is the
--- outermost layer.
-withReaderT :: (r' -> r) -> ReaderT r m a -> ReaderT r' m a
-withReaderT f m = R (\r -> m $$ f r)
-
--- sugar.
-($$) = unR
-
-
--- how the features are implemented for readers
-
-instance (Monad m) => MonadReader r (ReaderT r m) where
- ask = R return
- local = withReaderT
-
-instance MonadWriter w m => MonadWriter w (ReaderT r m) where
- tell = tell'
- listen = listen2' R unR (\w a -> (a,w))
-
-instance MonadState s m => MonadState s (ReaderT r m) where
- get = get'
- put = put'
-
-instance MonadError e m => MonadError e (ReaderT r m) where
- throwError = throwError'
- catchError = catchError2' R unR
-
-instance MonadPlus m => MonadPlus (ReaderT r m) where
- mzero = mzero'
- mplus = mplus2' R unR
-
-instance (MonadNondet m) => MonadNondet (ReaderT r m) where
- findAll = mapReaderT findAll
- commit = mapReaderT commit
-
-instance MonadResume m => MonadResume (ReaderT r m) where
- delay = mapReaderT delay
- force = mapReaderT force
-
-instance MonadCont m => MonadCont (ReaderT r m) where
- callCC = callCC2' R unR const
-
-
-
-
-
+++ /dev/null
-module Control.Monad.X.Resume (Resume, hyper, module T) where
-
-import Control.Monad.X.Identity
-import qualified Control.Monad.X.ResumeT as R
-import Control.Monad.X.Trans as T
-
-type Resume = R.ResumeT Identity
-
-hyper :: Resume a -> a
-hyper m = runIdentity (R.hyper m)
-
-
+++ /dev/null
-module Control.Monad.X.ResumeT
- (ResumeT,
- hyper,
- module T
- ) where
-
-import Prelude(Functor(..),Monad(..),error)
-import Control.Monad(liftM,MonadPlus(..))
-
-import Control.Monad.X.Trans as T
-import Control.Monad.X.Utils
-import Control.Monad.X.Types (ResumeT(..), Res(..))
-
--- resumptions:
--- a transformer for explicit "lazyness"
-
-
-instance MonadTrans ResumeT where
- lift m = Re (liftM Value m)
-
-instance Monad m => Functor (ResumeT m) where
- fmap = liftM
-
-instance Monad m => Monad (ResumeT m) where
- return = return'
- m >>= f = Re (do x <- unRe m
- case x of
- Value a -> unRe (f a)
- Delay m -> return (Delay (m >>= f)))
-
-instance HasBaseMonad m n => HasBaseMonad (ResumeT m) n where
- inBase = inBase'
-
-instance Monad m => Functor (Res m) where
- fmap f (Value a) = Value (f a)
- fmap f (Delay m) = Delay (liftM f m)
-
-
-
-hyper :: Monad m => ResumeT m a -> m a
-hyper m = do x <- unRe m
- case x of
- Value a -> return a
- Delay m -> hyper m
-
-mapResumeT f m = Re (f (unRe m))
-
-instance MonadReader r m => MonadReader r (ResumeT m) where
- ask = ask'
- local = local' mapResumeT
-
-instance MonadWriter w m => MonadWriter w (ResumeT m) where
- tell = tell'
- listen = listen1' Re unRe (\w -> fmap (\a -> (a,w)))
-
-instance MonadState s m => MonadState s (ResumeT m) where
- get = get'
- put = put'
-
-instance MonadError e m => MonadError e (ResumeT m) where
- throwError = throwError'
- catchError = catchError1' Re unRe
-
-instance MonadPlus m => MonadPlus (ResumeT m) where
- mzero = mzero'
- mplus = mplus1' Re unRe
-
-instance MonadNondet m => MonadNondet (ResumeT m) where
- findAll = error "findAll ResumeT TODO"
- commit = mapResumeT commit
-
-instance Monad m => MonadResume (ResumeT m) where
- delay m = Re (return (Delay m))
- force m = Re (do x <- unRe m
- case x of
- Value a -> return (Value a)
- Delay m' -> unRe m')
-
-instance MonadCont m => MonadCont (ResumeT m) where
- callCC = callCC1' Re unRe Value
-
-
-
+++ /dev/null
-module Control.Monad.X.State (State, runState, runStateS, module T) where
-
-import Control.Monad.X.Identity
-import qualified Control.Monad.X.StateT as S
-import Control.Monad.X.Trans as T
-
-type State s = S.StateT s Identity
-
-runState :: s -> State s a -> a
-runState s m = runIdentity (S.runState s m)
-
-runStateS :: s -> State s a -> (a,s)
-runStateS s m = runIdentity (S.runStateS s m)
-
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Control.Monad.State
--- Copyright : (c) Andy Gill 2001,
--- (c) Oregon Graduate Institute of Science and Technology, 2001
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries@haskell.org
--- Stability : experimental
--- Portability : non-portable (multi-param classes, functional dependencies)
---
--- State monads.
---
--- This module is inspired by the paper
--- /Functional Programming with Overloading and
--- Higher-Order Polymorphism/,
--- Mark P Jones (<http://www.cse.ogi.edu/~mpj/>)
--- Advanced School of Functional Programming, 1995.
---
--- See below for examples.
-
------------------------------------------------------------------------------
-
-module Control.Monad.X.StateT (
- StateT,
- runState,
- runStateS,
- runStateT,
- evalStateT,
- execStateT,
- mapStateT,
- withStateT,
- module T
- ) where
-
-import Prelude (Functor(..),Monad(..),(.),fst)
-
-import Control.Monad
-import Control.Monad.X.Trans as T
-import Control.Monad.X.Utils
-import Control.Monad.X.Types(StateT(..))
-
-instance MonadTrans (StateT s) where
- lift m = S (\s -> liftM (\a -> (a,s)) m)
-
-instance HasBaseMonad m n => HasBaseMonad (StateT s m) n where
- inBase = inBase'
-
-instance (Monad m) => Functor (StateT s m) where
- fmap = liftM
-
-instance (Monad m) => Monad (StateT s m) where
- return = return'
- m >>= k = S (\s -> do (a, s') <- m $$ s
- k a $$ s')
- fail = fail'
-
-
-runState :: Monad m => s -> StateT s m a -> m a
-runState s m = liftM fst (runStateS s m)
-
-runStateS :: s -> StateT s m a -> m (a,s)
-runStateS s m = m $$ s
-
-
-runStateT :: StateT s m a -> s -> m (a,s)
-runStateT = ($$)
-
-evalStateT :: (Monad m) => StateT s m a -> s -> m a
-evalStateT m s = do
- (a, _) <- m $$ s
- return a
-
-execStateT :: (Monad m) => StateT s m a -> s -> m s
-execStateT m s = do
- (_, s') <- m $$ s
- return s'
-
-mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
-mapStateT f m = S (f . (m $$))
-
-withStateT :: (s -> s) -> StateT s m a -> StateT s m a
-withStateT f m = S ((m $$) . f)
-
-($$) = unS
-
-
-instance (MonadReader r m) => MonadReader r (StateT s m) where
- ask = ask'
- local = local' mapStateT
-
-instance (MonadWriter w m) => MonadWriter w (StateT s m) where
- tell = tell'
- listen = listen2' S unS (\w (a,s) -> ((a,w),s))
-
-instance (Monad m) => MonadState s (StateT s m) where
- get = S (\s -> return (s, s))
- put s = S (\_ -> return ((), s))
-
-instance (MonadError e m) => MonadError e (StateT s m) where
- throwError = throwError'
- catchError = catchError2' S ($$)
-
-instance (MonadPlus m) => MonadPlus (StateT s m) where
- mzero = mzero'
- mplus = mplus2' S ($$)
-
--- 'findAll' does not affect the state
--- if interested in the state as well as the result, use
--- `get` before `findAll`.
--- e.g. findAllSt m = findAll (do x <- m; y <- get; reutrn (x,y))
-instance MonadNondet m => MonadNondet (StateT s m) where
- findAll m = S (\s -> liftM (\xs -> (fmap fst xs,s)) (findAll (m $$ s)))
- commit = mapStateT commit
-
-instance MonadResume m => MonadResume (StateT s m) where
- delay = mapStateT delay
- force = mapStateT force
-
--- jumping undoes changes to the state state
-instance MonadCont m => MonadCont (StateT s m) where
- callCC = callCC2' S unS (\a s -> (a,s))
-
-
+++ /dev/null
-module Control.Monad.X.Trans
- ( -- * General transformer classes
- MonadTrans(..),
- HasBaseMonad(..),
-
- -- * Plumbing transformers
- -- $PlumbingDoc
-
- -- ** Reader
- MonadReader(..),
- -- $MonadReaderDoc
- asks,
- localSet,
-
- -- ** Writer
- MonadWriter(..),
- -- $MonadWriterDoc
- listens,
- censor,
- pass,
-
- -- ** State
- MonadState(..),
- -- $MonadStateDoc
- gets,
- modify,
-
- -- * Control transformers
- -- $ControlDoc
-
- -- ** Exceptions
- MonadError(..),
- -- $MonadErrorDoc
-
- -- ** Non-determinism
- MonadNondet(..),
- -- $MonadNondetDoc
-
- -- ** Resumptions
- MonadResume(..),
- -- $MonadResumeDoc
-
- -- ** Continuations
- MonadCont(..),
- -- $MonadContDoc
- )
- where
-
-import Prelude (Monad(..),(.),const,IO,Maybe,id)
-import Control.Monad(MonadPlus,liftM)
-
-import Data.Monoid(Monoid)
-
-
-
---------------------------------------------------------------------------------
--- | Provides a way of going across one transformer layer.
-
-class MonadTrans t where
- lift :: Monad m => m a -> t m a
- -- ^ Provides a way of going across one transformer layer.
-
-
---------------------------------------------------------------------------------
--- | The predicate @HasBaseMonad m n@ indicates that 'm' is a monad
--- built by applying a number of transformers to 'n'.
-
-class (Monad m, Monad n) => HasBaseMonad m n | m -> n where
- inBase :: n a -> m a
- -- ^ Provides a way of going across multiple transformer layers,
- -- all the way to the innermost atomic monad.
-
-
--- Move me somewhere else.
-instance HasBaseMonad IO IO where inBase = id
-instance HasBaseMonad [] [] where inBase = id
-instance HasBaseMonad Maybe Maybe where inBase = id
-
-
-
-
-{- $PlumbingDoc
- /Plumbing transformers/ take care of propagating information around in a computation.
-They all commute with each other. This means that it doesn't meter
-in what order they are added to a computation, the final effect is the same.
--}
-
--- | A reader monad has the ability to propagate around a read-only environment.
--- One can think of the environment as a special read only variable that can
--- be accessed via the methods of the class.
-
-class (Monad m) => MonadReader r m | m -> r where
- ask :: m r
- -- ^ Read the value of the variable.
-
- local :: (r -> r) -> m a -> m a
- -- ^ The method @local f m@ uses @f@ to change the value of the variable
- -- for the duration of a computation @m@. After @m@ completes its execution
- -- the original value of the variable is restored.
-
-{- $MonadReaderDoc
- Read-only variables are useful when some information needs to be carried
-around, but is not used all the time. Such a situation may occur when a deeply nested
-function call needs the information, but most of the functions involved in
-a computation will not use it and simply pass it around. Read-only variables
-are very closely related to /implicit parameters/ <...>.
-See also `MonadWriter'.
--}
-
-
--- | Gets specific component of the environment, using the projection function
--- supplied.
-asks :: (MonadReader r m) => (r -> a) -> m a
-asks f = liftM f ask
-
-
--- | Temporarily sets the value of the read-only variable. One can think of
--- @localSet x m@ as a @let@ construct.
-localSet :: MonadReader r m => r -> m a -> m a
-localSet = local . const
-
-
--- | A writer monad has the ability to collect a number of outputs generated
--- during a computation. It is like carrying around a buffer that can be
--- manipulated with the methods of the class. The 'Monoid' class specifies
--- how to make an empty buffer, and how to join two buffers together.
-class (Monoid w, Monad m) => MonadWriter w m | m -> w where
- tell :: w -> m ()
- -- ^ @tell w@ appends the new information @w@ to the buffer.
-
- listen :: m a -> m (a, w)
- -- ^ @listen m@ moves the contents of the buffer of computation @m@ to its result.
- -- The resulting computation has an empty buffer.
-
-{- $MonadWriterDoc
- Buffer variables are often useful when one needs to collect some
-information, for example while traversing a data structure. In a sense,
-they are the dual of read-only variables, as they propagate outputs
-of functions, rather then their inputs.
--}
-
-
--- | Gets specific component of the output, using the projection function supplied.
-listens :: (MonadWriter w m) => (w -> b) -> m a -> m (a, b)
-listens f m = liftM (\ ~(a,w) -> (a,f w)) (listen m)
-
-
--- | @censor f m@ behaves like @m@ except its output is modified by @f@.
-censor :: MonadWriter w m => (w -> w) -> m a -> m a
-censor f m = do (a,w) <- listen m
- tell (f w) -- the media :-)
- return a
-
--- | NOTE: SHOULD THIS BE IN THE LIBRARY?
--- Does what the type suggests.
-pass :: (MonadWriter w m) => m (a, w -> w) -> m a
-pass m = do ((a,f),w) <- listen m
- tell (f w)
- return a
-
-
-
--- | A state monad carries around a piece of state. It is just like
--- having a read-write variable in an imperative language.
-
-class (Monad m) => MonadState s m | m -> s where
- get :: m s
- -- ^ reads the value of the variable
-
- put :: s -> m ()
- -- ^ @put s@ permanently changes the value of the variable to @s@.
-
--- $MonadStateDoc
---
-
--- | Gets specific component of the state, using the projection function supplied.
-gets :: (MonadState s m) => (s -> a) -> m a
-gets f = liftM f get
-
--- | Update the state with a function.
-modify :: (MonadState s m) => (s -> s) -> m ()
-modify f = get >>= put . f
-
-
--- $ControlDoc
--- /Control transformers/ are used to manipulate the control flow in a program.
--- In general they do not commute between themselves and with other transformers.
--- This means that it is important in what order they are added on top of a monad.
--- Different orders yield monads with different behavior. See "FeatureInteract.hs".
-
-
-
--- | An error (or exception) monad is aware that computations may fail.
--- The type @e@ specifies what errors may occur in a computation.
-class (Monad m) => MonadError e m | m -> e where
- throwError :: e -> m a
- -- ^ The method @throwError e@ raises exception @e@.
- -- It never returns a value.
-
- catchError :: m a -> (e -> m a) -> m a
- -- ^ The method @catchError m h@ uses the handler @h@ to handle exceptions
- -- raised in computation @m@. If no exceptions are
- -- raised, the final computation behaves as @m@. It is possible
- -- for the handler itself to throw an exception.
-
--- $ErrorDoc
-
--- | A nondeterminism (or backtracking) monad supports computations that
--- may fail and backtrack or produce multiple results.
---
--- Currently some of the methods in this class are inherited from
--- the class 'MonadPlus' defined in module "Control.Monad".
--- 'mzero' is used to indicate no results.
--- 'mplus' is used to indicate alternatives.
---
--- Since the use of 'MonadPlus' is somewhat overloaded in Haskell
--- (it is also used for exception handling)
--- in the future 'mzero' and 'mplus' may be added explicitly to this class
--- (with different names).
-class (MonadPlus m) => MonadNondet m where
- findAll :: m a -> m [a]
- -- ^ @findAll m@ is analogous to the construct found in logic languages
- -- (e.g. Prolog, Curry). It produces all possible results of @m@.
- commit :: m a -> m a
- -- ^ @commit m@ behaves like @m@ except it will produce at most one result.
- -- Thus, it resembles the /cut/ operator of Prolog.
- -- (VERIFY) @findAll (commit m)@ should never produce a list with more than one element.
-
-class Monad m => MonadResume m where
- delay :: m a -> m a
- force :: m a -> m a
-
--- | TODO.
-class (Monad m) => MonadCont m where
- callCC :: ((a -> m b) -> m a) -> m a
-
-
-
-
-
-
+++ /dev/null
-module Control.Monad.X.Transformers
- ( module R, module W, module S, module E, module N, module Re {- , module C-} )
- where
-
-import Control.Monad.X.ReaderT as R
-import Control.Monad.X.WriterT as W
-import Control.Monad.X.StateT as S
-import Control.Monad.X.ErrorT as E
-import Control.Monad.X.NondetT as N
-import Control.Monad.X.ResumeT as Re
--- import Control.Monad.X.ContT as C
-
-
+++ /dev/null
-module Control.Monad.X.Types where
-
-import Control.Monad(MonadPlus(..))
-
-newtype ReaderT r m a = R { unR :: r -> m a }
-newtype WriterT w m a = W { unW :: m (a, w) }
-newtype StateT s m a = S { unS :: s -> m (a,s) }
-newtype ErrorT e m a = E { unE :: m (Either e a) }
-newtype NondetT m a = N { unN :: m (T m a) }
-newtype ResumeT m a = Re { unRe :: m (Res m a) }
-newtype ContT r m a = C { unC :: (a -> m r) -> m r }
-
-data T m a = Empty | Cons a (NondetT m a)
-data Res m a = Value a | Delay (ResumeT m a)
-
-
+++ /dev/null
-module Control.Monad.X.Utils where
-
--- | This is a private module and is not to be imported
--- directly by non-library modules.
-
-
-import Prelude(return,fail,(.))
-import Control.Monad(MonadPlus(..))
-import Control.Monad.X.Trans
-
--- has base
-inBase' m = lift (inBase m)
-
--- monad
-return' x = lift (return x)
-fail' msg = lift (fail msg)
-
--- reader
-ask' :: (MonadTrans t, MonadReader r m) => t m r
-ask' = lift ask
-local' map f = map (local f)
-
--- writer
-tell' w = lift (tell w)
-listen1' mk unmk add m = mk (do (x,w) <- listen (unmk m)
- return (add w x))
-listen2' mk unmk add m = mk (\s -> do (x,w) <- listen (unmk m s)
- return (add w x))
-
--- state
-get' :: (MonadTrans t, MonadState s m) => t m s
-get' = lift get
-put' s = lift (put s)
-
--- error
-throwError' e = lift (throwError e)
-catchError1' mk unmk m h = mk (catchError (unmk m) (unmk . h))
-catchError2' mk unmk m h = mk (\y -> catchError (unmk m y) (\e -> unmk (h e) y))
-
--- mplus
-mzero' :: (MonadTrans t, MonadPlus m) => t m a
-mzero' = lift mzero
-mplus1' mk unmk m n = mk (mplus (unmk m) (unmk n))
-mplus2' mk unmk m n = mk (\y -> unmk m y `mplus` unmk n y)
-
--- cont
-callCC1' mk unmk ret f = mk (callCC (\br -> unmk (f (\a -> lift (br (ret a))))))
-callCC2' mk unmk ret f = mk (\s -> callCC (\br -> unmk (f (\a -> lift (br (ret a s)))) s))
-
-
-
-
+++ /dev/null
-module Control.Monad.X.Writer (Writer, runWriter, module T)where
-
-import Control.Monad.X.Identity
-import qualified Control.Monad.X.WriterT as W
-import Control.Monad.X.Trans as T
-
-type Writer w = W.WriterT w Identity
-
-runWriter :: Writer w a -> (a,w)
-runWriter m = runIdentity (W.runWriter m)
-
-
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Control.Monad.Writer
--- Copyright : (c) Andy Gill 2001,
--- (c) Oregon Graduate Institute of Science and Technology, 2001
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries@haskell.org
--- Stability : experimental
--- Portability : non-portable (multi-param classes, functional dependencies)
---
--- The implementation of the writer transformer.
---
--- Inspired by the paper
--- /Functional Programming with Overloading and
--- Higher-Order Polymorphism/,
--- Mark P Jones (<http://www.cse.ogi.edu/~mpj/>)
--- Advanced School of Functional Programming, 1995.
------------------------------------------------------------------------------
-
-module Control.Monad.X.WriterT (
- WriterT,
- runWriter,
- runWriterT,
- execWriterT,
- mapWriterT,
- module T,
- module Monoid,
- ) where
-
-import Prelude(Functor(..),Monad(..),fst,snd,(.))
-import Control.Monad(liftM,MonadPlus(..))
-
-import Data.Monoid as Monoid (Monoid(..))
-
-import Control.Monad.X.Trans as T
-import Control.Monad.X.Utils
-import Control.Monad.X.Types(WriterT(..))
-
-
-instance (Monoid w) => MonadTrans (WriterT w) where
- lift m = W (liftM (\a -> (a,mempty)) m)
-
-instance (Monoid w, HasBaseMonad m n) => HasBaseMonad (WriterT w m) n where
- inBase = inBase'
-
-instance (Monoid w, Monad m) => Functor (WriterT w m) where
- fmap = liftM
-
-instance (Monoid w, Monad m) => Monad (WriterT w m) where
- return = return'
- m >>= f = W (do (a, w) <- unW m
- (b, w') <- unW (f a)
- return (b, w `mappend` w'))
- fail = fail'
-
-
-runWriter :: WriterT w m a -> m (a,w)
-runWriter = unW
-
-runWriterT :: WriterT w m a -> m (a,w)
-runWriterT = unW
-
-execWriterT :: Monad m => WriterT w m a -> m w
-execWriterT m = liftM snd (unW m)
-
-mapWriterT :: (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
-mapWriterT f m = W (f (unW m))
-
-
-instance (Monoid w, MonadReader r m) => MonadReader r (WriterT w m) where
- ask = ask'
- local = local' mapWriterT
-
--- different from before, listen produces no output
-instance (Monoid w, Monad m) => MonadWriter w (WriterT w m) where
- tell w = W (return ((), w))
- listen = mapWriterT (liftM (\(a,w) -> ((a,w),mempty)))
-
-instance (Monoid w, MonadState s m) => MonadState s (WriterT w m) where
- get = get'
- put = put'
-
-instance (Monoid w, MonadError e m) => MonadError e (WriterT w m) where
- throwError = throwError'
- catchError = catchError1' W unW
-
-instance (Monoid w, MonadPlus m) => MonadPlus (WriterT w m) where
- mzero = mzero'
- mplus = mplus1' W unW
-
--- 'findAll' does not produce output
--- if interested in the output use 'listen' before calling 'findAll'.
-instance (Monoid w, MonadNondet m) => MonadNondet (WriterT w m) where
- findAll = mapWriterT (liftM (\xs -> (fmap fst xs, mempty)) . findAll)
- commit = mapWriterT commit
-
-instance (Monoid w, MonadResume m) => MonadResume (WriterT w m) where
- delay = mapWriterT delay
- force = mapWriterT force
-
--- jumping undoes the output
-instance (Monoid w, MonadCont m) => MonadCont (WriterT w m) where
- callCC = callCC1' W unW (\a -> (a,mempty))
-
-
+++ /dev/null
-module Prop where
-
-data Prop a
-
-infix 1 ===
-(===) :: a -> a -> Prop a
-(===) = error "==="
-
+++ /dev/null
-import Prop
-import Control.Monad.X.ReaderT
-
-
-local_return f x = local f (return x) === return x
-local_bind f m1 m2 = (local f m1 >>= \x -> local f (m2 x)) === local f (m1 >>= m2)
-local_local f g m = local f (local g m) === local (g . f) m
-local_get f = local f get === fmap f get
-
-get_bind m = (get >> m) === m
-
-
-
-
+++ /dev/null
-import Prop
-import Control.Monad.X.WriterT
-
-listen_return x = listen (return x) === return (x,mempty)
-listen_bind m1 m2 = listen (m1 >>= m2) === (do (x,w1) <- listen m1
- (y,w2) <- listen (m2 x)
- return (y, w1 `mappend` w2))
-
-
+++ /dev/null
-import Control.Monad.X.Transformers
-
-test00' _ = do a <- local (+1) ask
- b <- ask
- return (a,b)
-
-
-test0' _ = do a <- callCC $ \jmp -> local (+1) ask
- b <- ask
- return (a,b)
-
--- this illustrates an interesting phenomenon.
--- if the reader is there before continuations,
--- jumping will not undo "local" changes to the environment,
--- and they will be seen in the continuation.
--- this happens because the jump is within the scope
--- of the local.
-test1' _ = do a <- callCC $ \jmp -> local (+1) (ask >>= jmp)
- b <- ask
- return (a,b)
-
-
-test2' _ = callCC $ \jmp -> tell [1] >> jmp 2
-
--- what should this do?
-test22' _ = do (a,w) <- callCC $ \jmp -> tell [1] >> listen (jmp (3,[]))
- tell [2]
- return (a,w)
-
-
-output w = do x <- get
- put (mappend x w)
-
-list m = do w <- get
- put mempty
- a <- m -- this is wrong if m jumps as it will delete all output
- w' <- get
- put w
- return (a,w')
-
-
-test32' _ = do (a,w) <- callCC $ \jmp -> output "1" >> {-list-} (jmp (3,""))
- output "2"
- return (a,w)
-
-test33' _ = do (a,w) <- callCC $ \jmp -> output "1" >> list (output "7")
- output "2"
- return (a,w)
-
-
-
-test3' _ = callCC $ \jmp -> put 1 >> jmp 2
-
-
-test00 = do print =<< (runCont $ runReader 7 $ test00' ())
- print =<< (runReader 7 $ runCont $ test00' ())
-
-test0 = do print =<< (runCont $ runReader 7 $ test0' ())
- print =<< (runReader 7 $ runCont $ test0' ())
-
-test1 = do print =<< (runCont $ runReader 7 $ test1' ())
- print =<< (runReader 7 $ runCont $ test1' ())
-
-test2 = do print =<< (runCont $ runWriter $ test2' ())
- print =<< (runWriter $ runCont $ test2' ())
-
-test3 = do print =<< (runCont $ runStateS 7 $ test3' ())
- print =<< (runStateS 7 $ runCont $ test3' ())
-
-test32 = do print =<< (runCont $ runStateS [] $ test32' ())
- print =<< (runStateS [] $ runCont $ test32' ())
-
-test33 = do print =<< (runCont $ runStateS [] $ test33' ())
- print =<< (runStateS [] $ runCont $ test33' ())
+++ /dev/null
-import Control.Monad.X.Error
-
-
-t1 = test (throwError "x") (Left "x" :: Either String Int)
-t2 = test (throwError "x" >>= undefined) (Left "x" :: Either String Int)
-t3 = test (throwError "x" `catchError` return) (Right "x")
-t4 = test (throwError "x" `catchError` throwError) (Left "x" :: Either String Int)
-t5 = test (return 3 `catchError` undefined) (Right 3:: Either String Int)
-
-
-test m e = runError m == e
-
-main = print $ and [t1,t2,t3,t4,t5]
-
+++ /dev/null
-import Control.Monad.X.Transformers
-
-test2' _ = tell "1" >> throwError '2' >> return ()
-test3' _ = put 1 >> throwError 2 >> return ()
-
-test2 = do print =<< (runError $ runWriter $ test2' ())
- print =<< (runWriter $ runError $ test2' ())
-
-test3 = do print =<< (runError $ runStateS 7 $ test3' ())
- print =<< (runStateS 7 $ runError $ test3' ())
-
+++ /dev/null
-import Control.Monad.X.Nondet
-
-assoc1 a b c = (a `mplus` b) `mplus` c
-assoc2 a b c = a `mplus` (b `mplus` c)
-
+++ /dev/null
-import Control.Monad.X.Reader
-
-
-t1 = test "x" ask "x"
-t2 = test "x" (local ('a':) ask) "ax"
-t3 = test "x"
- (do x <- ask
- y <- local ('a':) ask
- z <- ask
- return (x,y,z)) ("x","ax","x")
-t4 = test "x" (local ('a':) (local ('b':) ask)) "bax"
-
-test r m e = runReader r m == e
-
-main = print $ and [t1,t2,t3,t4]
-
+++ /dev/null
-import Control.Monad.X.ReaderT
-import Control.Monad.X.NondetT
-import Control.Monad.X.Identity
-
-t0,t1,t2 :: (MonadReader String m, MonadNondet m) => m String
-t0 = local ('a':) mzero
-t1 = (local ('a':) mzero) `mplus` ask
-t2 = local ('a':) (mzero `mplus` ask)
-
-
-run1 m = runIdentity $ runReader "x" $ runNondet $ m
-run2 m = runIdentity $ runNondet $ runReader "x" $ m
-
-test :: Eq a => (forall m. (MonadReader String m, MonadNondet m) => m a) -> Maybe a -> Bool
-test t r = run1 t == r && run2 t == r
-
-
-main = do print $ test t0 Nothing
- print $ test t1 (Just "x")
- print $ test t2 (Just "ax")
-
+++ /dev/null
-import Control.Monad.X.State
-
-
-t1 = test "x" get ("x","x")
-t2 = test "x" (put "y") ((),"y")
-t3 = test "x"
- (do x <- get
- put "y"
- y <- get
- return (x,y)) (("x","y"),"y")
-
-test s m e = runStateS s m == e
-
-main = print $ and [t1,t2,t3]
+++ /dev/null
-import Control.Monad.X.Writer
-
-
-t1 = test (tell "x") ((),"x")
-t2 = test (listen (tell "x")) (((),"x"),"")
-t3 = test
- (do tell "x"
- (_,y) <- listen (tell "y")
- tell "z"
- return y)
- ("y","xz")
-
-t4 = test (listen (listen (tell "x"))) ((((),"x"),""),"")
-
-test m e = runWriter m == e
-
-main = print $ and [t1,t2,t3,t4]
-
+++ /dev/null
-import Control.Monad.X.Transformers
-
-
-pr x = inBase (putStr $ show x ++ " ")
-
-
-
-
-test3' _ = pr "1" `mplus` pr "2"
-
--- writer & nonedt
-test4' _ = tell "1" `mplus` tell "2"
-test5' _ = listen (tell "1") `mplus` (tell "2" >> return ((),"77"))
-test6' _ = listen mzero `mplus` (tell "2" >> return ((),"77"))
-test7' _ = do (x,w) <- listen (tell "b")
- if w == "a" then mzero else return 7
-
-law3' _ = (m >>= f >>= g, m >>= \x -> f x >>= g)
- where m = pr "m" >> mplus (pr "1") (pr "2")
- f _ = pr "f" >> mplus (pr "3") (pr "4")
- g _ = pr "g" >> mplus (pr "5") (pr "6")
-
-law3 = do let (lhs,rhs) = law3' ()
- print =<< runNondets lhs
- print =<< runNondets rhs
-
-
-test8' _ = (tell "1" >> mzero) `mplus` tell "2"
-
-main = do -- x <- runWriter $ runNondets (test8' ())
- x <- runNondet $ runWriter $ test8' ()
- print x
-
-
-
projects / ghc-base.git / commitdiff