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