Control/Monad/Cont.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Control.Monad.Cont
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/core/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable
  10 --
  11 -- $Id: Cont.hs,v 1.2 2002/04/24 16:31:38 simonmar Exp $
  12 --
  13 -- Continuation monads.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module Control.Monad.Cont (
  18         MonadCont(..),
  19         Cont(..),
  20         runCont,
  21         mapCont,
  22         withCont,
  23         ContT(..),
  24         runContT,
  25         mapContT,
  26         withContT,
  27         module Control.Monad,
  28         module Control.Monad.Trans,
  29   ) where
  30
  31 import Prelude
  32
  33 import Control.Monad
  34 import Control.Monad.Trans
  35 import Control.Monad.Reader
  36 import Control.Monad.Writer
  37 import Control.Monad.State
  38 import Control.Monad.RWS
  39
  40 class (Monad m) => MonadCont m where
  41         callCC :: ((a -> m b) -> m a) -> m a
  42
  43 -- ---------------------------------------------------------------------------
  44 -- Our parameterizable continuation monad
  45
  46 newtype Cont r a = Cont { runCont :: (a -> r) -> r }
  47
  48 instance Functor (Cont r) where
  49         fmap f m = Cont $ \c -> runCont m (c . f)
  50
  51 instance Monad (Cont r) where
  52         return a = Cont ($ a)
  53         m >>= k  = Cont $ \c -> runCont m $ \a -> runCont (k a) c
  54
  55 instance MonadCont (Cont r) where
  56         callCC f = Cont $ \c -> runCont (f (\a -> Cont $ \_ -> c a)) c
  57
  58 mapCont :: (r -> r) -> Cont r a -> Cont r a
  59 mapCont f m = Cont $ f . runCont m
  60
  61 withCont :: ((b -> r) -> (a -> r)) -> Cont r a -> Cont r b
  62 withCont f m = Cont $ runCont m . f
  63
  64 -- ---------------------------------------------------------------------------
  65 -- Our parameterizable continuation monad, with an inner monad
  66
  67 newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }
  68
  69 instance (Monad m) => Functor (ContT r m) where
  70         fmap f m = ContT $ \c -> runContT m (c . f)
  71
  72 instance (Monad m) => Monad (ContT r m) where
  73         return a = ContT ($ a)
  74         m >>= k  = ContT $ \c -> runContT m (\a -> runContT (k a) c)
  75
  76 instance (Monad m) => MonadCont (ContT r m) where
  77         callCC f = ContT $ \c -> runContT (f (\a -> ContT $ \_ -> c a)) c
  78
  79 instance MonadTrans (ContT r) where
  80         lift m = ContT (m >>=)
  81
  82 instance (MonadIO m) => MonadIO (ContT r m) where
  83         liftIO = lift . liftIO
  84
  85 instance (MonadReader r' m) => MonadReader r' (ContT r m) where
  86         ask       = lift ask
  87         local f m = ContT $ \c -> do
  88                 r <- ask
  89                 local f (runContT m (local (const r) . c))
  90
  91 instance (MonadState s m) => MonadState s (ContT r m) where
  92         get = lift get
  93         put = lift . put
  94
  95 -- -----------------------------------------------------------------------------
  96 -- MonadCont instances for other monad transformers
  97
  98 instance (MonadCont m) => MonadCont (ReaderT r m) where
  99         callCC f = ReaderT $ \r ->
 100                 callCC $ \c ->
 101                 runReaderT (f (\a -> ReaderT $ \_ -> c a)) r
 102
 103 instance (MonadCont m) => MonadCont (StateT s m) where
 104         callCC f = StateT $ \s ->
 105                 callCC $ \c ->
 106                 runStateT (f (\a -> StateT $ \s' -> c (a, s'))) s
 107
 108 instance (Monoid w, MonadCont m) => MonadCont (WriterT w m) where
 109         callCC f = WriterT $
 110                 callCC $ \c ->
 111                 runWriterT (f (\a -> WriterT $ c (a, mempty)))
 112
 113 instance (Monoid w, MonadCont m) => MonadCont (RWST r w s m) where
 114         callCC f = RWST $ \r s ->
 115                 callCC $ \c ->
 116                 runRWST (f (\a -> RWST $ \_ s' -> c (a, s', mempty))) r s
 117
 118 mapContT :: (m r -> m r) -> ContT r m a -> ContT r m a
 119 mapContT f m = ContT $ f . runContT m
 120
 121 withContT :: ((b -> m r) -> (a -> m r)) -> ContT r m a -> ContT r m b
 122 withContT f m = ContT $ runContT m . f