Added a first version of the new monad library (experimental).
Hopefully one day the "X" will disappear.
--- /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