packages feed

contstuff 0.7.0 → 1.2.6

raw patch · 7 files changed

Files

Control/ContStuff.hs view
@@ -15,7 +15,9 @@        -- * Convenience reexports       module Control.Applicative,-      module Control.Monad+      module Control.Monad,+      module Control.Monad.IO.Class,+      module Control.Monad.Trans.Class     )     where @@ -26,3 +28,5 @@ import Control.ContStuff.Monads import Control.ContStuff.Trans import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Class
Control/ContStuff/Classes.hs view
@@ -16,24 +16,32 @@       Abortable(..),       -- ** Call with current continuation       CallCC(..), Label, labelCC, goto,+      -- ** Multithreading+      -- *** Forking+      Forkable(..),       -- ** Exceptions-      HasExceptions(..), bracket, bracket_, catch, finally, forbid,-                         handle, raiseUnless, raiseWhen, require,-      -- ** Lifting-      Transformer(..),-      LiftBase(..), io,-      -- ** Running-      Runnable(..),+      HasExceptions(..),+      bracket, bracket_, catch, finally, forbid, handle, raiseUnless,+      raiseWhen, require,+      -- ** Functor lifting+      LiftFunctor(..),       -- ** State-      Stateful(..), getField, modify, modifyField, modifyFieldLazy,-                    modifyLazy,+      -- *** Reading+      Readable(..),+      getField,+      -- *** Writing+      Stateful(..),+      modify, modifyField, modifyFieldLazy, modifyLazy,       -- ** Logging support (writers)       Writable(..)     )     where +import qualified Control.Concurrent as Conc import Control.Applicative+import Control.Concurrent hiding (forkIO, forkOS) import Control.Monad+import Control.Monad.Trans.Class import Prelude hiding (catch)  @@ -62,6 +70,8 @@     callCC :: ((a -> m b) -> m a) -> m a  +-- | A jump label for 'labelCC' and 'goto'.+ newtype Label m a = Label (a -> Label m a -> m ())  @@ -77,6 +87,25 @@ goto lk@(Label k) x = k x lk  +---------------------+-- Forkable monads --+---------------------++-- | Monads with support for forking threads.++class Monad m => Forkable m where+    -- | Generalization of 'Conc.forkIO'.+    forkIO :: m () -> m ThreadId++    -- | Generalization of 'Conc.forkOS'.+    forkOS :: m () -> m ThreadId+++instance Forkable IO where+    forkIO = Conc.forkIO+    forkOS = Conc.forkOS++ ---------------- -- Exceptions -- ----------------@@ -146,7 +175,7 @@  forbid ::     ( Exception (t m) ~ (), HasExceptions (t m),-      Monad m, Monad (t m), Transformer t ) =>+      Monad m, Monad (t m), MonadTrans t ) =>     m Bool -> t m () forbid = raiseWhen () . lift @@ -174,61 +203,50 @@  require ::     ( Exception (t m) ~ (), HasExceptions (t m),-      Monad m, Monad (t m), Transformer t ) =>+      Monad m, Monad (t m), MonadTrans t ) =>     m Bool -> t m () require = raiseUnless () . lift  ----------------- Lifting ----------------+------------------+-- Lift functor --+------------------ --- | Monads, which support lifting base monad computations.+-- | Type class for lifting functor computations. -class LiftBase m where-    -- | Base monad of @m@.-    type Base m :: * -> *+class LiftFunctor t where+    -- | Inner functor.+    type InnerFunctor t :: * -> * -    -- | Promote a base monad computation.-    base :: Base m a -> m a+    -- | Unwrap inner functor.+    liftF :: Monad m => m (InnerFunctor t a) -> t m a  --- | Handy alias for lifting 'IO' computations.+-----------+-- State --+----------- -io :: (LiftBase m, Base m ~ IO) => Base m a -> m a-io = base+-- | Monads with environment (reader monads). +class Readable m where+    -- | Environment type of @m@.+    type StateOf m ----------------- Running ----------------+    -- | Get the current state.+    get :: m (StateOf m) --- | Every monad transformer @t@ that supports transforming @t m a@ to--- @m a@ can be an instance of this class. -class Runnable t r m a where-    -- | Arguments needed to run.-    type Argument t r m a+-- | Get a certain field. -    -- | Run the transformer.-    runT :: Argument t r m a -> t m a -> m r+getField :: (Functor m, Readable m) => (StateOf m -> a) -> m a+getField = (<$> get)  --------------- State ------------------ | Stateful monads.+-- | Stateful monads, i.e. having a modifyable environment (stateful monads). ----- Minimal complete definition: 'StateOf', 'get' and 'putLazy'.+-- Minimal complete definition: 'putLazy'.  class Stateful m where-    -- | State type of @m@.-    type StateOf m--    -- | Get the current state.-    get :: m (StateOf m)-     -- | Set the current state and force it.     put :: StateOf m -> m ()     put x = x `seq` putLazy x@@ -237,49 +255,31 @@     putLazy :: StateOf m -> m ()  --- | Get a certain field.--getField :: (Functor m, Stateful m) => (StateOf m -> a) -> m a-getField = (<$> get)-- -- | Apply a function to the current state. -modify :: (Monad m, Stateful m) => (StateOf m -> StateOf m) -> m ()+modify :: (Monad m, Readable m, Stateful m) => (StateOf m -> StateOf m) -> m () modify f = liftM f get >>= put   -- | Get a field and modify the state. -modifyField :: (Monad m, Stateful m) =>+modifyField :: (Monad m, Readable m, Stateful m) =>                (StateOf m -> a) -> (a -> StateOf m) -> m () modifyField accessor f = liftM (f . accessor) get >>= put   -- | Get a field and modify the state.  Lazy version. -modifyFieldLazy :: (Monad m, Stateful m) =>+modifyFieldLazy :: (Monad m, Readable m, Stateful m) =>                    (StateOf m -> a) -> (a -> StateOf m) -> m () modifyFieldLazy accessor f = liftM (f . accessor) get >>= putLazy   -- | Apply a function to the current state.  Lazy version. -modifyLazy :: (Monad m, Stateful m) => (StateOf m -> StateOf m) -> m ()+modifyLazy :: (Monad m, Readable m, Stateful m) =>+              (StateOf m -> StateOf m) -> m () modifyLazy f = liftM f get >>= putLazy-------------------------------- Monad transformation --------------------------------- | The monad transformer class.  Lifting computations one level down--- the monad stack, or stated differently promoting a computation of the--- underlying monad to the transformer.--class Transformer t where-    -- | Promote a monadic computation to the transformer.-    lift :: Monad m => m a -> t m a   -------------
Control/ContStuff/Instances.hs view
@@ -14,7 +14,7 @@ import qualified Control.Exception as E import Control.ContStuff.Classes import Control.ContStuff.Trans-import Control.Monad.ST+import Control.Monad.Trans.Class   ----------------@@ -38,39 +38,28 @@   ----------------- LiftBase --+-- Readable -- -------------- -instance LiftBase Id where type Base Id = Id; base = id-instance LiftBase IO where type Base IO = IO; base = id-instance LiftBase Maybe where type Base Maybe = Maybe; base = id-instance LiftBase (ST s) where type Base (ST s) = ST s; base = id-instance LiftBase [] where type Base [] = []; base = id-instance LiftBase ((->) r) where type Base ((->) r) = (->) r; base = id--instance (LiftBase m, Monad m) => LiftBase (ChoiceT r i m) where-    type Base (ChoiceT r i m) = Base m-    base = lift . base--instance (LiftBase m, Monad m) => LiftBase (ContT r m) where-    type Base (ContT r m) = Base m-    base = lift . base+instance (Monad m, Readable m) => Readable (ChoiceT r i m) where+    type StateOf (ChoiceT r i m) = StateOf m+    get = lift get -instance (LiftBase m, Monad m) => LiftBase (EitherT r e m) where-    type Base (EitherT r e m) = Base m-    base = lift . base+instance (Monad m, Readable m) => Readable (ContT r m) where+    type StateOf (ContT r m) = StateOf m+    get = lift get -instance (LiftBase m, Monad m) => LiftBase (IdT m) where-    type Base (IdT m) = Base m-    base = lift . base+instance (Monad m, Readable m) => Readable (EitherT r e m) where+    type StateOf (EitherT r e m) = StateOf m+    get = lift get -instance (LiftBase m, Monad m) => LiftBase (MaybeT r m) where-    type Base (MaybeT r m) = Base m-    base = lift . base+instance (Monad m, Readable m) => Readable (IdentityT m) where+    type StateOf (IdentityT m) = StateOf m+    get = lift get -instance (LiftBase m, Monad m) => LiftBase (StateT r s m) where-    type Base (StateT r s m) = Base m-    base = lift . base+instance (Monad m, Readable m) => Readable (MaybeT r m) where+    type StateOf (MaybeT r m) = StateOf m+    get = lift get   --------------@@ -78,31 +67,21 @@ --------------  instance (Monad m, Stateful m) => Stateful (ChoiceT r i m) where-    type StateOf (ChoiceT r i m) = StateOf m-    get = lift get     put = lift . put     putLazy = lift . putLazy  instance (Monad m, Stateful m) => Stateful (ContT r m) where-    type StateOf (ContT r m) = StateOf m-    get = lift get     put = lift . put     putLazy = lift . putLazy  instance (Monad m, Stateful m) => Stateful (EitherT r e m) where-    type StateOf (EitherT r e m) = StateOf m-    get = lift get     put = lift . put     putLazy = lift . putLazy -instance (Monad m, Stateful m) => Stateful (IdT m) where-    type StateOf (IdT m) = StateOf m-    get = lift get+instance (Monad m, Stateful m) => Stateful (IdentityT m) where     put = lift . put     putLazy = lift . putLazy  instance (Monad m, Stateful m) => Stateful (MaybeT r m) where-    type StateOf (MaybeT r m) = StateOf m-    get = lift get     put = lift . put     putLazy = lift . putLazy
Control/ContStuff/Monads.hs view
@@ -14,6 +14,8 @@       Choice, listChoice, maybeChoice,       -- ** Cont       Cont, runCont, evalCont, modifyCont,+      -- ** Reader+      Reader, runReader,       -- ** State       State, runState, evalState, execState,       -- ** Writer@@ -23,6 +25,7 @@  import Control.Applicative import Control.ContStuff.Trans+import Data.Functor.Identity import Data.Monoid  @@ -32,19 +35,19 @@  -- | The choice monad.  Derived from 'ChoiceT'. -type Choice r i a = ChoiceT r i Id a+type Choice r i a = ChoiceT r i Identity a   -- | Get list of solutions.  listChoice :: Choice [a] [a] a -> [a]-listChoice = getId . listChoiceT+listChoice = runIdentity . listChoiceT   -- | Get one solution.  maybeChoice :: Choice (Maybe a) (Maybe a) a -> Maybe a-maybeChoice = getId . maybeChoiceT+maybeChoice = runIdentity . maybeChoiceT   ----------@@ -53,19 +56,19 @@  -- | Pure CPS monad derived from ContT. -type Cont r a = ContT r Id a+type Cont r a = ContT r Identity a   -- | Run a pure CPS computation.  runCont :: (a -> r) -> Cont r a -> r-runCont k (ContT c) = getId $ c (Id . k)+runCont k (ContT c) = runIdentity $ c (Identity . k)   -- | Evaluate a pure CPS computation to its final result.  evalCont :: Cont r r -> r-evalCont (ContT c) = getId $ c pure+evalCont (ContT c) = runIdentity $ c pure   -- | Modify the result of a CPS computation along the way.@@ -80,49 +83,64 @@  -- | The traditional writer monad. -type OldWriter r w a = ContT (r, w) Id a+type OldWriter r w a = ContT (r, w) Identity a   -- | Run a traditional writer computation.  runOldWriter :: Monoid w => OldWriter r w r -> (r, w)-runOldWriter = getId . runOldWriterT+runOldWriter = runIdentity . runOldWriterT   -- | Run a traditional writer computation and return its result.  evalOldWriter :: Monoid w => OldWriter r w r -> r-evalOldWriter = fst . getId . runOldWriterT+evalOldWriter = fst . runIdentity . runOldWriterT   -- | Run a traditional writer computation and return its log.  execOldWriter :: Monoid w => OldWriter r w r -> w-execOldWriter = snd . getId . runOldWriterT+execOldWriter = snd . runIdentity . runOldWriterT  +------------+-- Reader --+------------++-- | Pure computation with environment.++type Reader e a = ReaderT e Identity a+++-- | Run a pure computation with environment.++runReader :: e -> Reader e a -> a+runReader env = runIdentity . runReaderT env++ ----------- -- State -- -----------  -- | Pure state monad derived from StateT. -type State r s a = StateT r s Id a+type State r s a = StateT r s Identity a   -- | Run a stateful computation. -runState :: s -> (s -> a -> r) -> State r s a -> r-runState s0 k c = getId $ runStateT s0 (\s1 -> Id . k s1) c+runState :: s -> (a -> s -> r) -> State r s a -> r+runState s0 k c = runIdentity $ runStateT s0 (\x -> Identity . k x) c   -- | Run a stateful computation returning its result.  evalState :: s -> State r s r -> r-evalState = (getId .) . evalStateT+evalState = (runIdentity .) . evalStateT   -- | Run a stateful computation returning its result.  execState :: s -> State s s a -> s-execState = (getId .) . execStateT+execState = (runIdentity .) . execStateT
+ Control/ContStuff/Simple.hs view
@@ -0,0 +1,135 @@+-- |+-- Module:     Control.ContStuff.Simple+-- Copyright:  (c) 2010 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+-- Stability:  experimental+--+-- This module provides all the transformers from+-- "Control.ContStuff.Trans", but with a simplified interface, hiding+-- the underlying CPS machinery.++{-# LANGUAGE RankNTypes, TypeFamilies #-}++module Control.ContStuff.Simple+    ( -- * Choice/nondeterminism+      ChoiceT,+      choice, findAll, findAll_, findFirst, findFirst_,+      T.listA, listChoiceT, maybeChoiceT,++      -- * Exceptions+      EitherT,+      evalEitherT, testEitherT,++      MaybeT,+      evalMaybeT, testMaybeT,++      -- * Reader+      ReaderT,+      runReaderT,++      -- * State+      StateT,+      evalStateT, execStateT,++      -- * Writer+      WriterT,+      runWriterT, evalWriterT, execWriterT,++      -- * Reexports+      module Control.Applicative,+      module Control.ContStuff.Classes,+      module Control.Monad+    )+    where++import qualified Control.ContStuff.Trans as T+import Control.Applicative+import Control.ContStuff.Classes+import Control.ContStuff.Instances ()+import Control.ContStuff.Trans (ReaderT, runReaderT)+import Control.Monad+import Data.Monoid+++-------------+-- ChoiceT --+-------------++type ChoiceT m a = forall r i. T.ChoiceT r i m a++choice :: [a] -> ChoiceT m a+choice xs = T.choice xs++findAll :: (Alternative f, Applicative m) => ChoiceT m a -> m (f a)+findAll c = T.findAll c++findAll_ :: Applicative m => ChoiceT m a -> m ()+findAll_ c = T.findAll_ c++findFirst :: (Alternative f, Applicative m) => ChoiceT m a -> m (f a)+findFirst c = T.findFirst c++findFirst_ :: Applicative m => ChoiceT m a -> m ()+findFirst_ c = T.findFirst_ c++listChoiceT :: Applicative m => ChoiceT m a -> m [a]+listChoiceT c = T.listChoiceT c++maybeChoiceT :: Applicative m => ChoiceT m a -> m (Maybe a)+maybeChoiceT c = T.maybeChoiceT c+++-------------+-- EitherT --+-------------++type EitherT e m a = forall r. T.EitherT r e m a++evalEitherT :: Applicative m => EitherT e m a -> m (Either e a)+evalEitherT c = T.evalEitherT c++testEitherT :: Applicative m => EitherT e m a -> m Bool+testEitherT c = T.testEitherT c+++------------+-- MaybeT --+------------++type MaybeT m a = forall r. T.MaybeT r m a++evalMaybeT :: Applicative m => MaybeT m a -> m (Maybe a)+evalMaybeT c = T.evalMaybeT c++testMaybeT :: Applicative m => MaybeT m a -> m Bool+testMaybeT c = T.testMaybeT c+++------------+-- StateT --+------------++type StateT s m a = forall r. T.StateT r s m a++evalStateT :: Applicative m => s -> StateT s m a -> m a+evalStateT s0 c = T.evalStateT s0 c++execStateT :: Applicative m => s -> StateT s m a -> m s+execStateT s0 c = T.execStateT s0 c+++-------------+-- WriterT --+-------------++type WriterT w m a = forall r. T.OldWriterT r w m a++runWriterT :: (Applicative m, Monoid w) => WriterT w m a -> m (a, w)+runWriterT c = T.runOldWriterT c++evalWriterT :: (Applicative m, Monoid w) => WriterT w m a -> m a+evalWriterT c = fmap fst . T.runOldWriterT $ c++execWriterT :: (Applicative m, Monoid w) => WriterT w m a -> m w+execWriterT c = fmap snd . T.runOldWriterT $ c
Control/ContStuff/Trans.hs view
@@ -8,66 +8,61 @@ -- This module implements a number of monad transformers using a CPS -- approach internally. -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}+{-# LANGUAGE+  FlexibleInstances,+  MultiParamTypeClasses,+  RankNTypes,+  TypeFamilies #-}  module Control.ContStuff.Trans-    ( -- * The identity monad-      Id(..),--      -- * Monad transformers+    ( -- * Monad transformers       -- ** Identity transformer-      IdT(..),+      IdentityT(..),+       -- ** ContT-      ContT(..), runContT, evalContT, modifyContT,+      ContT(..),+      runContT, evalContT, modifyContT,+       -- ** Choice/nondeterminism-      ChoiceT(..), runChoiceT, choice, findAll, findAll_, findFirst,-                   findFirst_, listA, listChoiceT, maybeChoiceT,+      ChoiceT(..),+      runChoiceT, choice, findAll, findAll_, findFirst,+      findFirst_, listA, listChoiceT, maybeChoiceT,+       -- ** Exceptions-      EitherT(..), runEitherT, evalEitherT, modifyEitherT,-      MaybeT(..), runMaybeT, evalMaybeT, modifyMaybeT,+      EitherT(..),+      runEitherT, evalEitherT, modifyEitherT, testEitherT,++      MaybeT(..),+      runMaybeT, evalMaybeT, modifyMaybeT, testMaybeT,+       -- ** State-      StateT(..), runStateT, evalStateT, execStateT,+      ReaderT,+      forkReaderT,+      runReaderT,++      StateT(..),+      runStateT, evalStateT, execStateT,+       -- ** Writer monads-      WriterT, runWriterT,-      OldWriterT, runOldWriterT, evalOldWriterT, execOldWriterT+      WriterT,+      runWriterT,++      OldWriterT,+      runOldWriterT, evalOldWriterT, execOldWriterT     )     where  import Control.Applicative import Control.Arrow+import Control.Concurrent hiding (forkIO, forkOS) import Control.ContStuff.Classes import Control.Monad-import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.Identity import Data.Monoid  ---------------------------- The identity monad ------------------------------- | The identity monad.  This monad represents values themselves,--- i.e. computations without effects.--newtype Id a = Id { getId :: a }--instance Functor Id where-    fmap f (Id x) = Id (f x)--instance Applicative Id where-    pure = Id-    Id f <*> Id x = Id (f x)--instance Monad Id where-    return = Id-    Id x >>= f = f x--instance MonadFix Id where-    mfix f = fix (f . getId)--instance Show a => Show (Id a) where-    show x = "Id " ++ show x-- ------------- -- ChoiceT -- -------------@@ -99,22 +94,33 @@         ChoiceT $ \fold z k ->             cx (\xx yx kx -> cf (\xf yf kf -> fold xf (yf yx) kf) xx kx) z k +instance (Applicative m, Forkable m) => Forkable (ChoiceT r i m) where+    forkIO = lift . forkIO . findAll_+    forkOS = lift . forkOS . findAll_+ instance Functor (ChoiceT r i m) where     fmap f (ChoiceT c) =         ChoiceT $ \fold z k ->             c (\x y k -> fold x (f y) k) z k +instance LiftFunctor (ChoiceT r i) where+    type InnerFunctor (ChoiceT r i) = []+    liftF c = lift c >>= choice+ instance Monad (ChoiceT r i m) where     return x = ChoiceT $ \fold z k -> fold z x k     ChoiceT c >>= f =         ChoiceT $ \fold z k ->             c (\x y kc -> getChoiceT (f y) fold x kc) z k +instance MonadIO m => MonadIO (ChoiceT r i m) where+    liftIO = lift . liftIO+ instance MonadPlus (ChoiceT r i m) where     mzero = empty     mplus = (<|>) -instance Transformer (ChoiceT r i) where+instance MonadTrans (ChoiceT r i) where     lift c = ChoiceT $ \fold z k -> c >>= \x -> fold z x k  @@ -146,8 +152,10 @@  -- | Find all solutions and ignore them. -findAll_ :: Applicative m => ChoiceT () i m a -> m ()-findAll_ = runChoiceT (\_ _ k -> k undefined) undefined (const $ pure ())+findAll_ :: Applicative m => ChoiceT r i m a -> m ()+findAll_ =+    (() <$) .+    runChoiceT (\_ _ k -> k undef) undef (const $ pure undef)   -- | Find the first solution.@@ -158,8 +166,10 @@  -- | Find the first solution and ignore it. -findFirst_ :: Applicative m => ChoiceT () i m a -> m ()-findFirst_ = runChoiceT (\_ _ _ -> pure ()) undefined (const $ pure ())+findFirst_ :: Applicative m => ChoiceT r i m a -> m ()+findFirst_ =+    (() <$) .+    runChoiceT (\_ _ _ -> pure undef) undef (const $ pure undef)   -- | Turn a list into a computation with alternatives.@@ -207,6 +217,10 @@ instance CallCC (ContT r m) where     callCC f = ContT $ \k -> getContT (f (ContT . const . k)) k +instance Forkable m => Forkable (ContT () m) where+    forkIO (ContT c) = ContT $ \k -> forkIO (c toUnitM) >>= k+    forkOS (ContT c) = ContT $ \k -> forkOS (c toUnitM) >>= k+ instance Functor (ContT r m) where     fmap f (ContT c) = ContT $ \k -> c (\x -> k (f x)) @@ -219,11 +233,10 @@     mzero = empty     mplus = (<|>) -instance Runnable (ContT r) r m a where-    type Argument (ContT r) r m a = a -> m r-    runT k (ContT c) = c k+instance MonadIO m => MonadIO (ContT r m) where+    liftIO = lift . liftIO -instance Transformer (ContT r) where+instance MonadTrans (ContT r) where     lift c = ContT $ \k -> c >>= k  instance Alternative m => Writable (ContT r m) r where@@ -280,14 +293,22 @@         EitherT $ \k expk ->             getEitherT (f (\x -> EitherT $ \_ _ -> k x)) k expk +instance Forkable m => Forkable (EitherT () e m) where+    forkIO (EitherT c) = lift . forkIO $ c toUnitM toUnitM+    forkOS (EitherT c) = lift . forkOS $ c toUnitM toUnitM++instance Functor (EitherT r e m) where+    fmap f (EitherT c) =+        EitherT $ \k expk -> c (k . f) expk+ instance HasExceptions (EitherT r e m) where     type Exception (EitherT r e m) = e     raise exp = EitherT $ \_ expk -> expk exp     try (EitherT c) = EitherT $ \k _ -> c (k . Right) (k . Left) -instance Functor (EitherT r e m) where-    fmap f (EitherT c) =-        EitherT $ \k expk -> c (k . f) expk+instance LiftFunctor (EitherT r e) where+    type InnerFunctor (EitherT r e) = Either e+    liftF c = EitherT $ \k expk -> c >>= either expk k  instance Monad (EitherT r e m) where     return x = EitherT $ \k _ -> k x@@ -295,15 +316,14 @@         EitherT $ \k expk ->             c (\x -> getEitherT (f x) k expk) expk +instance MonadIO m => MonadIO (EitherT r e m) where+    liftIO = lift . liftIO+ instance Alternative m => MonadPlus (EitherT r e m) where     mzero = empty     mplus = (<|>) -instance Runnable (EitherT r e) r m a where-    type Argument (EitherT r e) r m a = (a -> m r, e -> m r)-    runT (k, expk) (EitherT c) = c k expk--instance Transformer (EitherT r e) where+instance MonadTrans (EitherT r e) where     lift c = EitherT $ \k _ -> c >>= k  instance Alternative m => Writable (EitherT r e m) r where@@ -331,45 +351,14 @@ modifyEitherT f = EitherT $ \k _ -> fmap f (k ())  ------------- IdT ---------------- | The identity monad transformer.  This monad transformer represents--- computations themselves without further side effects.  Unlike most--- other monad transformers in this module it is not implemented in--- terms of continuation passing style.--newtype IdT m a = IdT { getIdT :: m a }--instance Alternative m => Alternative (IdT m) where-    empty = IdT empty-    IdT c <|> IdT d = IdT (c <|> d)--instance Applicative m => Applicative (IdT m) where-    pure = IdT . pure-    IdT cf <*> IdT cx = IdT $ cf <*> cx--instance Functor m => Functor (IdT m) where-    fmap f (IdT c) = IdT (fmap f c)--instance Monad m => Monad (IdT m) where-    return = IdT . return-    IdT c >>= f = IdT $ c >>= getIdT . f--instance (Alternative m, Monad m) => MonadPlus (IdT m) where-    mzero = empty-    mplus = (<|>)--instance MonadFix m => MonadFix (IdT m) where-    mfix f = IdT $ mfix (getIdT . f)--instance Runnable IdT r m r where-    type Argument IdT r m r = ()-    runT _ (IdT c) = c+-- | Run the 'EitherT' computation and return 'True', if it results in a+-- right value, 'False' otherwise. -instance Transformer IdT where-    lift = IdT+testEitherT :: Applicative m => EitherT Bool e m a -> m Bool+testEitherT =+    let pc :: Applicative m => a -> b -> m a+        pc x = pure . const x+    in runEitherT (pc True) (pc False)   ------------@@ -402,6 +391,10 @@         MaybeT $ \just noth ->             getMaybeT (f (\x -> MaybeT $ \_ _ -> just x)) just noth +instance Forkable m => Forkable (MaybeT () m) where+    forkIO (MaybeT c) = lift . forkIO $ c toUnitM (return ())+    forkOS (MaybeT c) = lift . forkOS $ c toUnitM (return ())+ instance HasExceptions (MaybeT r m) where     type Exception (MaybeT r m) = ()     raise _ = MaybeT $ const id@@ -411,21 +404,24 @@     fmap f (MaybeT c) =         MaybeT $ \just noth -> c (just . f) noth +instance LiftFunctor (MaybeT r) where+    type InnerFunctor (MaybeT r) = Maybe+    liftF c = MaybeT $ \just nothing -> c >>= maybe nothing just+ instance Monad (MaybeT r m) where     return x = MaybeT $ \just _ -> just x     MaybeT c >>= f =         MaybeT $ \just noth ->             c (\x -> getMaybeT (f x) just noth) noth +instance MonadIO m => MonadIO (MaybeT r m) where+    liftIO = lift . liftIO+ instance Alternative m => MonadPlus (MaybeT r m) where     mzero = empty     mplus = (<|>) -instance Runnable (MaybeT r) r m a where-    type Argument (MaybeT r) r m a = (a -> m r, m r)-    runT (just, noth) (MaybeT c) = c just noth--instance Transformer (MaybeT r) where+instance MonadTrans (MaybeT r) where     lift c = MaybeT $ \just _ -> c >>= just  instance Alternative m => Writable (MaybeT r m) r where@@ -453,6 +449,13 @@ modifyMaybeT f = MaybeT $ \just _ -> fmap f (just ())  +-- | Run the 'MaybeT' computation and return 'True', if it results in a+-- Just value, 'False' otherwise.++testMaybeT :: Applicative m => MaybeT Bool m a -> m Bool+testMaybeT = runMaybeT (pure . const True) (pure False)++ ---------------- -- OldWriterT -- ----------------@@ -480,6 +483,56 @@ execOldWriterT = fmap snd . runOldWriterT  +-------------+-- ReaderT --+-------------++-- | Monad transformer for computations with readable environment.+-- Unlike the other monad transformers this one allows no CPS effects+-- and also hides its constructors, which makes it commutative.+--+-- If you need CPS effects, consider using 'StateT'.++newtype ReaderT e m a =+    ReaderT { getReaderT :: forall r. StateT r e m a }++instance Applicative (ReaderT e m) where+    pure = return+    ReaderT cf <*> ReaderT cx = ReaderT (cf <*> cx)++instance Functor (ReaderT e m) where+    fmap f (ReaderT c) = ReaderT (fmap f c)++instance Monad (ReaderT e m) where+    return x = ReaderT (return x)+    ReaderT c >>= f =+        ReaderT (c >>= getReaderT . f)++instance MonadIO m => MonadIO (ReaderT e m) where+    liftIO c = ReaderT (liftIO c)++instance Readable (ReaderT e m) where+    type StateOf (ReaderT e m) = e+    get = ReaderT get++instance MonadTrans (ReaderT e) where+    lift c = ReaderT (lift c)+++-- | Fork a concurrent thread for a computation with environment.++forkReaderT :: (Applicative m, Forkable m) => ReaderT e m () -> ReaderT e m ThreadId+forkReaderT c = do+    env <- get+    lift $ forkIO (runReaderT env c)+++-- | Run a computation with environment.++runReaderT :: Applicative m => e -> ReaderT e m a -> m a+runReaderT x (ReaderT s) = evalStateT x s++ ------------ -- StateT -- ------------@@ -487,7 +540,7 @@ -- | Monad transformer for stateful computations.  newtype StateT r s m a =-    StateT { getStateT :: s -> (s -> a -> m r) -> m r }+    StateT { getStateT :: (a -> s -> m r) -> s -> m r }  instance Applicative m => Abortable (StateT r s m) where     type Result (StateT r s m) = r@@ -496,67 +549,67 @@ instance Alternative m => Alternative (StateT r s m) where     empty = StateT . const . const $ empty     StateT c <|> StateT d =-        StateT $ \s0 k -> c s0 k <|> d s0 k+        StateT $ \k s0 -> c k s0 <|> d k s0  instance Applicative (StateT r s m) where     pure = return-    StateT cf <*> StateT cx =-        StateT $ \s0 k -> cf s0 (\s1 f -> cx s1 (\s2 x -> k s2 (f x)))+    StateT cf <*> StateT cx = StateT $ \k -> cf (\f -> cx (k . f))  instance CallCC (StateT r s m) where-    callCC f =-        StateT $ \s0 k ->-            getStateT (f (\x -> StateT $ \s1 _ -> k s1 x)) s0 k+    callCC f = StateT $ \k -> getStateT (f (\x -> StateT $ \_ -> k x)) k +instance Forkable m => Forkable (StateT () s m) where+    forkIO (StateT c) = StateT $ \k s0 -> forkIO (c (\_ _ -> return ()) s0) >>= flip k s0+    forkOS (StateT c) = StateT $ \k s0 -> forkOS (c (\_ _ -> return ()) s0) >>= flip k s0+ instance Functor (StateT r s m) where-    fmap f (StateT c) =-        StateT $ \s0 k -> c s0 (\s1 -> k s1 . f)+    fmap f (StateT c) = StateT $ \k -> c (k . f)  instance Monad (StateT r s m) where-    return x = StateT $ \s0 k -> k s0 x-    StateT c >>= f =-        StateT $ \s0 k -> c s0 (\s1 x -> getStateT (f x) s1 k)+    return x = StateT ($ x)+    StateT c >>= f = StateT $ \k -> c (\x -> getStateT (f x) k) +instance MonadIO m => MonadIO (StateT r s m) where+    liftIO = lift . liftIO+ instance Alternative m => MonadPlus (StateT r s m) where     mzero = empty     mplus = (<|>) -instance Runnable (StateT r s) r m a where-    type Argument (StateT r s) r m a = (s, s -> a -> m r)-    runT (s0, k) (StateT c) = c s0 k+instance Readable (StateT r s m) where+    type StateOf (StateT r s m) = s+    get = StateT $ \k s0 -> k s0 s0  instance Stateful (StateT r s m) where-    type StateOf (StateT r s m) = s-    get = StateT $ \s0 k -> k s0 s0-    put s1 = s1 `seq` StateT $ \_ k -> k s1 ()-    putLazy s1 = StateT $ \_ k -> k s1 ()+    put s1 = s1 `seq` StateT $ \k -> const (k () s1)+    putLazy s1 = StateT $ \k -> const (k () s1) -instance Transformer (StateT r s) where-    lift c = StateT $ \s0 k -> c >>= k s0+instance MonadTrans (StateT r s) where+    lift c = StateT $ \k s0 -> c >>= flip k s0  instance Alternative m => Writable (StateT r s m) r where-    tell x = StateT $ \s0 k -> pure x <|> k s0 ()+    tell x = StateT $ \k s0 -> pure x <|> k () s0  instance (Functor m, Monoid w) => Writable (StateT (r, w) s m) w where-    tell x = StateT $ \s0 k -> fmap (second (`mappend` x)) (k s0 ())+    tell x = StateT $ \k -> fmap (second (`mappend` x)) . k ()   -- | Run a state transformer. -runStateT :: s -> (s -> a -> m r) -> StateT r s m a -> m r-runStateT s0 k (StateT c) = c s0 k+runStateT :: s -> (a -> s -> m r) -> StateT r s m a -> m r+runStateT s0 k (StateT c) = c k s0   -- | Run a state transformer returning its result.  evalStateT :: Applicative m => s -> StateT r s m r -> m r-evalStateT s0 (StateT c) = c s0 (\_ x -> pure x)+evalStateT s0 (StateT c) = c (\x -> const (pure x)) s0   -- | Run a state transformer returning its final state.  execStateT :: Applicative m => s -> StateT s s m a -> m s-execStateT s0 (StateT c) = c s0 (\s1 _ -> pure s1)+execStateT s0 (StateT c) = c (\_ s1 -> pure s1) s0   -------------@@ -572,3 +625,19 @@  runWriterT :: Alternative m => WriterT r m a -> m r runWriterT (ContT c) = c (const empty)+++----------------------+-- Helper functions --+----------------------++-- | Turn an arbitrary pure value into a monadic bottom.++toUnitM :: Monad m => a -> m ()+toUnitM = return . const undef+++-- | The undefined value with a more descriptive error message.++undef :: a+undef = error "contstuff: Undefined value evaluated. This is a bug!"
contstuff.cabal view
@@ -1,7 +1,7 @@ Name:          contstuff-Version:       0.7.0+Version:       1.2.6 Category:      Control, Monads-Synopsis:      Fast, easy to use CPS-based monads+Synopsis:      Fast, easy to use CPS-based monad transformers Maintainer:    Ertugrul Söylemez <es@ertes.de> Author:        Ertugrul Söylemez <es@ertes.de> Copyright:     (c) 2010 Ertugrul Söylemez@@ -13,23 +13,27 @@ Cabal-version: >= 1.6 Description: -  This library implements fast and easy to use CPS-based monad-  transformers.  Most of the usual monad transformers are implemented,-  including ChoiceT, ContT, EitherT, MaybeT and StateT.  Because of the-  design of this library, many other monad transformers are just special-  cases of those, including e.g. WriterT.+    This library implements fast and easy to use CPS-based monad+    transformers.  Most of the usual monad transformers are implemented,+    including ChoiceT, ContT, EitherT, MaybeT and StateT.  Because of+    the design of this library, many other monad transformers are just+    special cases of those, including e.g. ReaderT and WriterT. +    The Control.ContStuff.Simple module also provides simplified monad+    transformer wrappers, which hide the underlying CPS, so you get the+    full performance, but with a simplified interface.  Currently the+    simplified monad transformers are implemented as type synonyms, so+    their flexibility is slightly limited.+ Library-  Build-depends:-    base >= 4 && <= 5-  GHC-Options:   -W-  Extensions:-    FlexibleInstances,-    MultiParamTypeClasses,-    TypeFamilies-  Exposed-modules:-    Control.ContStuff-    Control.ContStuff.Classes-    Control.ContStuff.Instances-    Control.ContStuff.Monads-    Control.ContStuff.Trans+    Build-depends:+        base >= 4 && <= 5,+        transformers >= 0.2.2.0+    GHC-Options: -W+    Exposed-modules:+        Control.ContStuff+        Control.ContStuff.Classes+        Control.ContStuff.Instances+        Control.ContStuff.Monads+        Control.ContStuff.Simple+        Control.ContStuff.Trans