diff options
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Reader.hs')
| -rw-r--r-- | third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Reader.hs | 262 |
1 files changed, 262 insertions, 0 deletions
diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Reader.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Reader.hs new file mode 100644 index 0000000000..25e3ad27c3 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Reader.hs @@ -0,0 +1,262 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Safe #-} +#endif +#if __GLASGOW_HASKELL__ >= 710 +{-# LANGUAGE AutoDeriveTypeable #-} +#endif +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.Trans.Reader +-- Copyright : (c) Andy Gill 2001, +-- (c) Oregon Graduate Institute of Science and Technology, 2001 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : R.Paterson@city.ac.uk +-- Stability : experimental +-- Portability : portable +-- +-- Declaration of the 'ReaderT' monad transformer, which adds a static +-- environment to a given monad. +-- +-- If the computation is to modify the stored information, use +-- "Control.Monad.Trans.State" instead. +----------------------------------------------------------------------------- + +module Control.Monad.Trans.Reader ( + -- * The Reader monad + Reader, + reader, + runReader, + mapReader, + withReader, + -- * The ReaderT monad transformer + ReaderT(..), + mapReaderT, + withReaderT, + -- * Reader operations + ask, + local, + asks, + -- * Lifting other operations + liftCallCC, + liftCatch, + ) where + +import Control.Monad.IO.Class +import Control.Monad.Signatures +import Control.Monad.Trans.Class +#if MIN_VERSION_base(4,12,0) +import Data.Functor.Contravariant +#endif +import Data.Functor.Identity + +import Control.Applicative +import Control.Monad +#if MIN_VERSION_base(4,9,0) +import qualified Control.Monad.Fail as Fail +#endif +import Control.Monad.Fix +#if !(MIN_VERSION_base(4,6,0)) +import Control.Monad.Instances () -- deprecated from base-4.6 +#endif +#if MIN_VERSION_base(4,4,0) +import Control.Monad.Zip (MonadZip(mzipWith)) +#endif +#if MIN_VERSION_base(4,2,0) +import Data.Functor(Functor(..)) +#endif + +-- | The parameterizable reader monad. +-- +-- Computations are functions of a shared environment. +-- +-- The 'return' function ignores the environment, while @>>=@ passes +-- the inherited environment to both subcomputations. +type Reader r = ReaderT r Identity + +-- | Constructor for computations in the reader monad (equivalent to 'asks'). +reader :: (Monad m) => (r -> a) -> ReaderT r m a +reader f = ReaderT (return . f) +{-# INLINE reader #-} + +-- | Runs a @Reader@ and extracts the final value from it. +-- (The inverse of 'reader'.) +runReader + :: Reader r a -- ^ A @Reader@ to run. + -> r -- ^ An initial environment. + -> a +runReader m = runIdentity . runReaderT m +{-# INLINE runReader #-} + +-- | Transform the value returned by a @Reader@. +-- +-- * @'runReader' ('mapReader' f m) = f . 'runReader' m@ +mapReader :: (a -> b) -> Reader r a -> Reader r b +mapReader f = mapReaderT (Identity . f . runIdentity) +{-# INLINE mapReader #-} + +-- | Execute a computation in a modified environment +-- (a specialization of 'withReaderT'). +-- +-- * @'runReader' ('withReader' f m) = 'runReader' m . f@ +withReader + :: (r' -> r) -- ^ The function to modify the environment. + -> Reader r a -- ^ Computation to run in the modified environment. + -> Reader r' a +withReader = withReaderT +{-# INLINE withReader #-} + +-- | The reader monad transformer, +-- which adds a read-only environment to the given monad. +-- +-- The 'return' function ignores the environment, while @>>=@ passes +-- the inherited environment to both subcomputations. +newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a } + +-- | Transform the computation inside a @ReaderT@. +-- +-- * @'runReaderT' ('mapReaderT' f m) = f . 'runReaderT' m@ +mapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b +mapReaderT f m = ReaderT $ f . runReaderT m +{-# INLINE mapReaderT #-} + +-- | Execute a computation in a modified environment +-- (a more general version of 'local'). +-- +-- * @'runReaderT' ('withReaderT' f m) = 'runReaderT' m . f@ +withReaderT + :: (r' -> r) -- ^ The function to modify the environment. + -> ReaderT r m a -- ^ Computation to run in the modified environment. + -> ReaderT r' m a +withReaderT f m = ReaderT $ runReaderT m . f +{-# INLINE withReaderT #-} + +instance (Functor m) => Functor (ReaderT r m) where + fmap f = mapReaderT (fmap f) + {-# INLINE fmap #-} +#if MIN_VERSION_base(4,2,0) + x <$ v = mapReaderT (x <$) v + {-# INLINE (<$) #-} +#endif + +instance (Applicative m) => Applicative (ReaderT r m) where + pure = liftReaderT . pure + {-# INLINE pure #-} + f <*> v = ReaderT $ \ r -> runReaderT f r <*> runReaderT v r + {-# INLINE (<*>) #-} +#if MIN_VERSION_base(4,2,0) + u *> v = ReaderT $ \ r -> runReaderT u r *> runReaderT v r + {-# INLINE (*>) #-} + u <* v = ReaderT $ \ r -> runReaderT u r <* runReaderT v r + {-# INLINE (<*) #-} +#endif +#if MIN_VERSION_base(4,10,0) + liftA2 f x y = ReaderT $ \ r -> liftA2 f (runReaderT x r) (runReaderT y r) + {-# INLINE liftA2 #-} +#endif + +instance (Alternative m) => Alternative (ReaderT r m) where + empty = liftReaderT empty + {-# INLINE empty #-} + m <|> n = ReaderT $ \ r -> runReaderT m r <|> runReaderT n r + {-# INLINE (<|>) #-} + +instance (Monad m) => Monad (ReaderT r m) where +#if !(MIN_VERSION_base(4,8,0)) + return = lift . return + {-# INLINE return #-} +#endif + m >>= k = ReaderT $ \ r -> do + a <- runReaderT m r + runReaderT (k a) r + {-# INLINE (>>=) #-} +#if MIN_VERSION_base(4,8,0) + (>>) = (*>) +#else + m >> k = ReaderT $ \ r -> runReaderT m r >> runReaderT k r +#endif + {-# INLINE (>>) #-} +#if !(MIN_VERSION_base(4,13,0)) + fail msg = lift (fail msg) + {-# INLINE fail #-} +#endif + +#if MIN_VERSION_base(4,9,0) +instance (Fail.MonadFail m) => Fail.MonadFail (ReaderT r m) where + fail msg = lift (Fail.fail msg) + {-# INLINE fail #-} +#endif + +instance (MonadPlus m) => MonadPlus (ReaderT r m) where + mzero = lift mzero + {-# INLINE mzero #-} + m `mplus` n = ReaderT $ \ r -> runReaderT m r `mplus` runReaderT n r + {-# INLINE mplus #-} + +instance (MonadFix m) => MonadFix (ReaderT r m) where + mfix f = ReaderT $ \ r -> mfix $ \ a -> runReaderT (f a) r + {-# INLINE mfix #-} + +instance MonadTrans (ReaderT r) where + lift = liftReaderT + {-# INLINE lift #-} + +instance (MonadIO m) => MonadIO (ReaderT r m) where + liftIO = lift . liftIO + {-# INLINE liftIO #-} + +#if MIN_VERSION_base(4,4,0) +instance (MonadZip m) => MonadZip (ReaderT r m) where + mzipWith f (ReaderT m) (ReaderT n) = ReaderT $ \ a -> + mzipWith f (m a) (n a) + {-# INLINE mzipWith #-} +#endif + +#if MIN_VERSION_base(4,12,0) +instance Contravariant m => Contravariant (ReaderT r m) where + contramap f = ReaderT . fmap (contramap f) . runReaderT + {-# INLINE contramap #-} +#endif + +liftReaderT :: m a -> ReaderT r m a +liftReaderT m = ReaderT (const m) +{-# INLINE liftReaderT #-} + +-- | Fetch the value of the environment. +ask :: (Monad m) => ReaderT r m r +ask = ReaderT return +{-# INLINE ask #-} + +-- | Execute a computation in a modified environment +-- (a specialization of 'withReaderT'). +-- +-- * @'runReaderT' ('local' f m) = 'runReaderT' m . f@ +local + :: (r -> r) -- ^ The function to modify the environment. + -> ReaderT r m a -- ^ Computation to run in the modified environment. + -> ReaderT r m a +local = withReaderT +{-# INLINE local #-} + +-- | Retrieve a function of the current environment. +-- +-- * @'asks' f = 'liftM' f 'ask'@ +asks :: (Monad m) + => (r -> a) -- ^ The selector function to apply to the environment. + -> ReaderT r m a +asks f = ReaderT (return . f) +{-# INLINE asks #-} + +-- | Lift a @callCC@ operation to the new monad. +liftCallCC :: CallCC m a b -> CallCC (ReaderT r m) a b +liftCallCC callCC f = ReaderT $ \ r -> + callCC $ \ c -> + runReaderT (f (ReaderT . const . c)) r +{-# INLINE liftCallCC #-} + +-- | Lift a @catchE@ operation to the new monad. +liftCatch :: Catch e m a -> Catch e (ReaderT r m) a +liftCatch f m h = + ReaderT $ \ r -> f (runReaderT m r) (\ e -> runReaderT (h e) r) +{-# INLINE liftCatch #-} |