Control/Monad/X/ContT.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 (multi-parameter type classes)
  10 --
  11 -- Continuation monads.
  12 --
  13 -----------------------------------------------------------------------------
  14
  15 module Control.Monad.X.ContT (
  16         ContT,
  17         runCont,
  18         runContT,
  19         mapContT,
  20         withContT,
  21         module T
  22   ) where
  23
  24 import Prelude (Functor(..),Monad(..),(.),fst,error)
  25 import Control.Monad(liftM,MonadPlus(..))
  26
  27 import Control.Monad.X.Trans as T
  28 import Control.Monad.X.Utils
  29 import Control.Monad.X.Types(ContT(..))
  30
  31
  32 -- unfiinished
  33
  34
  35 instance MonadTrans (ContT r) where
  36   lift m      = C (m >>=)
  37
  38 instance HasBaseMonad m n => HasBaseMonad (ContT r m) n where
  39   inBase      = inBase'
  40
  41 instance (Monad m) => Functor (ContT r m) where
  42   fmap        = liftM
  43
  44 instance (Monad m) => Monad (ContT r m) where
  45   return      = return'
  46   m >>= k     = C (\c -> m $$ (\a -> k a $$ c))
  47
  48
  49 runCont       :: Monad m => ContT r m r -> m r
  50 runCont  m    = m $$ return
  51
  52 runContT      = ($$)
  53
  54 mapContT      :: (m r -> m r) -> ContT r m a -> ContT r m a
  55 mapContT f m  = C (f . (m $$))
  56
  57 withContT :: ((b -> m r) -> (a -> m r)) -> ContT r m a -> ContT r m b
  58 withContT f m = C ((m $$) . f)
  59
  60 ($$)          = unC
  61
  62 -- (a -> (e -> m a)) -> e -> m a
  63
  64 instance (MonadReader r' m) => MonadReader r' (ContT r m) where
  65   ask         = ask'
  66   local f m   = C (\k -> do r <- ask
  67                             local f (m $$ (\a -> localSet r (k a))))
  68
  69
  70 instance (MonadWriter w m) => MonadWriter w (ContT r m) where
  71   tell        = tell'
  72   listen      = error "listen: continuations after writer not implemenetd (yet?)"
  73
  74 instance (MonadState s m) => MonadState s (ContT r m) where
  75   get         = get'
  76   put         = put'
  77
  78 instance (MonadError e m) => MonadError e (ContT r m) where
  79   throwError  = throwError'
  80   catchError  = catchError2' C ($$)
  81
  82 instance MonadPlus m => MonadPlus (ContT r m) where
  83   mzero       = mzero
  84   mplus       = mplus2' C ($$)
  85
  86 instance (Monad m) => MonadCont (ContT r m) where
  87   callCC f    = C (\c -> f (\a -> C (\_ -> c a)) $$ c)
  88
  89
  90