diff options
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Cont.hs')
| -rw-r--r-- | third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Cont.hs | 240 |
1 files changed, 240 insertions, 0 deletions
diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Cont.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Cont.hs new file mode 100644 index 0000000000..ce2005d4b2 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Cont.hs @@ -0,0 +1,240 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Safe #-} +#endif +#if __GLASGOW_HASKELL__ >= 706 +{-# LANGUAGE PolyKinds #-} +#endif +#if __GLASGOW_HASKELL__ >= 710 +{-# LANGUAGE AutoDeriveTypeable #-} +#endif +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.Trans.Cont +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : R.Paterson@city.ac.uk +-- Stability : experimental +-- Portability : portable +-- +-- Continuation monads. +-- +-- Delimited continuation operators are taken from Kenichi Asai and Oleg +-- Kiselyov's tutorial at CW 2011, \"Introduction to programming with +-- shift and reset\" (<http://okmij.org/ftp/continuations/#tutorial>). +-- +----------------------------------------------------------------------------- + +module Control.Monad.Trans.Cont ( + -- * The Cont monad + Cont, + cont, + runCont, + evalCont, + mapCont, + withCont, + -- ** Delimited continuations + reset, shift, + -- * The ContT monad transformer + ContT(..), + evalContT, + mapContT, + withContT, + callCC, + -- ** Delimited continuations + resetT, shiftT, + -- * Lifting other operations + liftLocal, + ) where + +import Control.Monad.IO.Class +import Control.Monad.Trans.Class +import Data.Functor.Identity + +import Control.Applicative +#if MIN_VERSION_base(4,9,0) +import qualified Control.Monad.Fail as Fail +#endif + +{- | +Continuation monad. +@Cont r a@ is a CPS ("continuation-passing style") computation that produces an +intermediate result of type @a@ within a CPS computation whose final result type +is @r@. + +The @return@ function simply creates a continuation which passes the value on. + +The @>>=@ operator adds the bound function into the continuation chain. +-} +type Cont r = ContT r Identity + +-- | Construct a continuation-passing computation from a function. +-- (The inverse of 'runCont') +cont :: ((a -> r) -> r) -> Cont r a +cont f = ContT (\ c -> Identity (f (runIdentity . c))) +{-# INLINE cont #-} + +-- | The result of running a CPS computation with a given final continuation. +-- (The inverse of 'cont') +runCont + :: Cont r a -- ^ continuation computation (@Cont@). + -> (a -> r) -- ^ the final continuation, which produces + -- the final result (often 'id'). + -> r +runCont m k = runIdentity (runContT m (Identity . k)) +{-# INLINE runCont #-} + +-- | The result of running a CPS computation with the identity as the +-- final continuation. +-- +-- * @'evalCont' ('return' x) = x@ +evalCont :: Cont r r -> r +evalCont m = runIdentity (evalContT m) +{-# INLINE evalCont #-} + +-- | Apply a function to transform the result of a continuation-passing +-- computation. +-- +-- * @'runCont' ('mapCont' f m) = f . 'runCont' m@ +mapCont :: (r -> r) -> Cont r a -> Cont r a +mapCont f = mapContT (Identity . f . runIdentity) +{-# INLINE mapCont #-} + +-- | Apply a function to transform the continuation passed to a CPS +-- computation. +-- +-- * @'runCont' ('withCont' f m) = 'runCont' m . f@ +withCont :: ((b -> r) -> (a -> r)) -> Cont r a -> Cont r b +withCont f = withContT ((Identity .) . f . (runIdentity .)) +{-# INLINE withCont #-} + +-- | @'reset' m@ delimits the continuation of any 'shift' inside @m@. +-- +-- * @'reset' ('return' m) = 'return' m@ +-- +reset :: Cont r r -> Cont r' r +reset = resetT +{-# INLINE reset #-} + +-- | @'shift' f@ captures the continuation up to the nearest enclosing +-- 'reset' and passes it to @f@: +-- +-- * @'reset' ('shift' f >>= k) = 'reset' (f ('evalCont' . k))@ +-- +shift :: ((a -> r) -> Cont r r) -> Cont r a +shift f = shiftT (f . (runIdentity .)) +{-# INLINE shift #-} + +-- | The continuation monad transformer. +-- Can be used to add continuation handling to any type constructor: +-- the 'Monad' instance and most of the operations do not require @m@ +-- to be a monad. +-- +-- 'ContT' is not a functor on the category of monads, and many operations +-- cannot be lifted through it. +newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r } + +-- | The result of running a CPS computation with 'return' as the +-- final continuation. +-- +-- * @'evalContT' ('lift' m) = m@ +evalContT :: (Monad m) => ContT r m r -> m r +evalContT m = runContT m return +{-# INLINE evalContT #-} + +-- | Apply a function to transform the result of a continuation-passing +-- computation. This has a more restricted type than the @map@ operations +-- for other monad transformers, because 'ContT' does not define a functor +-- in the category of monads. +-- +-- * @'runContT' ('mapContT' f m) = f . 'runContT' m@ +mapContT :: (m r -> m r) -> ContT r m a -> ContT r m a +mapContT f m = ContT $ f . runContT m +{-# INLINE mapContT #-} + +-- | Apply a function to transform the continuation passed to a CPS +-- computation. +-- +-- * @'runContT' ('withContT' f m) = 'runContT' m . f@ +withContT :: ((b -> m r) -> (a -> m r)) -> ContT r m a -> ContT r m b +withContT f m = ContT $ runContT m . f +{-# INLINE withContT #-} + +instance Functor (ContT r m) where + fmap f m = ContT $ \ c -> runContT m (c . f) + {-# INLINE fmap #-} + +instance Applicative (ContT r m) where + pure x = ContT ($ x) + {-# INLINE pure #-} + f <*> v = ContT $ \ c -> runContT f $ \ g -> runContT v (c . g) + {-# INLINE (<*>) #-} + m *> k = m >>= \_ -> k + {-# INLINE (*>) #-} + +instance Monad (ContT r m) where +#if !(MIN_VERSION_base(4,8,0)) + return x = ContT ($ x) + {-# INLINE return #-} +#endif + m >>= k = ContT $ \ c -> runContT m (\ x -> runContT (k x) c) + {-# INLINE (>>=) #-} + +#if MIN_VERSION_base(4,9,0) +instance (Fail.MonadFail m) => Fail.MonadFail (ContT r m) where + fail msg = ContT $ \ _ -> Fail.fail msg + {-# INLINE fail #-} +#endif + +instance MonadTrans (ContT r) where + lift m = ContT (m >>=) + {-# INLINE lift #-} + +instance (MonadIO m) => MonadIO (ContT r m) where + liftIO = lift . liftIO + {-# INLINE liftIO #-} + +-- | @callCC@ (call-with-current-continuation) calls its argument +-- function, passing it the current continuation. It provides +-- an escape continuation mechanism for use with continuation +-- monads. Escape continuations one allow to abort the current +-- computation and return a value immediately. They achieve +-- a similar effect to 'Control.Monad.Trans.Except.throwE' +-- and 'Control.Monad.Trans.Except.catchE' within an +-- 'Control.Monad.Trans.Except.ExceptT' monad. The advantage of this +-- function over calling 'return' is that it makes the continuation +-- explicit, allowing more flexibility and better control. +-- +-- The standard idiom used with @callCC@ is to provide a lambda-expression +-- to name the continuation. Then calling the named continuation anywhere +-- within its scope will escape from the computation, even if it is many +-- layers deep within nested computations. +callCC :: ((a -> ContT r m b) -> ContT r m a) -> ContT r m a +callCC f = ContT $ \ c -> runContT (f (\ x -> ContT $ \ _ -> c x)) c +{-# INLINE callCC #-} + +-- | @'resetT' m@ delimits the continuation of any 'shiftT' inside @m@. +-- +-- * @'resetT' ('lift' m) = 'lift' m@ +-- +resetT :: (Monad m) => ContT r m r -> ContT r' m r +resetT = lift . evalContT +{-# INLINE resetT #-} + +-- | @'shiftT' f@ captures the continuation up to the nearest enclosing +-- 'resetT' and passes it to @f@: +-- +-- * @'resetT' ('shiftT' f >>= k) = 'resetT' (f ('evalContT' . k))@ +-- +shiftT :: (Monad m) => ((a -> m r) -> ContT r m r) -> ContT r m a +shiftT f = ContT (evalContT . f) +{-# INLINE shiftT #-} + +-- | @'liftLocal' ask local@ yields a @local@ function for @'ContT' r m@. +liftLocal :: (Monad m) => m r' -> ((r' -> r') -> m r -> m r) -> + (r' -> r') -> ContT r m a -> ContT r m a +liftLocal ask local f m = ContT $ \ c -> do + r <- ask + local f (runContT m (local (const r) . c)) +{-# INLINE liftLocal #-} |