feat(third_party/bazel): Check in rules_haskell from Tweag

third_party/bazel/rules_haskell/examples/transformers/Control/Applicative/Backwards.hs

@@ -0,0 +1,112 @@
+{-# 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.Applicative.Backwards
+-- Copyright   :  (c) Russell O'Connor 2009
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Making functors with an 'Applicative' instance that performs actions
+-- in the reverse order.
+-----------------------------------------------------------------------------
+
+module Control.Applicative.Backwards (
+    Backwards(..),
+  ) where
+
+import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
+
+import Prelude hiding (foldr, foldr1, foldl, foldl1, null, length)
+import Control.Applicative
+import Data.Foldable
+import Data.Traversable
+
+-- | The same functor, but with an 'Applicative' instance that performs
+-- actions in the reverse order.
+newtype Backwards f a = Backwards { forwards :: f a }
+
+instance (Eq1 f) => Eq1 (Backwards f) where
+    liftEq eq (Backwards x) (Backwards y) = liftEq eq x y
+    {-# INLINE liftEq #-}
+
+instance (Ord1 f) => Ord1 (Backwards f) where
+    liftCompare comp (Backwards x) (Backwards y) = liftCompare comp x y
+    {-# INLINE liftCompare #-}
+
+instance (Read1 f) => Read1 (Backwards f) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp rl) "Backwards" Backwards
+
+instance (Show1 f) => Show1 (Backwards f) where
+    liftShowsPrec sp sl d (Backwards x) =
+        showsUnaryWith (liftShowsPrec sp sl) "Backwards" d x
+
+instance (Eq1 f, Eq a) => Eq (Backwards f a) where (==) = eq1
+instance (Ord1 f, Ord a) => Ord (Backwards f a) where compare = compare1
+instance (Read1 f, Read a) => Read (Backwards f a) where readsPrec = readsPrec1
+instance (Show1 f, Show a) => Show (Backwards f a) where showsPrec = showsPrec1
+
+-- | Derived instance.
+instance (Functor f) => Functor (Backwards f) where
+    fmap f (Backwards a) = Backwards (fmap f a)
+    {-# INLINE fmap #-}
+
+-- | Apply @f@-actions in the reverse order.
+instance (Applicative f) => Applicative (Backwards f) where
+    pure a = Backwards (pure a)
+    {-# INLINE pure #-}
+    Backwards f <*> Backwards a = Backwards (a <**> f)
+    {-# INLINE (<*>) #-}
+
+-- | Try alternatives in the same order as @f@.
+instance (Alternative f) => Alternative (Backwards f) where
+    empty = Backwards empty
+    {-# INLINE empty #-}
+    Backwards x <|> Backwards y = Backwards (x <|> y)
+    {-# INLINE (<|>) #-}
+
+-- | Derived instance.
+instance (Foldable f) => Foldable (Backwards f) where
+    foldMap f (Backwards t) = foldMap f t
+    {-# INLINE foldMap #-}
+    foldr f z (Backwards t) = foldr f z t
+    {-# INLINE foldr #-}
+    foldl f z (Backwards t) = foldl f z t
+    {-# INLINE foldl #-}
+    foldr1 f (Backwards t) = foldr1 f t
+    {-# INLINE foldr1 #-}
+    foldl1 f (Backwards t) = foldl1 f t
+    {-# INLINE foldl1 #-}
+#if MIN_VERSION_base(4,8,0)
+    null (Backwards t) = null t
+    length (Backwards t) = length t
+#endif
+
+-- | Derived instance.
+instance (Traversable f) => Traversable (Backwards f) where
+    traverse f (Backwards t) = fmap Backwards (traverse f t)
+    {-# INLINE traverse #-}
+    sequenceA (Backwards t) = fmap Backwards (sequenceA t)
+    {-# INLINE sequenceA #-}
+
+#if MIN_VERSION_base(4,12,0)
+-- | Derived instance.
+instance Contravariant f => Contravariant (Backwards f) where
+    contramap f = Backwards . contramap f . forwards
+    {-# INLINE contramap #-}
+#endif

third_party/bazel/rules_haskell/examples/transformers/Control/Applicative/Lift.hs

@@ -0,0 +1,165 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Applicative.Lift
+-- Copyright   :  (c) Ross Paterson 2010
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Adding a new kind of pure computation to an applicative functor.
+-----------------------------------------------------------------------------
+
+module Control.Applicative.Lift (
+    -- * Lifting an applicative
+    Lift(..),
+    unLift,
+    mapLift,
+    elimLift,
+    -- * Collecting errors
+    Errors,
+    runErrors,
+    failure,
+    eitherToErrors
+  ) where
+
+import Data.Functor.Classes
+
+import Control.Applicative
+import Data.Foldable (Foldable(foldMap))
+import Data.Functor.Constant
+import Data.Monoid (Monoid(..))
+import Data.Traversable (Traversable(traverse))
+
+-- | Applicative functor formed by adding pure computations to a given
+-- applicative functor.
+data Lift f a = Pure a | Other (f a)
+
+instance (Eq1 f) => Eq1 (Lift f) where
+    liftEq eq (Pure x1) (Pure x2) = eq x1 x2
+    liftEq _ (Pure _) (Other _) = False
+    liftEq _ (Other _) (Pure _) = False
+    liftEq eq (Other y1) (Other y2) = liftEq eq y1 y2
+    {-# INLINE liftEq #-}
+
+instance (Ord1 f) => Ord1 (Lift f) where
+    liftCompare comp (Pure x1) (Pure x2) = comp x1 x2
+    liftCompare _ (Pure _) (Other _) = LT
+    liftCompare _ (Other _) (Pure _) = GT
+    liftCompare comp (Other y1) (Other y2) = liftCompare comp y1 y2
+    {-# INLINE liftCompare #-}
+
+instance (Read1 f) => Read1 (Lift f) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith rp "Pure" Pure `mappend`
+        readsUnaryWith (liftReadsPrec rp rl) "Other" Other
+
+instance (Show1 f) => Show1 (Lift f) where
+    liftShowsPrec sp _ d (Pure x) = showsUnaryWith sp "Pure" d x
+    liftShowsPrec sp sl d (Other y) =
+        showsUnaryWith (liftShowsPrec sp sl) "Other" d y
+
+instance (Eq1 f, Eq a) => Eq (Lift f a) where (==) = eq1
+instance (Ord1 f, Ord a) => Ord (Lift f a) where compare = compare1
+instance (Read1 f, Read a) => Read (Lift f a) where readsPrec = readsPrec1
+instance (Show1 f, Show a) => Show (Lift f a) where showsPrec = showsPrec1
+
+instance (Functor f) => Functor (Lift f) where
+    fmap f (Pure x) = Pure (f x)
+    fmap f (Other y) = Other (fmap f y)
+    {-# INLINE fmap #-}
+
+instance (Foldable f) => Foldable (Lift f) where
+    foldMap f (Pure x) = f x
+    foldMap f (Other y) = foldMap f y
+    {-# INLINE foldMap #-}
+
+instance (Traversable f) => Traversable (Lift f) where
+    traverse f (Pure x) = Pure <$> f x
+    traverse f (Other y) = Other <$> traverse f y
+    {-# INLINE traverse #-}
+
+-- | A combination is 'Pure' only if both parts are.
+instance (Applicative f) => Applicative (Lift f) where
+    pure = Pure
+    {-# INLINE pure #-}
+    Pure f <*> Pure x = Pure (f x)
+    Pure f <*> Other y = Other (f <$> y)
+    Other f <*> Pure x = Other (($ x) <$> f)
+    Other f <*> Other y = Other (f <*> y)
+    {-# INLINE (<*>) #-}
+
+-- | A combination is 'Pure' only either part is.
+instance (Alternative f) => Alternative (Lift f) where
+    empty = Other empty
+    {-# INLINE empty #-}
+    Pure x <|> _ = Pure x
+    Other _ <|> Pure y = Pure y
+    Other x <|> Other y = Other (x <|> y)
+    {-# INLINE (<|>) #-}
+
+-- | Projection to the other functor.
+unLift :: (Applicative f) => Lift f a -> f a
+unLift (Pure x) = pure x
+unLift (Other e) = e
+{-# INLINE unLift #-}
+
+-- | Apply a transformation to the other computation.
+mapLift :: (f a -> g a) -> Lift f a -> Lift g a
+mapLift _ (Pure x) = Pure x
+mapLift f (Other e) = Other (f e)
+{-# INLINE mapLift #-}
+
+-- | Eliminator for 'Lift'.
+--
+-- * @'elimLift' f g . 'pure' = f@
+--
+-- * @'elimLift' f g . 'Other' = g@
+--
+elimLift :: (a -> r) -> (f a -> r) -> Lift f a -> r
+elimLift f _ (Pure x) = f x
+elimLift _ g (Other e) = g e
+{-# INLINE elimLift #-}
+
+-- | An applicative functor that collects a monoid (e.g. lists) of errors.
+-- A sequence of computations fails if any of its components do, but
+-- unlike monads made with 'ExceptT' from "Control.Monad.Trans.Except",
+-- these computations continue after an error, collecting all the errors.
+--
+-- * @'pure' f '<*>' 'pure' x = 'pure' (f x)@
+--
+-- * @'pure' f '<*>' 'failure' e = 'failure' e@
+--
+-- * @'failure' e '<*>' 'pure' x = 'failure' e@
+--
+-- * @'failure' e1 '<*>' 'failure' e2 = 'failure' (e1 '<>' e2)@
+--
+type Errors e = Lift (Constant e)
+
+-- | Extractor for computations with accumulating errors.
+--
+-- * @'runErrors' ('pure' x) = 'Right' x@
+--
+-- * @'runErrors' ('failure' e) = 'Left' e@
+--
+runErrors :: Errors e a -> Either e a
+runErrors (Other (Constant e)) = Left e
+runErrors (Pure x) = Right x
+{-# INLINE runErrors #-}
+
+-- | Report an error.
+failure :: e -> Errors e a
+failure e = Other (Constant e)
+{-# INLINE failure #-}
+
+-- | Convert from 'Either' to 'Errors' (inverse of 'runErrors').
+eitherToErrors :: Either e a -> Errors e a
+eitherToErrors = either failure Pure

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Signatures.hs

@@ -0,0 +1,56 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 706
+{-# LANGUAGE PolyKinds #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Signatures
+-- Copyright   :  (c) Ross Paterson 2012
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Signatures for monad operations that require specialized lifting.
+-- Each signature has a uniformity property that the lifting should satisfy.
+-----------------------------------------------------------------------------
+
+module Control.Monad.Signatures (
+    CallCC, Catch, Listen, Pass
+  ) where
+
+-- | Signature of the @callCC@ operation,
+-- introduced in "Control.Monad.Trans.Cont".
+-- Any lifting function @liftCallCC@ should satisfy
+--
+-- * @'lift' (f k) = f' ('lift' . k) => 'lift' (cf f) = liftCallCC cf f'@
+--
+type CallCC m a b = ((a -> m b) -> m a) -> m a
+
+-- | Signature of the @catchE@ operation,
+-- introduced in "Control.Monad.Trans.Except".
+-- Any lifting function @liftCatch@ should satisfy
+--
+-- * @'lift' (cf m f) = liftCatch ('lift' . cf) ('lift' f)@
+--
+type Catch e m a = m a -> (e -> m a) -> m a
+
+-- | Signature of the @listen@ operation,
+-- introduced in "Control.Monad.Trans.Writer".
+-- Any lifting function @liftListen@ should satisfy
+--
+-- * @'lift' . liftListen = liftListen . 'lift'@
+--
+type Listen w m a = m a -> m (a, w)
+
+-- | Signature of the @pass@ operation,
+-- introduced in "Control.Monad.Trans.Writer".
+-- Any lifting function @liftPass@ should satisfy
+--
+-- * @'lift' . liftPass = liftPass . 'lift'@
+--
+type Pass w m a =  m (a, w -> w) -> m a

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Accum.hs

@@ -0,0 +1,292 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.Accum
+-- Copyright   :  (c) Nickolay Kudasov 2016
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- The lazy 'AccumT' monad transformer, which adds accumulation
+-- capabilities (such as declarations or document patches) to a given monad.
+--
+-- This monad transformer provides append-only accumulation
+-- during the computation. For more general access, use
+-- "Control.Monad.Trans.State" instead.
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.Accum (
+    -- * The Accum monad
+    Accum,
+    accum,
+    runAccum,
+    execAccum,
+    evalAccum,
+    mapAccum,
+    -- * The AccumT monad transformer
+    AccumT(AccumT),
+    runAccumT,
+    execAccumT,
+    evalAccumT,
+    mapAccumT,
+    -- * Accum operations
+    look,
+    looks,
+    add,
+    -- * Lifting other operations
+    liftCallCC,
+    liftCallCC',
+    liftCatch,
+    liftListen,
+    liftPass,
+    -- * Monad transformations
+    readerToAccumT,
+    writerToAccumT,
+    accumToStateT,
+  ) where
+
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Reader (ReaderT(..))
+import Control.Monad.Trans.Writer (WriterT(..))
+import Control.Monad.Trans.State  (StateT(..))
+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
+import Control.Monad.Signatures
+#if !MIN_VERSION_base(4,8,0)
+import Data.Monoid
+#endif
+
+-- ---------------------------------------------------------------------------
+-- | An accumulation monad parameterized by the type @w@ of output to accumulate.
+--
+-- The 'return' function produces the output 'mempty', while @>>=@
+-- combines the outputs of the subcomputations using 'mappend'.
+type Accum w = AccumT w Identity
+
+-- | Construct an accumulation computation from a (result, output) pair.
+-- (The inverse of 'runAccum'.)
+accum :: (Monad m) => (w -> (a, w)) -> AccumT w m a
+accum f = AccumT $ \ w -> return (f w)
+{-# INLINE accum #-}
+
+-- | Unwrap an accumulation computation as a (result, output) pair.
+-- (The inverse of 'accum'.)
+runAccum :: Accum w a -> w -> (a, w)
+runAccum m = runIdentity . runAccumT m
+{-# INLINE runAccum #-}
+
+-- | Extract the output from an accumulation computation.
+--
+-- * @'execAccum' m w = 'snd' ('runAccum' m w)@
+execAccum :: Accum w a -> w -> w
+execAccum m w = snd (runAccum m w)
+{-# INLINE execAccum #-}
+
+-- | Evaluate an accumulation computation with the given initial output history
+-- and return the final value, discarding the final output.
+--
+-- * @'evalAccum' m w = 'fst' ('runAccum' m w)@
+evalAccum :: (Monoid w) => Accum w a -> w -> a
+evalAccum m w = fst (runAccum m w)
+{-# INLINE evalAccum #-}
+
+-- | Map both the return value and output of a computation using
+-- the given function.
+--
+-- * @'runAccum' ('mapAccum' f m) = f . 'runAccum' m@
+mapAccum :: ((a, w) -> (b, w)) -> Accum w a -> Accum w b
+mapAccum f = mapAccumT (Identity . f . runIdentity)
+{-# INLINE mapAccum #-}
+
+-- ---------------------------------------------------------------------------
+-- | An accumulation monad parameterized by:
+--
+--   * @w@ - the output to accumulate.
+--
+--   * @m@ - The inner monad.
+--
+-- The 'return' function produces the output 'mempty', while @>>=@
+-- combines the outputs of the subcomputations using 'mappend'.
+--
+-- This monad transformer is similar to both state and writer monad transformers.
+-- Thus it can be seen as
+--
+--  * a restricted append-only version of a state monad transformer or
+--
+--  * a writer monad transformer with the extra ability to read all previous output.
+newtype AccumT w m a = AccumT (w -> m (a, w))
+
+-- | Unwrap an accumulation computation.
+runAccumT :: AccumT w m a -> w -> m (a, w)
+runAccumT (AccumT f) = f
+{-# INLINE runAccumT #-}
+
+-- | Extract the output from an accumulation computation.
+--
+-- * @'execAccumT' m w = 'liftM' 'snd' ('runAccumT' m w)@
+execAccumT :: (Monad m) => AccumT w m a -> w -> m w
+execAccumT m w = do
+    ~(_, w') <- runAccumT m w
+    return w'
+{-# INLINE execAccumT #-}
+
+-- | Evaluate an accumulation computation with the given initial output history
+-- and return the final value, discarding the final output.
+--
+-- * @'evalAccumT' m w = 'liftM' 'fst' ('runAccumT' m w)@
+evalAccumT :: (Monad m, Monoid w) => AccumT w m a -> w -> m a
+evalAccumT m w = do
+    ~(a, _) <- runAccumT m w
+    return a
+{-# INLINE evalAccumT #-}
+
+-- | Map both the return value and output of a computation using
+-- the given function.
+--
+-- * @'runAccumT' ('mapAccumT' f m) = f . 'runAccumT' m@
+mapAccumT :: (m (a, w) -> n (b, w)) -> AccumT w m a -> AccumT w n b
+mapAccumT f m = AccumT (f . runAccumT m)
+{-# INLINE mapAccumT #-}
+
+instance (Functor m) => Functor (AccumT w m) where
+    fmap f = mapAccumT $ fmap $ \ ~(a, w) -> (f a, w)
+    {-# INLINE fmap #-}
+
+instance (Monoid w, Functor m, Monad m) => Applicative (AccumT w m) where
+    pure a  = AccumT $ const $ return (a, mempty)
+    {-# INLINE pure #-}
+    mf <*> mv = AccumT $ \ w -> do
+      ~(f, w')  <- runAccumT mf w
+      ~(v, w'') <- runAccumT mv (w `mappend` w')
+      return (f v, w' `mappend` w'')
+    {-# INLINE (<*>) #-}
+
+instance (Monoid w, Functor m, MonadPlus m) => Alternative (AccumT w m) where
+    empty   = AccumT $ const mzero
+    {-# INLINE empty #-}
+    m <|> n = AccumT $ \ w -> runAccumT m w `mplus` runAccumT n w
+    {-# INLINE (<|>) #-}
+
+instance (Monoid w, Functor m, Monad m) => Monad (AccumT w m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return a  = AccumT $ const $ return (a, mempty)
+    {-# INLINE return #-}
+#endif
+    m >>= k  = AccumT $ \ w -> do
+        ~(a, w')  <- runAccumT m w
+        ~(b, w'') <- runAccumT (k a) (w `mappend` w')
+        return (b, w' `mappend` w'')
+    {-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
+    fail msg = AccumT $ const (fail msg)
+    {-# INLINE fail #-}
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (AccumT w m) where
+    fail msg = AccumT $ const (Fail.fail msg)
+    {-# INLINE fail #-}
+#endif
+
+instance (Monoid w, Functor m, MonadPlus m) => MonadPlus (AccumT w m) where
+    mzero       = AccumT $ const mzero
+    {-# INLINE mzero #-}
+    m `mplus` n = AccumT $ \ w -> runAccumT m w `mplus` runAccumT n w
+    {-# INLINE mplus #-}
+
+instance (Monoid w, Functor m, MonadFix m) => MonadFix (AccumT w m) where
+    mfix m = AccumT $ \ w -> mfix $ \ ~(a, _) -> runAccumT (m a) w
+    {-# INLINE mfix #-}
+
+instance (Monoid w) => MonadTrans (AccumT w) where
+    lift m = AccumT $ const $ do
+        a <- m
+        return (a, mempty)
+    {-# INLINE lift #-}
+
+instance (Monoid w, Functor m, MonadIO m) => MonadIO (AccumT w m) where
+    liftIO = lift . liftIO
+    {-# INLINE liftIO #-}
+
+-- | @'look'@ is an action that fetches all the previously accumulated output.
+look :: (Monoid w, Monad m) => AccumT w m w
+look = AccumT $ \ w -> return (w, mempty)
+
+-- | @'look'@ is an action that retrieves a function of the previously accumulated output.
+looks :: (Monoid w, Monad m) => (w -> a) -> AccumT w m a
+looks f = AccumT $ \ w -> return (f w, mempty)
+
+-- | @'add' w@ is an action that produces the output @w@.
+add :: (Monad m) => w -> AccumT w m ()
+add w = accum $ const ((), w)
+{-# INLINE add #-}
+
+-- | Uniform lifting of a @callCC@ operation to the new monad.
+-- This version rolls back to the original output history on entering the
+-- continuation.
+liftCallCC :: CallCC m (a, w) (b, w) -> CallCC (AccumT w m) a b
+liftCallCC callCC f = AccumT $ \ w ->
+    callCC $ \ c ->
+    runAccumT (f (\ a -> AccumT $ \ _ -> c (a, w))) w
+{-# INLINE liftCallCC #-}
+
+-- | In-situ lifting of a @callCC@ operation to the new monad.
+-- This version uses the current output history on entering the continuation.
+-- It does not satisfy the uniformity property (see "Control.Monad.Signatures").
+liftCallCC' :: CallCC m (a, w) (b, w) -> CallCC (AccumT w m) a b
+liftCallCC' callCC f = AccumT $ \ s ->
+    callCC $ \ c ->
+    runAccumT (f (\ a -> AccumT $ \ s' -> c (a, s'))) s
+{-# INLINE liftCallCC' #-}
+
+-- | Lift a @catchE@ operation to the new monad.
+liftCatch :: Catch e m (a, w) -> Catch e (AccumT w m) a
+liftCatch catchE m h =
+    AccumT $ \ w -> runAccumT m w `catchE` \ e -> runAccumT (h e) w
+{-# INLINE liftCatch #-}
+
+-- | Lift a @listen@ operation to the new monad.
+liftListen :: (Monad m) => Listen w m (a, s) -> Listen w (AccumT s m) a
+liftListen listen m = AccumT $ \ s -> do
+    ~((a, s'), w) <- listen (runAccumT m s)
+    return ((a, w), s')
+{-# INLINE liftListen #-}
+
+-- | Lift a @pass@ operation to the new monad.
+liftPass :: (Monad m) => Pass w m (a, s) -> Pass w (AccumT s m) a
+liftPass pass m = AccumT $ \ s -> pass $ do
+    ~((a, f), s') <- runAccumT m s
+    return ((a, s'), f)
+{-# INLINE liftPass #-}
+
+-- | Convert a read-only computation into an accumulation computation.
+readerToAccumT :: (Functor m, Monoid w) => ReaderT w m a -> AccumT w m a
+readerToAccumT (ReaderT f) = AccumT $ \ w -> fmap (\ a -> (a, mempty)) (f w)
+{-# INLINE readerToAccumT #-}
+
+-- | Convert a writer computation into an accumulation computation.
+writerToAccumT :: WriterT w m a -> AccumT w m a
+writerToAccumT (WriterT m) = AccumT $ const $ m
+{-# INLINE writerToAccumT #-}
+
+-- | Convert an accumulation (append-only) computation into a fully
+-- stateful computation.
+accumToStateT :: (Functor m, Monoid s) => AccumT s m a -> StateT s m a
+accumToStateT (AccumT f) =
+    StateT $ \ w -> fmap (\ ~(a, w') -> (a, w `mappend` w')) (f w)
+{-# INLINE accumToStateT #-}

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Class.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.Class
+-- 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
+--
+-- The class of monad transformers.
+--
+-- A monad transformer makes a new monad out of an existing monad, such
+-- that computations of the old monad may be embedded in the new one.
+-- To construct a monad with a desired set of features, one typically
+-- starts with a base monad, such as 'Data.Functor.Identity.Identity', @[]@ or 'IO', and
+-- applies a sequence of monad transformers.
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.Class (
+    -- * Transformer class
+    MonadTrans(..)
+
+    -- * Conventions
+    -- $conventions
+
+    -- * Strict monads
+    -- $strict
+
+    -- * Examples
+    -- ** Parsing
+    -- $example1
+
+    -- ** Parsing and counting
+    -- $example2
+
+    -- ** Interpreter monad
+    -- $example3
+  ) where
+
+-- | The class of monad transformers.  Instances should satisfy the
+-- following laws, which state that 'lift' is a monad transformation:
+--
+-- * @'lift' . 'return' = 'return'@
+--
+-- * @'lift' (m >>= f) = 'lift' m >>= ('lift' . f)@
+
+class MonadTrans t where
+    -- | Lift a computation from the argument monad to the constructed monad.
+    lift :: (Monad m) => m a -> t m a
+
+{- $conventions
+Most monad transformer modules include the special case of applying
+the transformer to 'Data.Functor.Identity.Identity'.  For example,
+@'Control.Monad.Trans.State.Lazy.State' s@ is an abbreviation for
+@'Control.Monad.Trans.State.Lazy.StateT' s 'Data.Functor.Identity.Identity'@.
+
+Each monad transformer also comes with an operation @run@/XXX/@T@ to
+unwrap the transformer, exposing a computation of the inner monad.
+(Currently these functions are defined as field labels, but in the next
+major release they will be separate functions.)
+
+All of the monad transformers except 'Control.Monad.Trans.Cont.ContT'
+and 'Control.Monad.Trans.Cont.SelectT' are functors on the category
+of monads: in addition to defining a mapping of monads, they
+also define a mapping from transformations between base monads to
+transformations between transformed monads, called @map@/XXX/@T@.
+Thus given a monad transformation @t :: M a -> N a@, the combinator
+'Control.Monad.Trans.State.Lazy.mapStateT' constructs a monad
+transformation
+
+> mapStateT t :: StateT s M a -> StateT s N a
+
+For these monad transformers, 'lift' is a natural transformation in the
+category of monads, i.e. for any monad transformation @t :: M a -> N a@,
+
+* @map@/XXX/@T t . 'lift' = 'lift' . t@
+
+Each of the monad transformers introduces relevant operations.
+In a sequence of monad transformers, most of these operations.can be
+lifted through other transformers using 'lift' or the @map@/XXX/@T@
+combinator, but a few with more complex type signatures require
+specialized lifting combinators, called @lift@/Op/
+(see "Control.Monad.Signatures").
+-}
+
+{- $strict
+
+A monad is said to be /strict/ if its '>>=' operation is strict in its first
+argument.  The base monads 'Maybe', @[]@ and 'IO' are strict:
+
+>>> undefined >> return 2 :: Maybe Integer
+*** Exception: Prelude.undefined
+
+However the monad 'Data.Functor.Identity.Identity' is not:
+
+>>> runIdentity (undefined >> return 2)
+2
+
+In a strict monad you know when each action is executed, but the monad
+is not necessarily strict in the return value, or in other components
+of the monad, such as a state.  However you can use 'seq' to create
+an action that is strict in the component you want evaluated.
+-}
+
+{- $example1
+
+The first example is a parser monad in the style of
+
+* \"Monadic parsing in Haskell\", by Graham Hutton and Erik Meijer,
+/Journal of Functional Programming/ 8(4):437-444, July 1998
+(<http://www.cs.nott.ac.uk/~pszgmh/bib.html#pearl>).
+
+We can define such a parser monad by adding a state (the 'String' remaining
+to be parsed) to the @[]@ monad, which provides non-determinism:
+
+> import Control.Monad.Trans.State
+>
+> type Parser = StateT String []
+
+Then @Parser@ is an instance of @MonadPlus@: monadic sequencing implements
+concatenation of parsers, while @mplus@ provides choice.  To use parsers,
+we need a primitive to run a constructed parser on an input string:
+
+> runParser :: Parser a -> String -> [a]
+> runParser p s = [x | (x, "") <- runStateT p s]
+
+Finally, we need a primitive parser that matches a single character,
+from which arbitrarily complex parsers may be constructed:
+
+> item :: Parser Char
+> item = do
+>     c:cs <- get
+>     put cs
+>     return c
+
+In this example we use the operations @get@ and @put@ from
+"Control.Monad.Trans.State", which are defined only for monads that are
+applications of 'Control.Monad.Trans.State.Lazy.StateT'.  Alternatively one
+could use monad classes from the @mtl@ package or similar, which contain
+methods @get@ and @put@ with types generalized over all suitable monads.
+-}
+
+{- $example2
+
+We can define a parser that also counts by adding a
+'Control.Monad.Trans.Writer.Lazy.WriterT' transformer:
+
+> import Control.Monad.Trans.Class
+> import Control.Monad.Trans.State
+> import Control.Monad.Trans.Writer
+> import Data.Monoid
+>
+> type Parser = WriterT (Sum Int) (StateT String [])
+
+The function that applies a parser must now unwrap each of the monad
+transformers in turn:
+
+> runParser :: Parser a -> String -> [(a, Int)]
+> runParser p s = [(x, n) | ((x, Sum n), "") <- runStateT (runWriterT p) s]
+
+To define the @item@ parser, we need to lift the
+'Control.Monad.Trans.State.Lazy.StateT' operations through the
+'Control.Monad.Trans.Writer.Lazy.WriterT' transformer.
+
+> item :: Parser Char
+> item = do
+>     c:cs <- lift get
+>     lift (put cs)
+>     return c
+
+In this case, we were able to do this with 'lift', but operations with
+more complex types require special lifting functions, which are provided
+by monad transformers for which they can be implemented.  If you use the
+monad classes of the @mtl@ package or similar, this lifting is handled
+automatically by the instances of the classes, and you need only use
+the generalized methods @get@ and @put@.
+
+We can also define a primitive using the Writer:
+
+> tick :: Parser ()
+> tick = tell (Sum 1)
+
+Then the parser will keep track of how many @tick@s it executes.
+-}
+
+{- $example3
+
+This example is a cut-down version of the one in
+
+* \"Monad Transformers and Modular Interpreters\",
+by Sheng Liang, Paul Hudak and Mark Jones in /POPL'95/
+(<http://web.cecs.pdx.edu/~mpj/pubs/modinterp.html>).
+
+Suppose we want to define an interpreter that can do I\/O and has
+exceptions, an environment and a modifiable store.  We can define
+a monad that supports all these things as a stack of monad transformers:
+
+> import Control.Monad.Trans.Class
+> import Control.Monad.Trans.State
+> import qualified Control.Monad.Trans.Reader as R
+> import qualified Control.Monad.Trans.Except as E
+> import Control.Monad.IO.Class
+>
+> type InterpM = StateT Store (R.ReaderT Env (E.ExceptT Err IO))
+
+for suitable types @Store@, @Env@ and @Err@.
+
+Now we would like to be able to use the operations associated with each
+of those monad transformers on @InterpM@ actions.  Since the uppermost
+monad transformer of @InterpM@ is 'Control.Monad.Trans.State.Lazy.StateT',
+it already has the state operations @get@ and @set@.
+
+The first of the 'Control.Monad.Trans.Reader.ReaderT' operations,
+'Control.Monad.Trans.Reader.ask', is a simple action, so we can lift it
+through 'Control.Monad.Trans.State.Lazy.StateT' to @InterpM@ using 'lift':
+
+> ask :: InterpM Env
+> ask = lift R.ask
+
+The other 'Control.Monad.Trans.Reader.ReaderT' operation,
+'Control.Monad.Trans.Reader.local', has a suitable type for lifting
+using 'Control.Monad.Trans.State.Lazy.mapStateT':
+
+> local :: (Env -> Env) -> InterpM a -> InterpM a
+> local f = mapStateT (R.local f)
+
+We also wish to lift the operations of 'Control.Monad.Trans.Except.ExceptT'
+through both 'Control.Monad.Trans.Reader.ReaderT' and
+'Control.Monad.Trans.State.Lazy.StateT'.  For the operation
+'Control.Monad.Trans.Except.throwE', we know @throwE e@ is a simple
+action, so we can lift it through the two monad transformers to @InterpM@
+with two 'lift's:
+
+> throwE :: Err -> InterpM a
+> throwE e = lift (lift (E.throwE e))
+
+The 'Control.Monad.Trans.Except.catchE' operation has a more
+complex type, so we need to use the special-purpose lifting function
+@liftCatch@ provided by most monad transformers.  Here we use
+the 'Control.Monad.Trans.Reader.ReaderT' version followed by the
+'Control.Monad.Trans.State.Lazy.StateT' version:
+
+> catchE :: InterpM a -> (Err -> InterpM a) -> InterpM a
+> catchE = liftCatch (R.liftCatch E.catchE)
+
+We could lift 'IO' actions to @InterpM@ using three 'lift's, but @InterpM@
+is automatically an instance of 'Control.Monad.IO.Class.MonadIO',
+so we can use 'Control.Monad.IO.Class.liftIO' instead:
+
+> putStr :: String -> InterpM ()
+> putStr s = liftIO (Prelude.putStr s)
+
+-}

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 #-}

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Error.hs

@@ -0,0 +1,333 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+#if !(MIN_VERSION_base(4,9,0))
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.Error
+-- Copyright   :  (c) Michael Weber <michael.weber@post.rwth-aachen.de> 2001,
+--                (c) Jeff Newbern 2003-2006,
+--                (c) Andriy Palamarchuk 2006
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This monad transformer adds the ability to fail or throw exceptions
+-- to a monad.
+--
+-- A sequence of actions succeeds, producing a value, only if all the
+-- actions in the sequence are successful.  If one fails with an error,
+-- the rest of the sequence is skipped and the composite action fails
+-- with that error.
+--
+-- If the value of the error is not required, the variant in
+-- "Control.Monad.Trans.Maybe" may be used instead.
+--
+-- /Note:/ This module will be removed in a future release.
+-- Instead, use "Control.Monad.Trans.Except", which does not restrict
+-- the exception type, and also includes a base exception monad.
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.Error
+  {-# DEPRECATED "Use Control.Monad.Trans.Except instead" #-} (
+    -- * The ErrorT monad transformer
+    Error(..),
+    ErrorList(..),
+    ErrorT(..),
+    mapErrorT,
+    -- * Error operations
+    throwError,
+    catchError,
+    -- * Lifting other operations
+    liftCallCC,
+    liftListen,
+    liftPass,
+    -- * Examples
+    -- $examples
+  ) where
+
+import Control.Monad.IO.Class
+import Control.Monad.Signatures
+import Control.Monad.Trans.Class
+import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
+
+import Control.Applicative
+import Control.Exception (IOException)
+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
+import Data.Foldable (Foldable(foldMap))
+import Data.Monoid (mempty)
+import Data.Traversable (Traversable(traverse))
+import System.IO.Error
+
+#if !(MIN_VERSION_base(4,9,0))
+-- These instances are in base-4.9.0
+
+instance MonadPlus IO where
+    mzero       = ioError (userError "mzero")
+    m `mplus` n = m `catchIOError` \ _ -> n
+
+instance Alternative IO where
+    empty = mzero
+    (<|>) = mplus
+
+# if !(MIN_VERSION_base(4,4,0))
+-- exported by System.IO.Error from base-4.4
+catchIOError :: IO a -> (IOError -> IO a) -> IO a
+catchIOError = catch
+# endif
+#endif
+
+instance (Error e) => Alternative (Either e) where
+    empty        = Left noMsg
+    Left _ <|> n = n
+    m      <|> _ = m
+
+instance (Error e) => MonadPlus (Either e) where
+    mzero            = Left noMsg
+    Left _ `mplus` n = n
+    m      `mplus` _ = m
+
+#if !(MIN_VERSION_base(4,3,0))
+-- These instances are in base-4.3
+
+instance Applicative (Either e) where
+    pure          = Right
+    Left  e <*> _ = Left e
+    Right f <*> r = fmap f r
+
+instance Monad (Either e) where
+    return        = Right
+    Left  l >>= _ = Left l
+    Right r >>= k = k r
+
+instance MonadFix (Either e) where
+    mfix f = let
+        a = f $ case a of
+            Right r -> r
+            _       -> error "empty mfix argument"
+        in a
+
+#endif /* base to 4.2.0.x */
+
+-- | An exception to be thrown.
+--
+-- Minimal complete definition: 'noMsg' or 'strMsg'.
+class Error a where
+    -- | Creates an exception without a message.
+    -- The default implementation is @'strMsg' \"\"@.
+    noMsg  :: a
+    -- | Creates an exception with a message.
+    -- The default implementation of @'strMsg' s@ is 'noMsg'.
+    strMsg :: String -> a
+
+    noMsg    = strMsg ""
+    strMsg _ = noMsg
+
+instance Error IOException where
+    strMsg = userError
+
+-- | A string can be thrown as an error.
+instance (ErrorList a) => Error [a] where
+    strMsg = listMsg
+
+-- | Workaround so that we can have a Haskell 98 instance @'Error' 'String'@.
+class ErrorList a where
+    listMsg :: String -> [a]
+
+instance ErrorList Char where
+    listMsg = id
+
+-- | The error monad transformer. It can be used to add error handling
+-- to other monads.
+--
+-- The @ErrorT@ Monad structure is parameterized over two things:
+--
+-- * e - The error type.
+--
+-- * m - The inner monad.
+--
+-- The 'return' function yields a successful computation, while @>>=@
+-- sequences two subcomputations, failing on the first error.
+newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) }
+
+instance (Eq e, Eq1 m) => Eq1 (ErrorT e m) where
+    liftEq eq (ErrorT x) (ErrorT y) = liftEq (liftEq eq) x y
+
+instance (Ord e, Ord1 m) => Ord1 (ErrorT e m) where
+    liftCompare comp (ErrorT x) (ErrorT y) = liftCompare (liftCompare comp) x y
+
+instance (Read e, Read1 m) => Read1 (ErrorT e m) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "ErrorT" ErrorT
+      where
+        rp' = liftReadsPrec rp rl
+        rl' = liftReadList rp rl
+
+instance (Show e, Show1 m) => Show1 (ErrorT e m) where
+    liftShowsPrec sp sl d (ErrorT m) =
+        showsUnaryWith (liftShowsPrec sp' sl') "ErrorT" d m
+      where
+        sp' = liftShowsPrec sp sl
+        sl' = liftShowList sp sl
+
+instance (Eq e, Eq1 m, Eq a) => Eq (ErrorT e m a) where (==) = eq1
+instance (Ord e, Ord1 m, Ord a) => Ord (ErrorT e m a) where compare = compare1
+instance (Read e, Read1 m, Read a) => Read (ErrorT e m a) where
+    readsPrec = readsPrec1
+instance (Show e, Show1 m, Show a) => Show (ErrorT e m a) where
+    showsPrec = showsPrec1
+
+-- | Map the unwrapped computation using the given function.
+--
+-- * @'runErrorT' ('mapErrorT' f m) = f ('runErrorT' m)@
+mapErrorT :: (m (Either e a) -> n (Either e' b))
+          -> ErrorT e m a
+          -> ErrorT e' n b
+mapErrorT f m = ErrorT $ f (runErrorT m)
+
+instance (Functor m) => Functor (ErrorT e m) where
+    fmap f = ErrorT . fmap (fmap f) . runErrorT
+
+instance (Foldable f) => Foldable (ErrorT e f) where
+    foldMap f (ErrorT a) = foldMap (either (const mempty) f) a
+
+instance (Traversable f) => Traversable (ErrorT e f) where
+    traverse f (ErrorT a) =
+        ErrorT <$> traverse (either (pure . Left) (fmap Right . f)) a
+
+instance (Functor m, Monad m) => Applicative (ErrorT e m) where
+    pure a  = ErrorT $ return (Right a)
+    f <*> v = ErrorT $ do
+        mf <- runErrorT f
+        case mf of
+            Left  e -> return (Left e)
+            Right k -> do
+                mv <- runErrorT v
+                case mv of
+                    Left  e -> return (Left e)
+                    Right x -> return (Right (k x))
+
+instance (Functor m, Monad m, Error e) => Alternative (ErrorT e m) where
+    empty = mzero
+    (<|>) = mplus
+
+instance (Monad m, Error e) => Monad (ErrorT e m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return a = ErrorT $ return (Right a)
+#endif
+    m >>= k  = ErrorT $ do
+        a <- runErrorT m
+        case a of
+            Left  l -> return (Left l)
+            Right r -> runErrorT (k r)
+#if !(MIN_VERSION_base(4,13,0))
+    fail msg = ErrorT $ return (Left (strMsg msg))
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Monad m, Error e) => Fail.MonadFail (ErrorT e m) where
+    fail msg = ErrorT $ return (Left (strMsg msg))
+#endif
+
+instance (Monad m, Error e) => MonadPlus (ErrorT e m) where
+    mzero       = ErrorT $ return (Left noMsg)
+    m `mplus` n = ErrorT $ do
+        a <- runErrorT m
+        case a of
+            Left  _ -> runErrorT n
+            Right r -> return (Right r)
+
+instance (MonadFix m, Error e) => MonadFix (ErrorT e m) where
+    mfix f = ErrorT $ mfix $ \ a -> runErrorT $ f $ case a of
+        Right r -> r
+        _       -> error "empty mfix argument"
+
+instance MonadTrans (ErrorT e) where
+    lift m = ErrorT $ do
+        a <- m
+        return (Right a)
+
+instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where
+    liftIO = lift . liftIO
+
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (ErrorT e m) where
+    contramap f = ErrorT . contramap (fmap f) . runErrorT
+#endif
+
+-- | Signal an error value @e@.
+--
+-- * @'runErrorT' ('throwError' e) = 'return' ('Left' e)@
+--
+-- * @'throwError' e >>= m = 'throwError' e@
+throwError :: (Monad m) => e -> ErrorT e m a
+throwError l = ErrorT $ return (Left l)
+
+-- | Handle an error.
+--
+-- * @'catchError' h ('lift' m) = 'lift' m@
+--
+-- * @'catchError' h ('throwError' e) = h e@
+catchError :: (Monad m) =>
+    ErrorT e m a                -- ^ the inner computation
+    -> (e -> ErrorT e m a)      -- ^ a handler for errors in the inner
+                                -- computation
+    -> ErrorT e m a
+m `catchError` h = ErrorT $ do
+    a <- runErrorT m
+    case a of
+        Left  l -> runErrorT (h l)
+        Right r -> return (Right r)
+
+-- | Lift a @callCC@ operation to the new monad.
+liftCallCC :: CallCC m (Either e a) (Either e b) -> CallCC (ErrorT e m) a b
+liftCallCC callCC f = ErrorT $
+    callCC $ \ c ->
+    runErrorT (f (\ a -> ErrorT $ c (Right a)))
+
+-- | Lift a @listen@ operation to the new monad.
+liftListen :: (Monad m) => Listen w m (Either e a) -> Listen w (ErrorT e m) a
+liftListen listen = mapErrorT $ \ m -> do
+    (a, w) <- listen m
+    return $! fmap (\ r -> (r, w)) a
+
+-- | Lift a @pass@ operation to the new monad.
+liftPass :: (Monad m) => Pass w m (Either e a) -> Pass w (ErrorT e m) a
+liftPass pass = mapErrorT $ \ m -> pass $ do
+    a <- m
+    return $! case a of
+        Left  l      -> (Left  l, id)
+        Right (r, f) -> (Right r, f)
+
+{- $examples
+
+Wrapping an IO action that can throw an error @e@:
+
+> type ErrorWithIO e a = ErrorT e IO a
+> ==> ErrorT (IO (Either e a))
+
+An IO monad wrapped in @StateT@ inside of @ErrorT@:
+
+> type ErrorAndStateWithIO e s a = ErrorT e (StateT s IO) a
+> ==> ErrorT (StateT s IO (Either e a))
+> ==> ErrorT (StateT (s -> IO (Either e a,s)))
+
+-}

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Except.hs

@@ -0,0 +1,316 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.Except
+-- Copyright   :  (C) 2013 Ross Paterson
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This monad transformer extends a monad with the ability to throw exceptions.
+--
+-- A sequence of actions terminates normally, producing a value,
+-- only if none of the actions in the sequence throws an exception.
+-- If one throws an exception, the rest of the sequence is skipped and
+-- the composite action exits with that exception.
+--
+-- If the value of the exception is not required, the variant in
+-- "Control.Monad.Trans.Maybe" may be used instead.
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.Except (
+    -- * The Except monad
+    Except,
+    except,
+    runExcept,
+    mapExcept,
+    withExcept,
+    -- * The ExceptT monad transformer
+    ExceptT(ExceptT),
+    runExceptT,
+    mapExceptT,
+    withExceptT,
+    -- * Exception operations
+    throwE,
+    catchE,
+    -- * Lifting other operations
+    liftCallCC,
+    liftListen,
+    liftPass,
+  ) where
+
+import Control.Monad.IO.Class
+import Control.Monad.Signatures
+import Control.Monad.Trans.Class
+import Data.Functor.Classes
+#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,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
+import Data.Foldable (Foldable(foldMap))
+import Data.Monoid
+import Data.Traversable (Traversable(traverse))
+
+-- | The parameterizable exception monad.
+--
+-- Computations are either exceptions or normal values.
+--
+-- The 'return' function returns a normal value, while @>>=@ exits on
+-- the first exception.  For a variant that continues after an error
+-- and collects all the errors, see 'Control.Applicative.Lift.Errors'.
+type Except e = ExceptT e Identity
+
+-- | Constructor for computations in the exception monad.
+-- (The inverse of 'runExcept').
+except :: (Monad m) => Either e a -> ExceptT e m a
+except m = ExceptT (return m)
+{-# INLINE except #-}
+
+-- | Extractor for computations in the exception monad.
+-- (The inverse of 'except').
+runExcept :: Except e a -> Either e a
+runExcept (ExceptT m) = runIdentity m
+{-# INLINE runExcept #-}
+
+-- | Map the unwrapped computation using the given function.
+--
+-- * @'runExcept' ('mapExcept' f m) = f ('runExcept' m)@
+mapExcept :: (Either e a -> Either e' b)
+        -> Except e a
+        -> Except e' b
+mapExcept f = mapExceptT (Identity . f . runIdentity)
+{-# INLINE mapExcept #-}
+
+-- | Transform any exceptions thrown by the computation using the given
+-- function (a specialization of 'withExceptT').
+withExcept :: (e -> e') -> Except e a -> Except e' a
+withExcept = withExceptT
+{-# INLINE withExcept #-}
+
+-- | A monad transformer that adds exceptions to other monads.
+--
+-- @ExceptT@ constructs a monad parameterized over two things:
+--
+-- * e - The exception type.
+--
+-- * m - The inner monad.
+--
+-- The 'return' function yields a computation that produces the given
+-- value, while @>>=@ sequences two subcomputations, exiting on the
+-- first exception.
+newtype ExceptT e m a = ExceptT (m (Either e a))
+
+instance (Eq e, Eq1 m) => Eq1 (ExceptT e m) where
+    liftEq eq (ExceptT x) (ExceptT y) = liftEq (liftEq eq) x y
+    {-# INLINE liftEq #-}
+
+instance (Ord e, Ord1 m) => Ord1 (ExceptT e m) where
+    liftCompare comp (ExceptT x) (ExceptT y) =
+        liftCompare (liftCompare comp) x y
+    {-# INLINE liftCompare #-}
+
+instance (Read e, Read1 m) => Read1 (ExceptT e m) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "ExceptT" ExceptT
+      where
+        rp' = liftReadsPrec rp rl
+        rl' = liftReadList rp rl
+
+instance (Show e, Show1 m) => Show1 (ExceptT e m) where
+    liftShowsPrec sp sl d (ExceptT m) =
+        showsUnaryWith (liftShowsPrec sp' sl') "ExceptT" d m
+      where
+        sp' = liftShowsPrec sp sl
+        sl' = liftShowList sp sl
+
+instance (Eq e, Eq1 m, Eq a) => Eq (ExceptT e m a)
+    where (==) = eq1
+instance (Ord e, Ord1 m, Ord a) => Ord (ExceptT e m a)
+    where compare = compare1
+instance (Read e, Read1 m, Read a) => Read (ExceptT e m a) where
+    readsPrec = readsPrec1
+instance (Show e, Show1 m, Show a) => Show (ExceptT e m a) where
+    showsPrec = showsPrec1
+
+-- | The inverse of 'ExceptT'.
+runExceptT :: ExceptT e m a -> m (Either e a)
+runExceptT (ExceptT m) = m
+{-# INLINE runExceptT #-}
+
+-- | Map the unwrapped computation using the given function.
+--
+-- * @'runExceptT' ('mapExceptT' f m) = f ('runExceptT' m)@
+mapExceptT :: (m (Either e a) -> n (Either e' b))
+        -> ExceptT e m a
+        -> ExceptT e' n b
+mapExceptT f m = ExceptT $ f (runExceptT m)
+{-# INLINE mapExceptT #-}
+
+-- | Transform any exceptions thrown by the computation using the
+-- given function.
+withExceptT :: (Functor m) => (e -> e') -> ExceptT e m a -> ExceptT e' m a
+withExceptT f = mapExceptT $ fmap $ either (Left . f) Right
+{-# INLINE withExceptT #-}
+
+instance (Functor m) => Functor (ExceptT e m) where
+    fmap f = ExceptT . fmap (fmap f) . runExceptT
+    {-# INLINE fmap #-}
+
+instance (Foldable f) => Foldable (ExceptT e f) where
+    foldMap f (ExceptT a) = foldMap (either (const mempty) f) a
+    {-# INLINE foldMap #-}
+
+instance (Traversable f) => Traversable (ExceptT e f) where
+    traverse f (ExceptT a) =
+        ExceptT <$> traverse (either (pure . Left) (fmap Right . f)) a
+    {-# INLINE traverse #-}
+
+instance (Functor m, Monad m) => Applicative (ExceptT e m) where
+    pure a = ExceptT $ return (Right a)
+    {-# INLINE pure #-}
+    ExceptT f <*> ExceptT v = ExceptT $ do
+        mf <- f
+        case mf of
+            Left e -> return (Left e)
+            Right k -> do
+                mv <- v
+                case mv of
+                    Left e -> return (Left e)
+                    Right x -> return (Right (k x))
+    {-# INLINEABLE (<*>) #-}
+    m *> k = m >>= \_ -> k
+    {-# INLINE (*>) #-}
+
+instance (Functor m, Monad m, Monoid e) => Alternative (ExceptT e m) where
+    empty = ExceptT $ return (Left mempty)
+    {-# INLINE empty #-}
+    ExceptT mx <|> ExceptT my = ExceptT $ do
+        ex <- mx
+        case ex of
+            Left e -> liftM (either (Left . mappend e) Right) my
+            Right x -> return (Right x)
+    {-# INLINEABLE (<|>) #-}
+
+instance (Monad m) => Monad (ExceptT e m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return a = ExceptT $ return (Right a)
+    {-# INLINE return #-}
+#endif
+    m >>= k = ExceptT $ do
+        a <- runExceptT m
+        case a of
+            Left e -> return (Left e)
+            Right x -> runExceptT (k x)
+    {-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
+    fail = ExceptT . fail
+    {-# INLINE fail #-}
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Fail.MonadFail m) => Fail.MonadFail (ExceptT e m) where
+    fail = ExceptT . Fail.fail
+    {-# INLINE fail #-}
+#endif
+
+instance (Monad m, Monoid e) => MonadPlus (ExceptT e m) where
+    mzero = ExceptT $ return (Left mempty)
+    {-# INLINE mzero #-}
+    ExceptT mx `mplus` ExceptT my = ExceptT $ do
+        ex <- mx
+        case ex of
+            Left e -> liftM (either (Left . mappend e) Right) my
+            Right x -> return (Right x)
+    {-# INLINEABLE mplus #-}
+
+instance (MonadFix m) => MonadFix (ExceptT e m) where
+    mfix f = ExceptT (mfix (runExceptT . f . either (const bomb) id))
+      where bomb = error "mfix (ExceptT): inner computation returned Left value"
+    {-# INLINE mfix #-}
+
+instance MonadTrans (ExceptT e) where
+    lift = ExceptT . liftM Right
+    {-# INLINE lift #-}
+
+instance (MonadIO m) => MonadIO (ExceptT e m) where
+    liftIO = lift . liftIO
+    {-# INLINE liftIO #-}
+
+#if MIN_VERSION_base(4,4,0)
+instance (MonadZip m) => MonadZip (ExceptT e m) where
+    mzipWith f (ExceptT a) (ExceptT b) = ExceptT $ mzipWith (liftA2 f) a b
+    {-# INLINE mzipWith #-}
+#endif
+
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (ExceptT e m) where
+    contramap f = ExceptT . contramap (fmap f) . runExceptT
+    {-# INLINE contramap #-}
+#endif
+
+-- | Signal an exception value @e@.
+--
+-- * @'runExceptT' ('throwE' e) = 'return' ('Left' e)@
+--
+-- * @'throwE' e >>= m = 'throwE' e@
+throwE :: (Monad m) => e -> ExceptT e m a
+throwE = ExceptT . return . Left
+{-# INLINE throwE #-}
+
+-- | Handle an exception.
+--
+-- * @'catchE' ('lift' m) h = 'lift' m@
+--
+-- * @'catchE' ('throwE' e) h = h e@
+catchE :: (Monad m) =>
+    ExceptT e m a               -- ^ the inner computation
+    -> (e -> ExceptT e' m a)    -- ^ a handler for exceptions in the inner
+                                -- computation
+    -> ExceptT e' m a
+m `catchE` h = ExceptT $ do
+    a <- runExceptT m
+    case a of
+        Left  l -> runExceptT (h l)
+        Right r -> return (Right r)
+{-# INLINE catchE #-}
+
+-- | Lift a @callCC@ operation to the new monad.
+liftCallCC :: CallCC m (Either e a) (Either e b) -> CallCC (ExceptT e m) a b
+liftCallCC callCC f = ExceptT $
+    callCC $ \ c ->
+    runExceptT (f (\ a -> ExceptT $ c (Right a)))
+{-# INLINE liftCallCC #-}
+
+-- | Lift a @listen@ operation to the new monad.
+liftListen :: (Monad m) => Listen w m (Either e a) -> Listen w (ExceptT e m) a
+liftListen listen = mapExceptT $ \ m -> do
+    (a, w) <- listen m
+    return $! fmap (\ r -> (r, w)) a
+{-# INLINE liftListen #-}
+
+-- | Lift a @pass@ operation to the new monad.
+liftPass :: (Monad m) => Pass w m (Either e a) -> Pass w (ExceptT e m) a
+liftPass pass = mapExceptT $ \ m -> pass $ do
+    a <- m
+    return $! case a of
+        Left l -> (Left l, id)
+        Right (r, f) -> (Right r, f)
+{-# INLINE liftPass #-}

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Identity.hs

@@ -0,0 +1,188 @@
+{-# 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.Identity
+-- Copyright   :  (c) 2007 Magnus Therning
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- The identity monad transformer.
+--
+-- This is useful for functions parameterized by a monad transformer.
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.Identity (
+    -- * The identity monad transformer
+    IdentityT(..),
+    mapIdentityT,
+    -- * Lifting other operations
+    liftCatch,
+    liftCallCC,
+  ) where
+
+import Control.Monad.IO.Class (MonadIO(liftIO))
+import Control.Monad.Signatures
+import Control.Monad.Trans.Class (MonadTrans(lift))
+import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
+
+import Control.Applicative
+import Control.Monad (MonadPlus(mzero, mplus))
+#if MIN_VERSION_base(4,9,0)
+import qualified Control.Monad.Fail as Fail
+#endif
+import Control.Monad.Fix (MonadFix(mfix))
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
+import Data.Foldable
+import Data.Traversable (Traversable(traverse))
+import Prelude hiding (foldr, foldr1, foldl, foldl1, null, length)
+
+-- | The trivial monad transformer, which maps a monad to an equivalent monad.
+newtype IdentityT f a = IdentityT { runIdentityT :: f a }
+
+instance (Eq1 f) => Eq1 (IdentityT f) where
+    liftEq eq (IdentityT x) (IdentityT y) = liftEq eq x y
+    {-# INLINE liftEq #-}
+
+instance (Ord1 f) => Ord1 (IdentityT f) where
+    liftCompare comp (IdentityT x) (IdentityT y) = liftCompare comp x y
+    {-# INLINE liftCompare #-}
+
+instance (Read1 f) => Read1 (IdentityT f) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp rl) "IdentityT" IdentityT
+
+instance (Show1 f) => Show1 (IdentityT f) where
+    liftShowsPrec sp sl d (IdentityT m) =
+        showsUnaryWith (liftShowsPrec sp sl) "IdentityT" d m
+
+instance (Eq1 f, Eq a) => Eq (IdentityT f a) where (==) = eq1
+instance (Ord1 f, Ord a) => Ord (IdentityT f a) where compare = compare1
+instance (Read1 f, Read a) => Read (IdentityT f a) where readsPrec = readsPrec1
+instance (Show1 f, Show a) => Show (IdentityT f a) where showsPrec = showsPrec1
+
+instance (Functor m) => Functor (IdentityT m) where
+    fmap f = mapIdentityT (fmap f)
+    {-# INLINE fmap #-}
+
+instance (Foldable f) => Foldable (IdentityT f) where
+    foldMap f (IdentityT t) = foldMap f t
+    {-# INLINE foldMap #-}
+    foldr f z (IdentityT t) = foldr f z t
+    {-# INLINE foldr #-}
+    foldl f z (IdentityT t) = foldl f z t
+    {-# INLINE foldl #-}
+    foldr1 f (IdentityT t) = foldr1 f t
+    {-# INLINE foldr1 #-}
+    foldl1 f (IdentityT t) = foldl1 f t
+    {-# INLINE foldl1 #-}
+#if MIN_VERSION_base(4,8,0)
+    null (IdentityT t) = null t
+    length (IdentityT t) = length t
+#endif
+
+instance (Traversable f) => Traversable (IdentityT f) where
+    traverse f (IdentityT a) = IdentityT <$> traverse f a
+    {-# INLINE traverse #-}
+
+instance (Applicative m) => Applicative (IdentityT m) where
+    pure x = IdentityT (pure x)
+    {-# INLINE pure #-}
+    (<*>) = lift2IdentityT (<*>)
+    {-# INLINE (<*>) #-}
+    (*>) = lift2IdentityT (*>)
+    {-# INLINE (*>) #-}
+    (<*) = lift2IdentityT (<*)
+    {-# INLINE (<*) #-}
+
+instance (Alternative m) => Alternative (IdentityT m) where
+    empty = IdentityT empty
+    {-# INLINE empty #-}
+    (<|>) = lift2IdentityT (<|>)
+    {-# INLINE (<|>) #-}
+
+instance (Monad m) => Monad (IdentityT m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return = IdentityT . return
+    {-# INLINE return #-}
+#endif
+    m >>= k = IdentityT $ runIdentityT . k =<< runIdentityT m
+    {-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
+    fail msg = IdentityT $ fail msg
+    {-# INLINE fail #-}
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Fail.MonadFail m) => Fail.MonadFail (IdentityT m) where
+    fail msg = IdentityT $ Fail.fail msg
+    {-# INLINE fail #-}
+#endif
+
+instance (MonadPlus m) => MonadPlus (IdentityT m) where
+    mzero = IdentityT mzero
+    {-# INLINE mzero #-}
+    mplus = lift2IdentityT mplus
+    {-# INLINE mplus #-}
+
+instance (MonadFix m) => MonadFix (IdentityT m) where
+    mfix f = IdentityT (mfix (runIdentityT . f))
+    {-# INLINE mfix #-}
+
+instance (MonadIO m) => MonadIO (IdentityT m) where
+    liftIO = IdentityT . liftIO
+    {-# INLINE liftIO #-}
+
+#if MIN_VERSION_base(4,4,0)
+instance (MonadZip m) => MonadZip (IdentityT m) where
+    mzipWith f = lift2IdentityT (mzipWith f)
+    {-# INLINE mzipWith #-}
+#endif
+
+instance MonadTrans IdentityT where
+    lift = IdentityT
+    {-# INLINE lift #-}
+
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant f => Contravariant (IdentityT f) where
+    contramap f = IdentityT . contramap f . runIdentityT
+    {-# INLINE contramap #-}
+#endif
+
+-- | Lift a unary operation to the new monad.
+mapIdentityT :: (m a -> n b) -> IdentityT m a -> IdentityT n b
+mapIdentityT f = IdentityT . f . runIdentityT
+{-# INLINE mapIdentityT #-}
+
+-- | Lift a binary operation to the new monad.
+lift2IdentityT ::
+    (m a -> n b -> p c) -> IdentityT m a -> IdentityT n b -> IdentityT p c
+lift2IdentityT f a b = IdentityT (f (runIdentityT a) (runIdentityT b))
+{-# INLINE lift2IdentityT #-}
+
+-- | Lift a @callCC@ operation to the new monad.
+liftCallCC :: CallCC m a b -> CallCC (IdentityT m) a b
+liftCallCC callCC f =
+    IdentityT $ callCC $ \ c -> runIdentityT (f (IdentityT . c))
+{-# INLINE liftCallCC #-}
+
+-- | Lift a @catchE@ operation to the new monad.
+liftCatch :: Catch e m a -> Catch e (IdentityT m) a
+liftCatch f m h = IdentityT $ f (runIdentityT m) (runIdentityT . h)
+{-# INLINE liftCatch #-}

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/List.hs

@@ -0,0 +1,185 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.List
+-- 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
+--
+-- The ListT monad transformer, adding backtracking to a given monad,
+-- which must be commutative.
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.List
+  {-# DEPRECATED "This transformer is invalid on most monads" #-} (
+    -- * The ListT monad transformer
+    ListT(..),
+    mapListT,
+    -- * Lifting other operations
+    liftCallCC,
+    liftCatch,
+  ) where
+
+import Control.Monad.IO.Class
+import Control.Monad.Signatures
+import Control.Monad.Trans.Class
+import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
+
+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,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
+import Data.Foldable (Foldable(foldMap))
+import Data.Traversable (Traversable(traverse))
+
+-- | Parameterizable list monad, with an inner monad.
+--
+-- /Note:/ this does not yield a monad unless the argument monad is commutative.
+newtype ListT m a = ListT { runListT :: m [a] }
+
+instance (Eq1 m) => Eq1 (ListT m) where
+    liftEq eq (ListT x) (ListT y) = liftEq (liftEq eq) x y
+    {-# INLINE liftEq #-}
+
+instance (Ord1 m) => Ord1 (ListT m) where
+    liftCompare comp (ListT x) (ListT y) = liftCompare (liftCompare comp) x y
+    {-# INLINE liftCompare #-}
+
+instance (Read1 m) => Read1 (ListT m) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "ListT" ListT
+      where
+        rp' = liftReadsPrec rp rl
+        rl' = liftReadList rp rl
+
+instance (Show1 m) => Show1 (ListT m) where
+    liftShowsPrec sp sl d (ListT m) =
+        showsUnaryWith (liftShowsPrec sp' sl') "ListT" d m
+      where
+        sp' = liftShowsPrec sp sl
+        sl' = liftShowList sp sl
+
+instance (Eq1 m, Eq a) => Eq (ListT m a) where (==) = eq1
+instance (Ord1 m, Ord a) => Ord (ListT m a) where compare = compare1
+instance (Read1 m, Read a) => Read (ListT m a) where readsPrec = readsPrec1
+instance (Show1 m, Show a) => Show (ListT m a) where showsPrec = showsPrec1
+
+-- | Map between 'ListT' computations.
+--
+-- * @'runListT' ('mapListT' f m) = f ('runListT' m)@
+mapListT :: (m [a] -> n [b]) -> ListT m a -> ListT n b
+mapListT f m = ListT $ f (runListT m)
+{-# INLINE mapListT #-}
+
+instance (Functor m) => Functor (ListT m) where
+    fmap f = mapListT $ fmap $ map f
+    {-# INLINE fmap #-}
+
+instance (Foldable f) => Foldable (ListT f) where
+    foldMap f (ListT a) = foldMap (foldMap f) a
+    {-# INLINE foldMap #-}
+
+instance (Traversable f) => Traversable (ListT f) where
+    traverse f (ListT a) = ListT <$> traverse (traverse f) a
+    {-# INLINE traverse #-}
+
+instance (Applicative m) => Applicative (ListT m) where
+    pure a  = ListT $ pure [a]
+    {-# INLINE pure #-}
+    f <*> v = ListT $ (<*>) <$> runListT f <*> runListT v
+    {-# INLINE (<*>) #-}
+
+instance (Applicative m) => Alternative (ListT m) where
+    empty   = ListT $ pure []
+    {-# INLINE empty #-}
+    m <|> n = ListT $ (++) <$> runListT m <*> runListT n
+    {-# INLINE (<|>) #-}
+
+instance (Monad m) => Monad (ListT m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return a = ListT $ return [a]
+    {-# INLINE return #-}
+#endif
+    m >>= k  = ListT $ do
+        a <- runListT m
+        b <- mapM (runListT . k) a
+        return (concat b)
+    {-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
+    fail _ = ListT $ return []
+    {-# INLINE fail #-}
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Monad m) => Fail.MonadFail (ListT m) where
+    fail _ = ListT $ return []
+    {-# INLINE fail #-}
+#endif
+
+instance (Monad m) => MonadPlus (ListT m) where
+    mzero       = ListT $ return []
+    {-# INLINE mzero #-}
+    m `mplus` n = ListT $ do
+        a <- runListT m
+        b <- runListT n
+        return (a ++ b)
+    {-# INLINE mplus #-}
+
+instance (MonadFix m) => MonadFix (ListT m) where
+    mfix f = ListT $ mfix (runListT . f . head) >>= \ xs -> case xs of
+        [] -> return []
+        x:_ -> liftM (x:) (runListT (mfix (mapListT (liftM tail) . f)))
+    {-# INLINE mfix #-}
+
+instance MonadTrans ListT where
+    lift m = ListT $ do
+        a <- m
+        return [a]
+    {-# INLINE lift #-}
+
+instance (MonadIO m) => MonadIO (ListT m) where
+    liftIO = lift . liftIO
+    {-# INLINE liftIO #-}
+
+#if MIN_VERSION_base(4,4,0)
+instance (MonadZip m) => MonadZip (ListT m) where
+    mzipWith f (ListT a) (ListT b) = ListT $ mzipWith (zipWith f) a b
+    {-# INLINE mzipWith #-}
+#endif
+
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (ListT m) where
+    contramap f = ListT . contramap (fmap f) . runListT
+    {-# INLINE contramap #-}
+#endif
+
+-- | Lift a @callCC@ operation to the new monad.
+liftCallCC :: CallCC m [a] [b] -> CallCC (ListT m) a b
+liftCallCC callCC f = ListT $
+    callCC $ \ c ->
+    runListT (f (\ a -> ListT $ c [a]))
+{-# INLINE liftCallCC #-}
+
+-- | Lift a @catchE@ operation to the new monad.
+liftCatch :: Catch e m [a] -> Catch e (ListT m) a
+liftCatch catchE m h = ListT $ runListT m
+    `catchE` \ e -> runListT (h e)
+{-# INLINE liftCatch #-}

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Maybe.hs

@@ -0,0 +1,241 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.Maybe
+-- Copyright   :  (c) 2007 Yitzak Gale, Eric Kidd
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- The 'MaybeT' monad transformer extends a monad with the ability to exit
+-- the computation without returning a value.
+--
+-- A sequence of actions produces a value only if all the actions in
+-- the sequence do.  If one exits, the rest of the sequence is skipped
+-- and the composite action exits.
+--
+-- For a variant allowing a range of exception values, see
+-- "Control.Monad.Trans.Except".
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.Maybe (
+    -- * The MaybeT monad transformer
+    MaybeT(..),
+    mapMaybeT,
+    -- * Monad transformations
+    maybeToExceptT,
+    exceptToMaybeT,
+    -- * Lifting other operations
+    liftCallCC,
+    liftCatch,
+    liftListen,
+    liftPass,
+  ) where
+
+import Control.Monad.IO.Class
+import Control.Monad.Signatures
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except (ExceptT(..))
+import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
+
+import Control.Applicative
+import Control.Monad (MonadPlus(mzero, mplus), liftM)
+#if MIN_VERSION_base(4,9,0)
+import qualified Control.Monad.Fail as Fail
+#endif
+import Control.Monad.Fix (MonadFix(mfix))
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
+import Data.Foldable (Foldable(foldMap))
+import Data.Maybe (fromMaybe)
+import Data.Traversable (Traversable(traverse))
+
+-- | The parameterizable maybe monad, obtained by composing an arbitrary
+-- monad with the 'Maybe' monad.
+--
+-- Computations are actions that may produce a value or exit.
+--
+-- The 'return' function yields a computation that produces that
+-- value, while @>>=@ sequences two subcomputations, exiting if either
+-- computation does.
+newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
+
+instance (Eq1 m) => Eq1 (MaybeT m) where
+    liftEq eq (MaybeT x) (MaybeT y) = liftEq (liftEq eq) x y
+    {-# INLINE liftEq #-}
+
+instance (Ord1 m) => Ord1 (MaybeT m) where
+    liftCompare comp (MaybeT x) (MaybeT y) = liftCompare (liftCompare comp) x y
+    {-# INLINE liftCompare #-}
+
+instance (Read1 m) => Read1 (MaybeT m) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "MaybeT" MaybeT
+      where
+        rp' = liftReadsPrec rp rl
+        rl' = liftReadList rp rl
+
+instance (Show1 m) => Show1 (MaybeT m) where
+    liftShowsPrec sp sl d (MaybeT m) =
+        showsUnaryWith (liftShowsPrec sp' sl') "MaybeT" d m
+      where
+        sp' = liftShowsPrec sp sl
+        sl' = liftShowList sp sl
+
+instance (Eq1 m, Eq a) => Eq (MaybeT m a) where (==) = eq1
+instance (Ord1 m, Ord a) => Ord (MaybeT m a) where compare = compare1
+instance (Read1 m, Read a) => Read (MaybeT m a) where readsPrec = readsPrec1
+instance (Show1 m, Show a) => Show (MaybeT m a) where showsPrec = showsPrec1
+
+-- | Transform the computation inside a @MaybeT@.
+--
+-- * @'runMaybeT' ('mapMaybeT' f m) = f ('runMaybeT' m)@
+mapMaybeT :: (m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
+mapMaybeT f = MaybeT . f . runMaybeT
+{-# INLINE mapMaybeT #-}
+
+-- | Convert a 'MaybeT' computation to 'ExceptT', with a default
+-- exception value.
+maybeToExceptT :: (Functor m) => e -> MaybeT m a -> ExceptT e m a
+maybeToExceptT e (MaybeT m) = ExceptT $ fmap (maybe (Left e) Right) m
+{-# INLINE maybeToExceptT #-}
+
+-- | Convert a 'ExceptT' computation to 'MaybeT', discarding the
+-- value of any exception.
+exceptToMaybeT :: (Functor m) => ExceptT e m a -> MaybeT m a
+exceptToMaybeT (ExceptT m) = MaybeT $ fmap (either (const Nothing) Just) m
+{-# INLINE exceptToMaybeT #-}
+
+instance (Functor m) => Functor (MaybeT m) where
+    fmap f = mapMaybeT (fmap (fmap f))
+    {-# INLINE fmap #-}
+
+instance (Foldable f) => Foldable (MaybeT f) where
+    foldMap f (MaybeT a) = foldMap (foldMap f) a
+    {-# INLINE foldMap #-}
+
+instance (Traversable f) => Traversable (MaybeT f) where
+    traverse f (MaybeT a) = MaybeT <$> traverse (traverse f) a
+    {-# INLINE traverse #-}
+
+instance (Functor m, Monad m) => Applicative (MaybeT m) where
+    pure = MaybeT . return . Just
+    {-# INLINE pure #-}
+    mf <*> mx = MaybeT $ do
+        mb_f <- runMaybeT mf
+        case mb_f of
+            Nothing -> return Nothing
+            Just f  -> do
+                mb_x <- runMaybeT mx
+                case mb_x of
+                    Nothing -> return Nothing
+                    Just x  -> return (Just (f x))
+    {-# INLINE (<*>) #-}
+    m *> k = m >>= \_ -> k
+    {-# INLINE (*>) #-}
+
+instance (Functor m, Monad m) => Alternative (MaybeT m) where
+    empty = MaybeT (return Nothing)
+    {-# INLINE empty #-}
+    x <|> y = MaybeT $ do
+        v <- runMaybeT x
+        case v of
+            Nothing -> runMaybeT y
+            Just _  -> return v
+    {-# INLINE (<|>) #-}
+
+instance (Monad m) => Monad (MaybeT m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return = MaybeT . return . Just
+    {-# INLINE return #-}
+#endif
+    x >>= f = MaybeT $ do
+        v <- runMaybeT x
+        case v of
+            Nothing -> return Nothing
+            Just y  -> runMaybeT (f y)
+    {-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
+    fail _ = MaybeT (return Nothing)
+    {-# INLINE fail #-}
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Monad m) => Fail.MonadFail (MaybeT m) where
+    fail _ = MaybeT (return Nothing)
+    {-# INLINE fail #-}
+#endif
+
+instance (Monad m) => MonadPlus (MaybeT m) where
+    mzero = MaybeT (return Nothing)
+    {-# INLINE mzero #-}
+    mplus x y = MaybeT $ do
+        v <- runMaybeT x
+        case v of
+            Nothing -> runMaybeT y
+            Just _  -> return v
+    {-# INLINE mplus #-}
+
+instance (MonadFix m) => MonadFix (MaybeT m) where
+    mfix f = MaybeT (mfix (runMaybeT . f . fromMaybe bomb))
+      where bomb = error "mfix (MaybeT): inner computation returned Nothing"
+    {-# INLINE mfix #-}
+
+instance MonadTrans MaybeT where
+    lift = MaybeT . liftM Just
+    {-# INLINE lift #-}
+
+instance (MonadIO m) => MonadIO (MaybeT m) where
+    liftIO = lift . liftIO
+    {-# INLINE liftIO #-}
+
+#if MIN_VERSION_base(4,4,0)
+instance (MonadZip m) => MonadZip (MaybeT m) where
+    mzipWith f (MaybeT a) (MaybeT b) = MaybeT $ mzipWith (liftA2 f) a b
+    {-# INLINE mzipWith #-}
+#endif
+
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (MaybeT m) where
+    contramap f = MaybeT . contramap (fmap f) . runMaybeT
+    {-# INLINE contramap #-}
+#endif
+
+-- | Lift a @callCC@ operation to the new monad.
+liftCallCC :: CallCC m (Maybe a) (Maybe b) -> CallCC (MaybeT m) a b
+liftCallCC callCC f =
+    MaybeT $ callCC $ \ c -> runMaybeT (f (MaybeT . c . Just))
+{-# INLINE liftCallCC #-}
+
+-- | Lift a @catchE@ operation to the new monad.
+liftCatch :: Catch e m (Maybe a) -> Catch e (MaybeT m) a
+liftCatch f m h = MaybeT $ f (runMaybeT m) (runMaybeT . h)
+{-# INLINE liftCatch #-}
+
+-- | Lift a @listen@ operation to the new monad.
+liftListen :: (Monad m) => Listen w m (Maybe a) -> Listen w (MaybeT m) a
+liftListen listen = mapMaybeT $ \ m -> do
+    (a, w) <- listen m
+    return $! fmap (\ r -> (r, w)) a
+{-# INLINE liftListen #-}
+
+-- | Lift a @pass@ operation to the new monad.
+liftPass :: (Monad m) => Pass w m (Maybe a) -> Pass w (MaybeT m) a
+liftPass pass = mapMaybeT $ \ m -> pass $ do
+    a <- m
+    return $! case a of
+        Nothing     -> (Nothing, id)
+        Just (v, f) -> (Just v, f)
+{-# INLINE liftPass #-}

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.RWS
+-- 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
+--
+-- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'.
+-- This version is lazy; for a constant-space version with almost the
+-- same interface, see "Control.Monad.Trans.RWS.CPS".
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.RWS (
+    module Control.Monad.Trans.RWS.Lazy
+  ) where
+
+import Control.Monad.Trans.RWS.Lazy

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS/CPS.hs

@@ -0,0 +1,406 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.RWS.CPS
+-- Copyright   :  (c) Daniel Mendler 2016,
+--                (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
+--
+-- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'.
+-- This version uses continuation-passing-style for the writer part
+-- to achieve constant space usage.
+-- For a lazy version with the same interface,
+-- see "Control.Monad.Trans.RWS.Lazy".
+-----------------------------------------------------------------------------
+  
+module Control.Monad.Trans.RWS.CPS (
+    -- * The RWS monad
+    RWS,
+    rws,
+    runRWS,
+    evalRWS,
+    execRWS,
+    mapRWS,
+    withRWS,
+    -- * The RWST monad transformer
+    RWST,
+    rwsT,
+    runRWST,
+    evalRWST,
+    execRWST,
+    mapRWST,
+    withRWST,
+    -- * Reader operations
+    reader,
+    ask,
+    local,
+    asks,
+    -- * Writer operations
+    writer,
+    tell,
+    listen,
+    listens,
+    pass,
+    censor,
+    -- * State operations
+    state,
+    get,
+    put,
+    modify,
+    gets,
+    -- * Lifting other operations
+    liftCallCC,
+    liftCallCC',
+    liftCatch,
+  ) where
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Fix
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+import Control.Monad.Signatures
+import Data.Functor.Identity
+
+#if !(MIN_VERSION_base(4,8,0))
+import Data.Monoid
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+import qualified Control.Monad.Fail as Fail
+#endif
+
+-- | A monad containing an environment of type @r@, output of type @w@
+-- and an updatable state of type @s@.
+type RWS r w s = RWST r w s Identity
+
+-- | Construct an RWS computation from a function.
+-- (The inverse of 'runRWS'.)
+rws :: (Monoid w) => (r -> s -> (a, s, w)) -> RWS r w s a
+rws f = RWST $ \ r s w ->
+    let (a, s', w') = f r s; wt = w `mappend` w' in wt `seq` return (a, s', wt)
+{-# INLINE rws #-}
+
+-- | Unwrap an RWS computation as a function.
+-- (The inverse of 'rws'.)
+runRWS :: (Monoid w) => RWS r w s a -> r -> s -> (a, s, w)
+runRWS m r s = runIdentity (runRWST m r s)
+{-# INLINE runRWS #-}
+
+-- | Evaluate a computation with the given initial state and environment,
+-- returning the final value and output, discarding the final state.
+evalRWS :: (Monoid w)
+        => RWS r w s a  -- ^RWS computation to execute
+        -> r            -- ^initial environment
+        -> s            -- ^initial value
+        -> (a, w)       -- ^final value and output
+evalRWS m r s = let
+    (a, _, w) = runRWS m r s
+    in (a, w)
+{-# INLINE evalRWS #-}
+
+-- | Evaluate a computation with the given initial state and environment,
+-- returning the final state and output, discarding the final value.
+execRWS :: (Monoid w)
+        => RWS r w s a  -- ^RWS computation to execute
+        -> r            -- ^initial environment
+        -> s            -- ^initial value
+        -> (s, w)       -- ^final state and output
+execRWS m r s = let
+    (_, s', w) = runRWS m r s
+    in (s', w)
+{-# INLINE execRWS #-}
+
+-- | Map the return value, final state and output of a computation using
+-- the given function.
+--
+-- * @'runRWS' ('mapRWS' f m) r s = f ('runRWS' m r s)@
+mapRWS :: (Monoid w, Monoid w') => ((a, s, w) -> (b, s, w')) -> RWS r w s a -> RWS r w' s b
+mapRWS f = mapRWST (Identity . f . runIdentity)
+{-# INLINE mapRWS #-}
+
+-- | @'withRWS' f m@ executes action @m@ with an initial environment
+-- and state modified by applying @f@.
+--
+-- * @'runRWS' ('withRWS' f m) r s = 'uncurry' ('runRWS' m) (f r s)@
+withRWS :: (r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a
+withRWS = withRWST
+{-# INLINE withRWS #-}
+
+-- ---------------------------------------------------------------------------
+-- | A monad transformer adding reading an environment of type @r@,
+-- collecting an output of type @w@ and updating a state of type @s@
+-- to an inner monad @m@.
+newtype RWST r w s m a = RWST { unRWST :: r -> s -> w -> m (a, s, w) }
+
+-- | Construct an RWST computation from a function.
+-- (The inverse of 'runRWST'.)
+rwsT :: (Functor m, Monoid w) => (r -> s -> m (a, s, w)) -> RWST r w s m a
+rwsT f = RWST $ \ r s w ->
+     (\ (a, s', w') -> let wt = w `mappend` w' in wt `seq` (a, s', wt)) <$> f r s
+{-# INLINE rwsT #-}
+
+-- | Unwrap an RWST computation as a function.
+-- (The inverse of 'rwsT'.)
+runRWST :: (Monoid w) => RWST r w s m a -> r -> s -> m (a, s, w)
+runRWST m r s = unRWST m r s mempty
+{-# INLINE runRWST #-}
+
+-- | Evaluate a computation with the given initial state and environment,
+-- returning the final value and output, discarding the final state.
+evalRWST :: (Monad m, Monoid w)
+         => RWST r w s m a      -- ^computation to execute
+         -> r                   -- ^initial environment
+         -> s                   -- ^initial value
+         -> m (a, w)            -- ^computation yielding final value and output
+evalRWST m r s = do
+    (a, _, w) <- runRWST m r s
+    return (a, w)
+{-# INLINE evalRWST #-}
+
+-- | Evaluate a computation with the given initial state and environment,
+-- returning the final state and output, discarding the final value.
+execRWST :: (Monad m, Monoid w)
+         => RWST r w s m a      -- ^computation to execute
+         -> r                   -- ^initial environment
+         -> s                   -- ^initial value
+         -> m (s, w)            -- ^computation yielding final state and output
+execRWST m r s = do
+    (_, s', w) <- runRWST m r s
+    return (s', w)
+{-# INLINE execRWST #-}
+
+-- | Map the inner computation using the given function.
+--
+-- * @'runRWST' ('mapRWST' f m) r s = f ('runRWST' m r s)@
+--mapRWST :: (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
+mapRWST :: (Monad n, Monoid w, Monoid w') =>
+    (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
+mapRWST f m = RWST $ \ r s w -> do
+    (a, s', w') <- f (runRWST m r s)
+    let wt = w `mappend` w'
+    wt `seq` return (a, s', wt)
+{-# INLINE mapRWST #-}
+
+-- | @'withRWST' f m@ executes action @m@ with an initial environment
+-- and state modified by applying @f@.
+--
+-- * @'runRWST' ('withRWST' f m) r s = 'uncurry' ('runRWST' m) (f r s)@
+withRWST :: (r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
+withRWST f m = RWST $ \ r s -> uncurry (unRWST m) (f r s)
+{-# INLINE withRWST #-}
+
+instance (Functor m) => Functor (RWST r w s m) where
+    fmap f m = RWST $ \ r s w -> (\ (a, s', w') -> (f a, s', w')) <$> unRWST m r s w
+    {-# INLINE fmap #-}
+
+instance (Functor m, Monad m) => Applicative (RWST r w s m) where
+    pure a = RWST $ \ _ s w -> return (a, s, w)
+    {-# INLINE pure #-}
+
+    RWST mf <*> RWST mx = RWST $ \ r s w -> do
+        (f, s', w')    <- mf r s w
+        (x, s'', w'') <- mx r s' w'
+        return (f x, s'', w'')
+    {-# INLINE (<*>) #-}
+
+instance (Functor m, MonadPlus m) => Alternative (RWST r w s m) where
+    empty = RWST $ \ _ _ _ -> mzero
+    {-# INLINE empty #-}
+
+    RWST m <|> RWST n = RWST $ \ r s w -> m r s w `mplus` n r s w
+    {-# INLINE (<|>) #-}
+
+instance (Monad m) => Monad (RWST r w s m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return a = RWST $ \ _ s w -> return (a, s, w)
+    {-# INLINE return #-}
+#endif
+
+    m >>= k = RWST $ \ r s w -> do
+        (a, s', w')    <- unRWST m r s w
+        unRWST (k a) r s' w'
+    {-# INLINE (>>=) #-}
+
+#if !(MIN_VERSION_base(4,13,0))
+    fail msg = RWST $ \ _ _ _ -> fail msg
+    {-# INLINE fail #-}
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Fail.MonadFail m) => Fail.MonadFail (RWST r w s m) where
+    fail msg = RWST $ \ _ _ _ -> Fail.fail msg
+    {-# INLINE fail #-}
+#endif
+
+instance (Functor m, MonadPlus m) => MonadPlus (RWST r w s m) where
+    mzero = empty
+    {-# INLINE mzero #-}
+    mplus = (<|>)
+    {-# INLINE mplus #-}
+
+instance (MonadFix m) => MonadFix (RWST r w s m) where
+    mfix f = RWST $ \ r s w -> mfix $ \ ~(a, _, _) -> unRWST (f a) r s w
+    {-# INLINE mfix #-}
+
+instance MonadTrans (RWST r w s) where
+    lift m = RWST $ \ _ s w -> do
+        a <- m
+        return (a, s, w)
+    {-# INLINE lift #-}
+
+instance (MonadIO m) => MonadIO (RWST r w s m) where
+    liftIO = lift . liftIO
+    {-# INLINE liftIO #-}
+-- ---------------------------------------------------------------------------
+-- Reader operations
+
+-- | Constructor for computations in the reader monad (equivalent to 'asks').
+reader :: (Monad m) => (r -> a) -> RWST r w s m a
+reader = asks
+{-# INLINE reader #-}
+
+-- | Fetch the value of the environment.
+ask :: (Monad m) => RWST r w s m r
+ask = asks id
+{-# INLINE ask #-}
+
+-- | Execute a computation in a modified environment
+--
+-- * @'runRWST' ('local' f m) r s = 'runRWST' m (f r) s@
+local :: (r -> r) -> RWST r w s m a -> RWST r w s m a
+local f m = RWST $ \ r s w -> unRWST m (f r) s w
+{-# INLINE local #-}
+
+-- | Retrieve a function of the current environment.
+--
+-- * @'asks' f = 'liftM' f 'ask'@
+asks :: (Monad m) => (r -> a) -> RWST r w s m a
+asks f = RWST $ \ r s w -> return (f r, s, w)
+{-# INLINE asks #-}
+
+-- ---------------------------------------------------------------------------
+-- Writer operations
+
+-- | Construct a writer computation from a (result, output) pair.
+writer :: (Monoid w, Monad m) => (a, w) -> RWST r w s m a
+writer (a, w') = RWST $ \ _ s w -> let wt = w `mappend` w' in wt `seq` return (a, s, wt)
+{-# INLINE writer #-}
+
+-- | @'tell' w@ is an action that produces the output @w@.
+tell :: (Monoid w, Monad m) => w -> RWST r w s m ()
+tell w' = writer ((), w')
+{-# INLINE tell #-}
+
+-- | @'listen' m@ is an action that executes the action @m@ and adds its
+-- output to the value of the computation.
+--
+-- * @'runRWST' ('listen' m) r s = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runRWST' m r s)@
+listen :: (Monoid w, Monad m) => RWST r w s m a -> RWST r w s m (a, w)
+listen = listens id
+{-# INLINE listen #-}
+
+-- | @'listens' f m@ is an action that executes the action @m@ and adds
+-- the result of applying @f@ to the output to the value of the computation.
+--
+-- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@
+--
+-- * @'runRWST' ('listens' f m) r s = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runRWST' m r s)@
+listens :: (Monoid w, Monad m) => (w -> b) -> RWST r w s m a -> RWST r w s m (a, b)
+listens f m = RWST $ \ r s w -> do
+    (a, s', w') <- runRWST m r s
+    let wt = w `mappend` w'
+    wt `seq` return ((a, f w'), s', wt)
+{-# INLINE listens #-}
+
+-- | @'pass' m@ is an action that executes the action @m@, which returns
+-- a value and a function, and returns the value, applying the function
+-- to the output.
+--
+-- * @'runRWST' ('pass' m) r s = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runRWST' m r s)@
+pass :: (Monoid w, Monoid w', Monad m) => RWST r w s m (a, w -> w') -> RWST r w' s m a
+pass m = RWST $ \ r s w -> do
+    ((a, f), s', w') <- runRWST m r s
+    let wt = w `mappend` f w'
+    wt `seq` return (a, s', wt)
+{-# INLINE pass #-}
+
+-- | @'censor' f m@ is an action that executes the action @m@ and
+-- applies the function @f@ to its output, leaving the return value
+-- unchanged.
+--
+-- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@
+--
+-- * @'runRWST' ('censor' f m) r s = 'liftM' (\\ (a, w) -> (a, f w)) ('runRWST' m r s)@
+censor :: (Monoid w, Monad m) => (w -> w) -> RWST r w s m a -> RWST r w s m a
+censor f m = RWST $ \ r s w -> do
+    (a, s', w') <- runRWST m r s
+    let wt = w `mappend` f w'
+    wt `seq` return (a, s', wt)
+{-# INLINE censor #-}
+
+-- ---------------------------------------------------------------------------
+-- State operations
+
+-- | Construct a state monad computation from a state transformer function.
+state :: (Monad m) => (s -> (a, s)) -> RWST r w s m a
+state f = RWST $ \ _ s w -> let (a, s') = f s in return (a, s', w)
+{-# INLINE state #-}
+
+-- | Fetch the current value of the state within the monad.
+get :: (Monad m) =>RWST r w s m s
+get = gets id
+{-# INLINE get #-}
+
+-- | @'put' s@ sets the state within the monad to @s@.
+put :: (Monad m) =>s -> RWST r w s m ()
+put s = RWST $ \ _ _ w -> return ((), s, w)
+{-# INLINE put #-}
+
+-- | @'modify' f@ is an action that updates the state to the result of
+-- applying @f@ to the current state.
+--
+-- * @'modify' f = 'get' >>= ('put' . f)@
+modify :: (Monad m) =>(s -> s) -> RWST r w s m ()
+modify f = RWST $ \ _ s w -> return ((), f s, w)
+{-# INLINE modify #-}
+
+-- | Get a specific component of the state, using a projection function
+-- supplied.
+--
+-- * @'gets' f = 'liftM' f 'get'@
+gets :: (Monad m) =>(s -> a) -> RWST r w s m a
+gets f = RWST $ \ _ s w -> return (f s, s, w)
+{-# INLINE gets #-}
+
+-- | Uniform lifting of a @callCC@ operation to the new monad.
+-- This version rolls back to the original state on entering the
+-- continuation.
+liftCallCC :: CallCC m (a,s,w) (b,s,w) -> CallCC (RWST r w s m) a b
+liftCallCC callCC f = RWST $ \ r s w ->
+    callCC $ \ c -> unRWST (f (\ a -> RWST $ \ _ _ _ -> c (a, s, w))) r s w
+{-# INLINE liftCallCC #-}
+
+-- | In-situ lifting of a @callCC@ operation to the new monad.
+-- This version uses the current state on entering the continuation.
+liftCallCC' :: CallCC m (a,s,w) (b,s,w) -> CallCC (RWST r w s m) a b
+liftCallCC' callCC f = RWST $ \ r s w ->
+    callCC $ \ c -> unRWST (f (\ a -> RWST $ \ _ s' _ -> c (a, s', w))) r s w
+{-# INLINE liftCallCC' #-}
+
+-- | Lift a @catchE@ operation to the new monad.
+liftCatch :: Catch e m (a,s,w) -> Catch e (RWST r w s m) a
+liftCatch catchE m h =
+    RWST $ \ r s w -> unRWST m r s w `catchE` \ e -> unRWST (h e) r s w
+{-# INLINE liftCatch #-}

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS/Lazy.hs

@@ -0,0 +1,389 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.RWS.Lazy
+-- 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
+--
+-- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'.
+-- This version is lazy; for a constant-space version with almost the
+-- same interface, see "Control.Monad.Trans.RWS.CPS".
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.RWS.Lazy (
+    -- * The RWS monad
+    RWS,
+    rws,
+    runRWS,
+    evalRWS,
+    execRWS,
+    mapRWS,
+    withRWS,
+    -- * The RWST monad transformer
+    RWST(..),
+    evalRWST,
+    execRWST,
+    mapRWST,
+    withRWST,
+    -- * Reader operations
+    reader,
+    ask,
+    local,
+    asks,
+    -- * Writer operations
+    writer,
+    tell,
+    listen,
+    listens,
+    pass,
+    censor,
+    -- * State operations
+    state,
+    get,
+    put,
+    modify,
+    gets,
+    -- * Lifting other operations
+    liftCallCC,
+    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
+import Data.Monoid
+
+-- | A monad containing an environment of type @r@, output of type @w@
+-- and an updatable state of type @s@.
+type RWS r w s = RWST r w s Identity
+
+-- | Construct an RWS computation from a function.
+-- (The inverse of 'runRWS'.)
+rws :: (r -> s -> (a, s, w)) -> RWS r w s a
+rws f = RWST (\ r s -> Identity (f r s))
+{-# INLINE rws #-}
+
+-- | Unwrap an RWS computation as a function.
+-- (The inverse of 'rws'.)
+runRWS :: RWS r w s a -> r -> s -> (a, s, w)
+runRWS m r s = runIdentity (runRWST m r s)
+{-# INLINE runRWS #-}
+
+-- | Evaluate a computation with the given initial state and environment,
+-- returning the final value and output, discarding the final state.
+evalRWS :: RWS r w s a  -- ^RWS computation to execute
+        -> r            -- ^initial environment
+        -> s            -- ^initial value
+        -> (a, w)       -- ^final value and output
+evalRWS m r s = let
+    (a, _, w) = runRWS m r s
+    in (a, w)
+{-# INLINE evalRWS #-}
+
+-- | Evaluate a computation with the given initial state and environment,
+-- returning the final state and output, discarding the final value.
+execRWS :: RWS r w s a  -- ^RWS computation to execute
+        -> r            -- ^initial environment
+        -> s            -- ^initial value
+        -> (s, w)       -- ^final state and output
+execRWS m r s = let
+    (_, s', w) = runRWS m r s
+    in (s', w)
+{-# INLINE execRWS #-}
+
+-- | Map the return value, final state and output of a computation using
+-- the given function.
+--
+-- * @'runRWS' ('mapRWS' f m) r s = f ('runRWS' m r s)@
+mapRWS :: ((a, s, w) -> (b, s, w')) -> RWS r w s a -> RWS r w' s b
+mapRWS f = mapRWST (Identity . f . runIdentity)
+{-# INLINE mapRWS #-}
+
+-- | @'withRWS' f m@ executes action @m@ with an initial environment
+-- and state modified by applying @f@.
+--
+-- * @'runRWS' ('withRWS' f m) r s = 'uncurry' ('runRWS' m) (f r s)@
+withRWS :: (r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a
+withRWS = withRWST
+{-# INLINE withRWS #-}
+
+-- ---------------------------------------------------------------------------
+-- | A monad transformer adding reading an environment of type @r@,
+-- collecting an output of type @w@ and updating a state of type @s@
+-- to an inner monad @m@.
+newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) }
+
+-- | Evaluate a computation with the given initial state and environment,
+-- returning the final value and output, discarding the final state.
+evalRWST :: (Monad m)
+         => RWST r w s m a      -- ^computation to execute
+         -> r                   -- ^initial environment
+         -> s                   -- ^initial value
+         -> m (a, w)            -- ^computation yielding final value and output
+evalRWST m r s = do
+    ~(a, _, w) <- runRWST m r s
+    return (a, w)
+{-# INLINE evalRWST #-}
+
+-- | Evaluate a computation with the given initial state and environment,
+-- returning the final state and output, discarding the final value.
+execRWST :: (Monad m)
+         => RWST r w s m a      -- ^computation to execute
+         -> r                   -- ^initial environment
+         -> s                   -- ^initial value
+         -> m (s, w)            -- ^computation yielding final state and output
+execRWST m r s = do
+    ~(_, s', w) <- runRWST m r s
+    return (s', w)
+{-# INLINE execRWST #-}
+
+-- | Map the inner computation using the given function.
+--
+-- * @'runRWST' ('mapRWST' f m) r s = f ('runRWST' m r s)@
+mapRWST :: (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
+mapRWST f m = RWST $ \ r s -> f (runRWST m r s)
+{-# INLINE mapRWST #-}
+
+-- | @'withRWST' f m@ executes action @m@ with an initial environment
+-- and state modified by applying @f@.
+--
+-- * @'runRWST' ('withRWST' f m) r s = 'uncurry' ('runRWST' m) (f r s)@
+withRWST :: (r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
+withRWST f m = RWST $ \ r s -> uncurry (runRWST m) (f r s)
+{-# INLINE withRWST #-}
+
+instance (Functor m) => Functor (RWST r w s m) where
+    fmap f m = RWST $ \ r s ->
+        fmap (\ ~(a, s', w) -> (f a, s', w)) $ runRWST m r s
+    {-# INLINE fmap #-}
+
+instance (Monoid w, Functor m, Monad m) => Applicative (RWST r w s m) where
+    pure a = RWST $ \ _ s -> return (a, s, mempty)
+    {-# INLINE pure #-}
+    RWST mf <*> RWST mx  = RWST $ \ r s -> do
+        ~(f, s', w)  <- mf r s
+        ~(x, s'',w') <- mx r s'
+        return (f x, s'', w `mappend` w')
+    {-# INLINE (<*>) #-}
+
+instance (Monoid w, Functor m, MonadPlus m) => Alternative (RWST r w s m) where
+    empty = RWST $ \ _ _ -> mzero
+    {-# INLINE empty #-}
+    RWST m <|> RWST n = RWST $ \ r s -> m r s `mplus` n r s
+    {-# INLINE (<|>) #-}
+
+instance (Monoid w, Monad m) => Monad (RWST r w s m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return a = RWST $ \ _ s -> return (a, s, mempty)
+    {-# INLINE return #-}
+#endif
+    m >>= k  = RWST $ \ r s -> do
+        ~(a, s', w)  <- runRWST m r s
+        ~(b, s'',w') <- runRWST (k a) r s'
+        return (b, s'', w `mappend` w')
+    {-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
+    fail msg = RWST $ \ _ _ -> fail msg
+    {-# INLINE fail #-}
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (RWST r w s m) where
+    fail msg = RWST $ \ _ _ -> Fail.fail msg
+    {-# INLINE fail #-}
+#endif
+
+instance (Monoid w, MonadPlus m) => MonadPlus (RWST r w s m) where
+    mzero = RWST $ \ _ _ -> mzero
+    {-# INLINE mzero #-}
+    RWST m `mplus` RWST n = RWST $ \ r s -> m r s `mplus` n r s
+    {-# INLINE mplus #-}
+
+instance (Monoid w, MonadFix m) => MonadFix (RWST r w s m) where
+    mfix f = RWST $ \ r s -> mfix $ \ ~(a, _, _) -> runRWST (f a) r s
+    {-# INLINE mfix #-}
+
+instance (Monoid w) => MonadTrans (RWST r w s) where
+    lift m = RWST $ \ _ s -> do
+        a <- m
+        return (a, s, mempty)
+    {-# INLINE lift #-}
+
+instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where
+    liftIO = lift . liftIO
+    {-# INLINE liftIO #-}
+
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (RWST r w s m) where
+    contramap f m = RWST $ \r s ->
+      contramap (\ ~(a, s', w) -> (f a, s', w)) $ runRWST m r s
+    {-# INLINE contramap #-}
+#endif
+
+-- ---------------------------------------------------------------------------
+-- Reader operations
+
+-- | Constructor for computations in the reader monad (equivalent to 'asks').
+reader :: (Monoid w, Monad m) => (r -> a) -> RWST r w s m a
+reader = asks
+{-# INLINE reader #-}
+
+-- | Fetch the value of the environment.
+ask :: (Monoid w, Monad m) => RWST r w s m r
+ask = RWST $ \ r s -> return (r, s, mempty)
+{-# INLINE ask #-}
+
+-- | Execute a computation in a modified environment
+--
+-- * @'runRWST' ('local' f m) r s = 'runRWST' m (f r) s@
+local :: (r -> r) -> RWST r w s m a -> RWST r w s m a
+local f m = RWST $ \ r s -> runRWST m (f r) s
+{-# INLINE local #-}
+
+-- | Retrieve a function of the current environment.
+--
+-- * @'asks' f = 'liftM' f 'ask'@
+asks :: (Monoid w, Monad m) => (r -> a) -> RWST r w s m a
+asks f = RWST $ \ r s -> return (f r, s, mempty)
+{-# INLINE asks #-}
+
+-- ---------------------------------------------------------------------------
+-- Writer operations
+
+-- | Construct a writer computation from a (result, output) pair.
+writer :: (Monad m) => (a, w) -> RWST r w s m a
+writer (a, w) = RWST $ \ _ s -> return (a, s, w)
+{-# INLINE writer #-}
+
+-- | @'tell' w@ is an action that produces the output @w@.
+tell :: (Monad m) => w -> RWST r w s m ()
+tell w = RWST $ \ _ s -> return ((),s,w)
+{-# INLINE tell #-}
+
+-- | @'listen' m@ is an action that executes the action @m@ and adds its
+-- output to the value of the computation.
+--
+-- * @'runRWST' ('listen' m) r s = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runRWST' m r s)@
+listen :: (Monad m) => RWST r w s m a -> RWST r w s m (a, w)
+listen m = RWST $ \ r s -> do
+    ~(a, s', w) <- runRWST m r s
+    return ((a, w), s', w)
+{-# INLINE listen #-}
+
+-- | @'listens' f m@ is an action that executes the action @m@ and adds
+-- the result of applying @f@ to the output to the value of the computation.
+--
+-- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@
+--
+-- * @'runRWST' ('listens' f m) r s = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runRWST' m r s)@
+listens :: (Monad m) => (w -> b) -> RWST r w s m a -> RWST r w s m (a, b)
+listens f m = RWST $ \ r s -> do
+    ~(a, s', w) <- runRWST m r s
+    return ((a, f w), s', w)
+{-# INLINE listens #-}
+
+-- | @'pass' m@ is an action that executes the action @m@, which returns
+-- a value and a function, and returns the value, applying the function
+-- to the output.
+--
+-- * @'runRWST' ('pass' m) r s = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runRWST' m r s)@
+pass :: (Monad m) => RWST r w s m (a, w -> w) -> RWST r w s m a
+pass m = RWST $ \ r s -> do
+    ~((a, f), s', w) <- runRWST m r s
+    return (a, s', f w)
+{-# INLINE pass #-}
+
+-- | @'censor' f m@ is an action that executes the action @m@ and
+-- applies the function @f@ to its output, leaving the return value
+-- unchanged.
+--
+-- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@
+--
+-- * @'runRWST' ('censor' f m) r s = 'liftM' (\\ (a, w) -> (a, f w)) ('runRWST' m r s)@
+censor :: (Monad m) => (w -> w) -> RWST r w s m a -> RWST r w s m a
+censor f m = RWST $ \ r s -> do
+    ~(a, s', w) <- runRWST m r s
+    return (a, s', f w)
+{-# INLINE censor #-}
+
+-- ---------------------------------------------------------------------------
+-- State operations
+
+-- | Construct a state monad computation from a state transformer function.
+state :: (Monoid w, Monad m) => (s -> (a,s)) -> RWST r w s m a
+state f = RWST $ \ _ s -> let (a,s') = f s  in  return (a, s', mempty)
+{-# INLINE state #-}
+
+-- | Fetch the current value of the state within the monad.
+get :: (Monoid w, Monad m) => RWST r w s m s
+get = RWST $ \ _ s -> return (s, s, mempty)
+{-# INLINE get #-}
+
+-- | @'put' s@ sets the state within the monad to @s@.
+put :: (Monoid w, Monad m) => s -> RWST r w s m ()
+put s = RWST $ \ _ _ -> return ((), s, mempty)
+{-# INLINE put #-}
+
+-- | @'modify' f@ is an action that updates the state to the result of
+-- applying @f@ to the current state.
+--
+-- * @'modify' f = 'get' >>= ('put' . f)@
+modify :: (Monoid w, Monad m) => (s -> s) -> RWST r w s m ()
+modify f = RWST $ \ _ s -> return ((), f s, mempty)
+{-# INLINE modify #-}
+
+-- | Get a specific component of the state, using a projection function
+-- supplied.
+--
+-- * @'gets' f = 'liftM' f 'get'@
+gets :: (Monoid w, Monad m) => (s -> a) -> RWST r w s m a
+gets f = RWST $ \ _ s -> return (f s, s, mempty)
+{-# INLINE gets #-}
+
+-- | Uniform lifting of a @callCC@ operation to the new monad.
+-- This version rolls back to the original state on entering the
+-- continuation.
+liftCallCC :: (Monoid w) =>
+    CallCC m (a,s,w) (b,s,w) -> CallCC (RWST r w s m) a b
+liftCallCC callCC f = RWST $ \ r s ->
+    callCC $ \ c ->
+    runRWST (f (\ a -> RWST $ \ _ _ -> c (a, s, mempty))) r s
+{-# INLINE liftCallCC #-}
+
+-- | In-situ lifting of a @callCC@ operation to the new monad.
+-- This version uses the current state on entering the continuation.
+liftCallCC' :: (Monoid w) =>
+    CallCC m (a,s,w) (b,s,w) -> CallCC (RWST r w s m) a b
+liftCallCC' callCC f = RWST $ \ r s ->
+    callCC $ \ c ->
+    runRWST (f (\ a -> RWST $ \ _ s' -> c (a, s', mempty))) r s
+{-# INLINE liftCallCC' #-}
+
+-- | Lift a @catchE@ operation to the new monad.
+liftCatch :: Catch e m (a,s,w) -> Catch e (RWST r w s m) a
+liftCatch catchE m h =
+    RWST $ \ r s -> runRWST m r s `catchE` \ e -> runRWST (h e) r s
+{-# INLINE liftCatch #-}

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/RWS/Strict.hs

@@ -0,0 +1,392 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.RWS.Strict
+-- 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
+--
+-- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'.
+-- This version is strict; for a lazy version with the same interface,
+-- see "Control.Monad.Trans.RWS.Lazy".
+-- Although the output is built strictly, it is not possible to
+-- achieve constant space behaviour with this transformer: for that,
+-- use "Control.Monad.Trans.RWS.CPS" instead.
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.RWS.Strict (
+    -- * The RWS monad
+    RWS,
+    rws,
+    runRWS,
+    evalRWS,
+    execRWS,
+    mapRWS,
+    withRWS,
+    -- * The RWST monad transformer
+    RWST(..),
+    evalRWST,
+    execRWST,
+    mapRWST,
+    withRWST,
+    -- * Reader operations
+    reader,
+    ask,
+    local,
+    asks,
+    -- * Writer operations
+    writer,
+    tell,
+    listen,
+    listens,
+    pass,
+    censor,
+    -- * State operations
+    state,
+    get,
+    put,
+    modify,
+    gets,
+    -- * Lifting other operations
+    liftCallCC,
+    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
+import Data.Monoid
+
+-- | A monad containing an environment of type @r@, output of type @w@
+-- and an updatable state of type @s@.
+type RWS r w s = RWST r w s Identity
+
+-- | Construct an RWS computation from a function.
+-- (The inverse of 'runRWS'.)
+rws :: (r -> s -> (a, s, w)) -> RWS r w s a
+rws f = RWST (\ r s -> Identity (f r s))
+{-# INLINE rws #-}
+
+-- | Unwrap an RWS computation as a function.
+-- (The inverse of 'rws'.)
+runRWS :: RWS r w s a -> r -> s -> (a, s, w)
+runRWS m r s = runIdentity (runRWST m r s)
+{-# INLINE runRWS #-}
+
+-- | Evaluate a computation with the given initial state and environment,
+-- returning the final value and output, discarding the final state.
+evalRWS :: RWS r w s a  -- ^RWS computation to execute
+        -> r            -- ^initial environment
+        -> s            -- ^initial value
+        -> (a, w)       -- ^final value and output
+evalRWS m r s = let
+    (a, _, w) = runRWS m r s
+    in (a, w)
+{-# INLINE evalRWS #-}
+
+-- | Evaluate a computation with the given initial state and environment,
+-- returning the final state and output, discarding the final value.
+execRWS :: RWS r w s a  -- ^RWS computation to execute
+        -> r            -- ^initial environment
+        -> s            -- ^initial value
+        -> (s, w)       -- ^final state and output
+execRWS m r s = let
+    (_, s', w) = runRWS m r s
+    in (s', w)
+{-# INLINE execRWS #-}
+
+-- | Map the return value, final state and output of a computation using
+-- the given function.
+--
+-- * @'runRWS' ('mapRWS' f m) r s = f ('runRWS' m r s)@
+mapRWS :: ((a, s, w) -> (b, s, w')) -> RWS r w s a -> RWS r w' s b
+mapRWS f = mapRWST (Identity . f . runIdentity)
+{-# INLINE mapRWS #-}
+
+-- | @'withRWS' f m@ executes action @m@ with an initial environment
+-- and state modified by applying @f@.
+--
+-- * @'runRWS' ('withRWS' f m) r s = 'uncurry' ('runRWS' m) (f r s)@
+withRWS :: (r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a
+withRWS = withRWST
+{-# INLINE withRWS #-}
+
+-- ---------------------------------------------------------------------------
+-- | A monad transformer adding reading an environment of type @r@,
+-- collecting an output of type @w@ and updating a state of type @s@
+-- to an inner monad @m@.
+newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) }
+
+-- | Evaluate a computation with the given initial state and environment,
+-- returning the final value and output, discarding the final state.
+evalRWST :: (Monad m)
+         => RWST r w s m a      -- ^computation to execute
+         -> r                   -- ^initial environment
+         -> s                   -- ^initial value
+         -> m (a, w)            -- ^computation yielding final value and output
+evalRWST m r s = do
+    (a, _, w) <- runRWST m r s
+    return (a, w)
+{-# INLINE evalRWST #-}
+
+-- | Evaluate a computation with the given initial state and environment,
+-- returning the final state and output, discarding the final value.
+execRWST :: (Monad m)
+         => RWST r w s m a      -- ^computation to execute
+         -> r                   -- ^initial environment
+         -> s                   -- ^initial value
+         -> m (s, w)            -- ^computation yielding final state and output
+execRWST m r s = do
+    (_, s', w) <- runRWST m r s
+    return (s', w)
+{-# INLINE execRWST #-}
+
+-- | Map the inner computation using the given function.
+--
+-- * @'runRWST' ('mapRWST' f m) r s = f ('runRWST' m r s)@
+mapRWST :: (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
+mapRWST f m = RWST $ \ r s -> f (runRWST m r s)
+{-# INLINE mapRWST #-}
+
+-- | @'withRWST' f m@ executes action @m@ with an initial environment
+-- and state modified by applying @f@.
+--
+-- * @'runRWST' ('withRWST' f m) r s = 'uncurry' ('runRWST' m) (f r s)@
+withRWST :: (r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
+withRWST f m = RWST $ \ r s -> uncurry (runRWST m) (f r s)
+{-# INLINE withRWST #-}
+
+instance (Functor m) => Functor (RWST r w s m) where
+    fmap f m = RWST $ \ r s ->
+        fmap (\ (a, s', w) -> (f a, s', w)) $ runRWST m r s
+    {-# INLINE fmap #-}
+
+instance (Monoid w, Functor m, Monad m) => Applicative (RWST r w s m) where
+    pure a = RWST $ \ _ s -> return (a, s, mempty)
+    {-# INLINE pure #-}
+    RWST mf <*> RWST mx = RWST $ \ r s -> do
+        (f, s', w)  <- mf r s
+        (x, s'',w') <- mx r s'
+        return (f x, s'', w `mappend` w')
+    {-# INLINE (<*>) #-}
+
+instance (Monoid w, Functor m, MonadPlus m) => Alternative (RWST r w s m) where
+    empty = RWST $ \ _ _ -> mzero
+    {-# INLINE empty #-}
+    RWST m <|> RWST n = RWST $ \ r s -> m r s `mplus` n r s
+    {-# INLINE (<|>) #-}
+
+instance (Monoid w, Monad m) => Monad (RWST r w s m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return a = RWST $ \ _ s -> return (a, s, mempty)
+    {-# INLINE return #-}
+#endif
+    m >>= k  = RWST $ \ r s -> do
+        (a, s', w)  <- runRWST m r s
+        (b, s'',w') <- runRWST (k a) r s'
+        return (b, s'', w `mappend` w')
+    {-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
+    fail msg = RWST $ \ _ _ -> fail msg
+    {-# INLINE fail #-}
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (RWST r w s m) where
+    fail msg = RWST $ \ _ _ -> Fail.fail msg
+    {-# INLINE fail #-}
+#endif
+
+instance (Monoid w, MonadPlus m) => MonadPlus (RWST r w s m) where
+    mzero = RWST $ \ _ _ -> mzero
+    {-# INLINE mzero #-}
+    RWST m `mplus` RWST n = RWST $ \ r s -> m r s `mplus` n r s
+    {-# INLINE mplus #-}
+
+instance (Monoid w, MonadFix m) => MonadFix (RWST r w s m) where
+    mfix f = RWST $ \ r s -> mfix $ \ ~(a, _, _) -> runRWST (f a) r s
+    {-# INLINE mfix #-}
+
+instance (Monoid w) => MonadTrans (RWST r w s) where
+    lift m = RWST $ \ _ s -> do
+        a <- m
+        return (a, s, mempty)
+    {-# INLINE lift #-}
+
+instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where
+    liftIO = lift . liftIO
+    {-# INLINE liftIO #-}
+
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (RWST r w s m) where
+    contramap f m = RWST $ \r s ->
+      contramap (\ (a, s', w) -> (f a, s', w)) $ runRWST m r s
+    {-# INLINE contramap #-}
+#endif
+
+-- ---------------------------------------------------------------------------
+-- Reader operations
+
+-- | Constructor for computations in the reader monad (equivalent to 'asks').
+reader :: (Monoid w, Monad m) => (r -> a) -> RWST r w s m a
+reader = asks
+{-# INLINE reader #-}
+
+-- | Fetch the value of the environment.
+ask :: (Monoid w, Monad m) => RWST r w s m r
+ask = RWST $ \ r s -> return (r, s, mempty)
+{-# INLINE ask #-}
+
+-- | Execute a computation in a modified environment
+--
+-- * @'runRWST' ('local' f m) r s = 'runRWST' m (f r) s@
+local :: (r -> r) -> RWST r w s m a -> RWST r w s m a
+local f m = RWST $ \ r s -> runRWST m (f r) s
+{-# INLINE local #-}
+
+-- | Retrieve a function of the current environment.
+--
+-- * @'asks' f = 'liftM' f 'ask'@
+asks :: (Monoid w, Monad m) => (r -> a) -> RWST r w s m a
+asks f = RWST $ \ r s -> return (f r, s, mempty)
+{-# INLINE asks #-}
+
+-- ---------------------------------------------------------------------------
+-- Writer operations
+
+-- | Construct a writer computation from a (result, output) pair.
+writer :: (Monad m) => (a, w) -> RWST r w s m a
+writer (a, w) = RWST $ \ _ s -> return (a, s, w)
+{-# INLINE writer #-}
+
+-- | @'tell' w@ is an action that produces the output @w@.
+tell :: (Monad m) => w -> RWST r w s m ()
+tell w = RWST $ \ _ s -> return ((),s,w)
+{-# INLINE tell #-}
+
+-- | @'listen' m@ is an action that executes the action @m@ and adds its
+-- output to the value of the computation.
+--
+-- * @'runRWST' ('listen' m) r s = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runRWST' m r s)@
+listen :: (Monad m) => RWST r w s m a -> RWST r w s m (a, w)
+listen m = RWST $ \ r s -> do
+    (a, s', w) <- runRWST m r s
+    return ((a, w), s', w)
+{-# INLINE listen #-}
+
+-- | @'listens' f m@ is an action that executes the action @m@ and adds
+-- the result of applying @f@ to the output to the value of the computation.
+--
+-- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@
+--
+-- * @'runRWST' ('listens' f m) r s = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runRWST' m r s)@
+listens :: (Monad m) => (w -> b) -> RWST r w s m a -> RWST r w s m (a, b)
+listens f m = RWST $ \ r s -> do
+    (a, s', w) <- runRWST m r s
+    return ((a, f w), s', w)
+{-# INLINE listens #-}
+
+-- | @'pass' m@ is an action that executes the action @m@, which returns
+-- a value and a function, and returns the value, applying the function
+-- to the output.
+--
+-- * @'runRWST' ('pass' m) r s = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runRWST' m r s)@
+pass :: (Monad m) => RWST r w s m (a, w -> w) -> RWST r w s m a
+pass m = RWST $ \ r s -> do
+    ((a, f), s', w) <- runRWST m r s
+    return (a, s', f w)
+{-# INLINE pass #-}
+
+-- | @'censor' f m@ is an action that executes the action @m@ and
+-- applies the function @f@ to its output, leaving the return value
+-- unchanged.
+--
+-- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@
+--
+-- * @'runRWST' ('censor' f m) r s = 'liftM' (\\ (a, w) -> (a, f w)) ('runRWST' m r s)@
+censor :: (Monad m) => (w -> w) -> RWST r w s m a -> RWST r w s m a
+censor f m = RWST $ \ r s -> do
+    (a, s', w) <- runRWST m r s
+    return (a, s', f w)
+{-# INLINE censor #-}
+
+-- ---------------------------------------------------------------------------
+-- State operations
+
+-- | Construct a state monad computation from a state transformer function.
+state :: (Monoid w, Monad m) => (s -> (a,s)) -> RWST r w s m a
+state f = RWST $ \ _ s -> case f s of (a,s') -> return (a, s', mempty)
+{-# INLINE state #-}
+
+-- | Fetch the current value of the state within the monad.
+get :: (Monoid w, Monad m) => RWST r w s m s
+get = RWST $ \ _ s -> return (s, s, mempty)
+{-# INLINE get #-}
+
+-- | @'put' s@ sets the state within the monad to @s@.
+put :: (Monoid w, Monad m) => s -> RWST r w s m ()
+put s = RWST $ \ _ _ -> return ((), s, mempty)
+{-# INLINE put #-}
+
+-- | @'modify' f@ is an action that updates the state to the result of
+-- applying @f@ to the current state.
+--
+-- * @'modify' f = 'get' >>= ('put' . f)@
+modify :: (Monoid w, Monad m) => (s -> s) -> RWST r w s m ()
+modify f = RWST $ \ _ s -> return ((), f s, mempty)
+{-# INLINE modify #-}
+
+-- | Get a specific component of the state, using a projection function
+-- supplied.
+--
+-- * @'gets' f = 'liftM' f 'get'@
+gets :: (Monoid w, Monad m) => (s -> a) -> RWST r w s m a
+gets f = RWST $ \ _ s -> return (f s, s, mempty)
+{-# INLINE gets #-}
+
+-- | Uniform lifting of a @callCC@ operation to the new monad.
+-- This version rolls back to the original state on entering the
+-- continuation.
+liftCallCC :: (Monoid w) =>
+    CallCC m (a,s,w) (b,s,w) -> CallCC (RWST r w s m) a b
+liftCallCC callCC f = RWST $ \ r s ->
+    callCC $ \ c ->
+    runRWST (f (\ a -> RWST $ \ _ _ -> c (a, s, mempty))) r s
+{-# INLINE liftCallCC #-}
+
+-- | In-situ lifting of a @callCC@ operation to the new monad.
+-- This version uses the current state on entering the continuation.
+liftCallCC' :: (Monoid w) =>
+    CallCC m (a,s,w) (b,s,w) -> CallCC (RWST r w s m) a b
+liftCallCC' callCC f = RWST $ \ r s ->
+    callCC $ \ c ->
+    runRWST (f (\ a -> RWST $ \ _ s' -> c (a, s', mempty))) r s
+{-# INLINE liftCallCC' #-}
+
+-- | Lift a @catchE@ operation to the new monad.
+liftCatch :: Catch e m (a,s,w) -> Catch e (RWST r w s m) a
+liftCatch catchE m h =
+    RWST $ \ r s -> runRWST m r s `catchE` \ e -> runRWST (h e) r s
+{-# INLINE liftCatch #-}

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 #-}

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Select.hs

@@ -0,0 +1,161 @@
+{-# 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.Select
+-- Copyright   :  (c) Ross Paterson 2017
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Selection monad transformer, modelling search algorithms.
+--
+-- * Martin Escardo and Paulo Oliva.
+--   "Selection functions, bar recursion and backward induction",
+--   /Mathematical Structures in Computer Science/ 20:2 (2010), pp. 127-168.
+--   <https://www.cs.bham.ac.uk/~mhe/papers/selection-escardo-oliva.pdf>
+--
+-- * Jules Hedges. "Monad transformers for backtracking search".
+--   In /Proceedings of MSFP 2014/. <https://arxiv.org/abs/1406.2058>
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.Select (
+    -- * The Select monad
+    Select,
+    select,
+    runSelect,
+    mapSelect,
+    -- * The SelectT monad transformer
+    SelectT(SelectT),
+    runSelectT,
+    mapSelectT,
+    -- * Monad transformation
+    selectToContT,
+    selectToCont,
+    ) where
+
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Cont
+
+import Control.Applicative
+import Control.Monad
+#if MIN_VERSION_base(4,9,0)
+import qualified Control.Monad.Fail as Fail
+#endif
+import Data.Functor.Identity
+
+-- | Selection monad.
+type Select r = SelectT r Identity
+
+-- | Constructor for computations in the selection monad.
+select :: ((a -> r) -> a) -> Select r a
+select f = SelectT $ \ k -> Identity (f (runIdentity . k))
+{-# INLINE select #-}
+
+-- | Runs a @Select@ computation with a function for evaluating answers
+-- to select a particular answer.  (The inverse of 'select'.)
+runSelect :: Select r a -> (a -> r) -> a
+runSelect m k = runIdentity (runSelectT m (Identity . k))
+{-# INLINE runSelect #-}
+
+-- | Apply a function to transform the result of a selection computation.
+--
+-- * @'runSelect' ('mapSelect' f m) = f . 'runSelect' m@
+mapSelect :: (a -> a) -> Select r a -> Select r a
+mapSelect f = mapSelectT (Identity . f . runIdentity)
+{-# INLINE mapSelect #-}
+
+-- | Selection monad transformer.
+--
+-- 'SelectT' is not a functor on the category of monads, and many operations
+-- cannot be lifted through it.
+newtype SelectT r m a = SelectT ((a -> m r) -> m a)
+
+-- | Runs a @SelectT@ computation with a function for evaluating answers
+-- to select a particular answer.  (The inverse of 'select'.)
+runSelectT :: SelectT r m a -> (a -> m r) -> m a
+runSelectT (SelectT g) = g
+{-# INLINE runSelectT #-}
+
+-- | Apply a function to transform the result of a selection computation.
+-- This has a more restricted type than the @map@ operations for other
+-- monad transformers, because 'SelectT' does not define a functor in
+-- the category of monads.
+--
+-- * @'runSelectT' ('mapSelectT' f m) = f . 'runSelectT' m@
+mapSelectT :: (m a -> m a) -> SelectT r m a -> SelectT r m a
+mapSelectT f m = SelectT $ f . runSelectT m
+{-# INLINE mapSelectT #-}
+
+instance (Functor m) => Functor (SelectT r m) where
+    fmap f (SelectT g) = SelectT (fmap f . g . (. f))
+    {-# INLINE fmap #-}
+
+instance (Functor m, Monad m) => Applicative (SelectT r m) where
+    pure = lift . return
+    {-# INLINE pure #-}
+    SelectT gf <*> SelectT gx = SelectT $ \ k -> do
+        let h f = liftM f (gx (k . f))
+        f <- gf ((>>= k) . h)
+        h f
+    {-# INLINE (<*>) #-}
+    m *> k = m >>= \_ -> k
+    {-# INLINE (*>) #-}
+
+instance (Functor m, MonadPlus m) => Alternative (SelectT r m) where
+    empty = mzero
+    {-# INLINE empty #-}
+    (<|>) = mplus
+    {-# INLINE (<|>) #-}
+
+instance (Monad m) => Monad (SelectT r m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return = lift . return
+    {-# INLINE return #-}
+#endif
+    SelectT g >>= f = SelectT $ \ k -> do
+        let h x = runSelectT (f x) k
+        y <- g ((>>= k) . h)
+        h y
+    {-# INLINE (>>=) #-}
+
+#if MIN_VERSION_base(4,9,0)
+instance (Fail.MonadFail m) => Fail.MonadFail (SelectT r m) where
+    fail msg = lift (Fail.fail msg)
+    {-# INLINE fail #-}
+#endif
+
+instance (MonadPlus m) => MonadPlus (SelectT r m) where
+    mzero = SelectT (const mzero)
+    {-# INLINE mzero #-}
+    SelectT f `mplus` SelectT g = SelectT $ \ k -> f k `mplus` g k
+    {-# INLINE mplus #-}
+
+instance MonadTrans (SelectT r) where
+    lift = SelectT . const
+    {-# INLINE lift #-}
+
+instance (MonadIO m) => MonadIO (SelectT r m) where
+    liftIO = lift . liftIO
+    {-# INLINE liftIO #-}
+
+-- | Convert a selection computation to a continuation-passing computation.
+selectToContT :: (Monad m) => SelectT r m a -> ContT r m a
+selectToContT (SelectT g) = ContT $ \ k -> g k >>= k
+{-# INLINE selectToCont #-}
+
+-- | Deprecated name for 'selectToContT'.
+{-# DEPRECATED selectToCont "Use selectToContT instead" #-}
+selectToCont :: (Monad m) => SelectT r m a -> ContT r m a
+selectToCont = selectToContT

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/State.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.State
+-- 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
+--
+-- State monads, passing an updatable state through a computation.
+--
+-- Some computations may not require the full power of state transformers:
+--
+-- * For a read-only state, see "Control.Monad.Trans.Reader".
+--
+-- * To accumulate a value without using it on the way, see
+--   "Control.Monad.Trans.Writer".
+--
+-- This version is lazy; for a strict version, see
+-- "Control.Monad.Trans.State.Strict", which has the same interface.
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.State (
+  module Control.Monad.Trans.State.Lazy
+  ) where
+
+import Control.Monad.Trans.State.Lazy

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/State/Lazy.hs

@@ -0,0 +1,428 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.State.Lazy
+-- 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
+--
+-- Lazy state monads, passing an updatable state through a computation.
+-- See below for examples.
+--
+-- Some computations may not require the full power of state transformers:
+--
+-- * For a read-only state, see "Control.Monad.Trans.Reader".
+--
+-- * To accumulate a value without using it on the way, see
+--   "Control.Monad.Trans.Writer".
+--
+-- In this version, sequencing of computations is lazy, so that for
+-- example the following produces a usable result:
+--
+-- > evalState (sequence $ repeat $ do { n <- get; put (n*2); return n }) 1
+--
+-- For a strict version with the same interface, see
+-- "Control.Monad.Trans.State.Strict".
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.State.Lazy (
+    -- * The State monad
+    State,
+    state,
+    runState,
+    evalState,
+    execState,
+    mapState,
+    withState,
+    -- * The StateT monad transformer
+    StateT(..),
+    evalStateT,
+    execStateT,
+    mapStateT,
+    withStateT,
+    -- * State operations
+    get,
+    put,
+    modify,
+    modify',
+    gets,
+    -- * Lifting other operations
+    liftCallCC,
+    liftCallCC',
+    liftCatch,
+    liftListen,
+    liftPass,
+    -- * Examples
+    -- ** State monads
+    -- $examples
+
+    -- ** Counting
+    -- $counting
+
+    -- ** Labelling trees
+    -- $labelling
+  ) 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
+
+-- ---------------------------------------------------------------------------
+-- | A state monad parameterized by the type @s@ of the state to carry.
+--
+-- The 'return' function leaves the state unchanged, while @>>=@ uses
+-- the final state of the first computation as the initial state of
+-- the second.
+type State s = StateT s Identity
+
+-- | Construct a state monad computation from a function.
+-- (The inverse of 'runState'.)
+state :: (Monad m)
+      => (s -> (a, s))  -- ^pure state transformer
+      -> StateT s m a   -- ^equivalent state-passing computation
+state f = StateT (return . f)
+{-# INLINE state #-}
+
+-- | Unwrap a state monad computation as a function.
+-- (The inverse of 'state'.)
+runState :: State s a   -- ^state-passing computation to execute
+         -> s           -- ^initial state
+         -> (a, s)      -- ^return value and final state
+runState m = runIdentity . runStateT m
+{-# INLINE runState #-}
+
+-- | Evaluate a state computation with the given initial state
+-- and return the final value, discarding the final state.
+--
+-- * @'evalState' m s = 'fst' ('runState' m s)@
+evalState :: State s a  -- ^state-passing computation to execute
+          -> s          -- ^initial value
+          -> a          -- ^return value of the state computation
+evalState m s = fst (runState m s)
+{-# INLINE evalState #-}
+
+-- | Evaluate a state computation with the given initial state
+-- and return the final state, discarding the final value.
+--
+-- * @'execState' m s = 'snd' ('runState' m s)@
+execState :: State s a  -- ^state-passing computation to execute
+          -> s          -- ^initial value
+          -> s          -- ^final state
+execState m s = snd (runState m s)
+{-# INLINE execState #-}
+
+-- | Map both the return value and final state of a computation using
+-- the given function.
+--
+-- * @'runState' ('mapState' f m) = f . 'runState' m@
+mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
+mapState f = mapStateT (Identity . f . runIdentity)
+{-# INLINE mapState #-}
+
+-- | @'withState' f m@ executes action @m@ on a state modified by
+-- applying @f@.
+--
+-- * @'withState' f m = 'modify' f >> m@
+withState :: (s -> s) -> State s a -> State s a
+withState = withStateT
+{-# INLINE withState #-}
+
+-- ---------------------------------------------------------------------------
+-- | A state transformer monad parameterized by:
+--
+--   * @s@ - The state.
+--
+--   * @m@ - The inner monad.
+--
+-- The 'return' function leaves the state unchanged, while @>>=@ uses
+-- the final state of the first computation as the initial state of
+-- the second.
+newtype StateT s m a = StateT { runStateT :: s -> m (a,s) }
+
+-- | Evaluate a state computation with the given initial state
+-- and return the final value, discarding the final state.
+--
+-- * @'evalStateT' m s = 'liftM' 'fst' ('runStateT' m s)@
+evalStateT :: (Monad m) => StateT s m a -> s -> m a
+evalStateT m s = do
+    ~(a, _) <- runStateT m s
+    return a
+{-# INLINE evalStateT #-}
+
+-- | Evaluate a state computation with the given initial state
+-- and return the final state, discarding the final value.
+--
+-- * @'execStateT' m s = 'liftM' 'snd' ('runStateT' m s)@
+execStateT :: (Monad m) => StateT s m a -> s -> m s
+execStateT m s = do
+    ~(_, s') <- runStateT m s
+    return s'
+{-# INLINE execStateT #-}
+
+-- | Map both the return value and final state of a computation using
+-- the given function.
+--
+-- * @'runStateT' ('mapStateT' f m) = f . 'runStateT' m@
+mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
+mapStateT f m = StateT $ f . runStateT m
+{-# INLINE mapStateT #-}
+
+-- | @'withStateT' f m@ executes action @m@ on a state modified by
+-- applying @f@.
+--
+-- * @'withStateT' f m = 'modify' f >> m@
+withStateT :: (s -> s) -> StateT s m a -> StateT s m a
+withStateT f m = StateT $ runStateT m . f
+{-# INLINE withStateT #-}
+
+instance (Functor m) => Functor (StateT s m) where
+    fmap f m = StateT $ \ s ->
+        fmap (\ ~(a, s') -> (f a, s')) $ runStateT m s
+    {-# INLINE fmap #-}
+
+instance (Functor m, Monad m) => Applicative (StateT s m) where
+    pure a = StateT $ \ s -> return (a, s)
+    {-# INLINE pure #-}
+    StateT mf <*> StateT mx = StateT $ \ s -> do
+        ~(f, s') <- mf s
+        ~(x, s'') <- mx s'
+        return (f x, s'')
+    {-# INLINE (<*>) #-}
+    m *> k = m >>= \_ -> k
+    {-# INLINE (*>) #-}
+
+instance (Functor m, MonadPlus m) => Alternative (StateT s m) where
+    empty = StateT $ \ _ -> mzero
+    {-# INLINE empty #-}
+    StateT m <|> StateT n = StateT $ \ s -> m s `mplus` n s
+    {-# INLINE (<|>) #-}
+
+instance (Monad m) => Monad (StateT s m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return a = StateT $ \ s -> return (a, s)
+    {-# INLINE return #-}
+#endif
+    m >>= k  = StateT $ \ s -> do
+        ~(a, s') <- runStateT m s
+        runStateT (k a) s'
+    {-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
+    fail str = StateT $ \ _ -> fail str
+    {-# INLINE fail #-}
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Fail.MonadFail m) => Fail.MonadFail (StateT s m) where
+    fail str = StateT $ \ _ -> Fail.fail str
+    {-# INLINE fail #-}
+#endif
+
+instance (MonadPlus m) => MonadPlus (StateT s m) where
+    mzero       = StateT $ \ _ -> mzero
+    {-# INLINE mzero #-}
+    StateT m `mplus` StateT n = StateT $ \ s -> m s `mplus` n s
+    {-# INLINE mplus #-}
+
+instance (MonadFix m) => MonadFix (StateT s m) where
+    mfix f = StateT $ \ s -> mfix $ \ ~(a, _) -> runStateT (f a) s
+    {-# INLINE mfix #-}
+
+instance MonadTrans (StateT s) where
+    lift m = StateT $ \ s -> do
+        a <- m
+        return (a, s)
+    {-# INLINE lift #-}
+
+instance (MonadIO m) => MonadIO (StateT s m) where
+    liftIO = lift . liftIO
+    {-# INLINE liftIO #-}
+
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (StateT s m) where
+    contramap f m = StateT $ \s ->
+      contramap (\ ~(a, s') -> (f a, s')) $ runStateT m s
+    {-# INLINE contramap #-}
+#endif
+
+-- | Fetch the current value of the state within the monad.
+get :: (Monad m) => StateT s m s
+get = state $ \ s -> (s, s)
+{-# INLINE get #-}
+
+-- | @'put' s@ sets the state within the monad to @s@.
+put :: (Monad m) => s -> StateT s m ()
+put s = state $ \ _ -> ((), s)
+{-# INLINE put #-}
+
+-- | @'modify' f@ is an action that updates the state to the result of
+-- applying @f@ to the current state.
+--
+-- * @'modify' f = 'get' >>= ('put' . f)@
+modify :: (Monad m) => (s -> s) -> StateT s m ()
+modify f = state $ \ s -> ((), f s)
+{-# INLINE modify #-}
+
+-- | A variant of 'modify' in which the computation is strict in the
+-- new state.
+--
+-- * @'modify'' f = 'get' >>= (('$!') 'put' . f)@
+modify' :: (Monad m) => (s -> s) -> StateT s m ()
+modify' f = do
+    s <- get
+    put $! f s
+{-# INLINE modify' #-}
+
+-- | Get a specific component of the state, using a projection function
+-- supplied.
+--
+-- * @'gets' f = 'liftM' f 'get'@
+gets :: (Monad m) => (s -> a) -> StateT s m a
+gets f = state $ \ s -> (f s, s)
+{-# INLINE gets #-}
+
+-- | Uniform lifting of a @callCC@ operation to the new monad.
+-- This version rolls back to the original state on entering the
+-- continuation.
+liftCallCC :: CallCC m (a,s) (b,s) -> CallCC (StateT s m) a b
+liftCallCC callCC f = StateT $ \ s ->
+    callCC $ \ c ->
+    runStateT (f (\ a -> StateT $ \ _ -> c (a, s))) s
+{-# INLINE liftCallCC #-}
+
+-- | In-situ lifting of a @callCC@ operation to the new monad.
+-- This version uses the current state on entering the continuation.
+-- It does not satisfy the uniformity property (see "Control.Monad.Signatures").
+liftCallCC' :: CallCC m (a,s) (b,s) -> CallCC (StateT s m) a b
+liftCallCC' callCC f = StateT $ \ s ->
+    callCC $ \ c ->
+    runStateT (f (\ a -> StateT $ \ s' -> c (a, s'))) s
+{-# INLINE liftCallCC' #-}
+
+-- | Lift a @catchE@ operation to the new monad.
+liftCatch :: Catch e m (a,s) -> Catch e (StateT s m) a
+liftCatch catchE m h =
+    StateT $ \ s -> runStateT m s `catchE` \ e -> runStateT (h e) s
+{-# INLINE liftCatch #-}
+
+-- | Lift a @listen@ operation to the new monad.
+liftListen :: (Monad m) => Listen w m (a,s) -> Listen w (StateT s m) a
+liftListen listen m = StateT $ \ s -> do
+    ~((a, s'), w) <- listen (runStateT m s)
+    return ((a, w), s')
+{-# INLINE liftListen #-}
+
+-- | Lift a @pass@ operation to the new monad.
+liftPass :: (Monad m) => Pass w m (a,s) -> Pass w (StateT s m) a
+liftPass pass m = StateT $ \ s -> pass $ do
+    ~((a, f), s') <- runStateT m s
+    return ((a, s'), f)
+{-# INLINE liftPass #-}
+
+{- $examples
+
+Parser from ParseLib with Hugs:
+
+> type Parser a = StateT String [] a
+>    ==> StateT (String -> [(a,String)])
+
+For example, item can be written as:
+
+> item = do (x:xs) <- get
+>        put xs
+>        return x
+>
+> type BoringState s a = StateT s Identity a
+>      ==> StateT (s -> Identity (a,s))
+>
+> type StateWithIO s a = StateT s IO a
+>      ==> StateT (s -> IO (a,s))
+>
+> type StateWithErr s a = StateT s Maybe a
+>      ==> StateT (s -> Maybe (a,s))
+
+-}
+
+{- $counting
+
+A function to increment a counter.
+Taken from the paper \"Generalising Monads to Arrows\",
+John Hughes (<http://www.cse.chalmers.se/~rjmh/>), November 1998:
+
+> tick :: State Int Int
+> tick = do n <- get
+>           put (n+1)
+>           return n
+
+Add one to the given number using the state monad:
+
+> plusOne :: Int -> Int
+> plusOne n = execState tick n
+
+A contrived addition example. Works only with positive numbers:
+
+> plus :: Int -> Int -> Int
+> plus n x = execState (sequence $ replicate n tick) x
+
+-}
+
+{- $labelling
+
+An example from /The Craft of Functional Programming/, Simon
+Thompson (<http://www.cs.kent.ac.uk/people/staff/sjt/>),
+Addison-Wesley 1999: \"Given an arbitrary tree, transform it to a
+tree of integers in which the original elements are replaced by
+natural numbers, starting from 0.  The same element has to be
+replaced by the same number at every occurrence, and when we meet
+an as-yet-unvisited element we have to find a \'new\' number to match
+it with:\"
+
+> data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show, Eq)
+> type Table a = [a]
+
+> numberTree :: Eq a => Tree a -> State (Table a) (Tree Int)
+> numberTree Nil = return Nil
+> numberTree (Node x t1 t2) = do
+>     num <- numberNode x
+>     nt1 <- numberTree t1
+>     nt2 <- numberTree t2
+>     return (Node num nt1 nt2)
+>   where
+>     numberNode :: Eq a => a -> State (Table a) Int
+>     numberNode x = do
+>         table <- get
+>         case elemIndex x table of
+>             Nothing -> do
+>                 put (table ++ [x])
+>                 return (length table)
+>             Just i -> return i
+
+numTree applies numberTree with an initial state:
+
+> numTree :: (Eq a) => Tree a -> Tree Int
+> numTree t = evalState (numberTree t) []
+
+> testTree = Node "Zero" (Node "One" (Node "Two" Nil Nil) (Node "One" (Node "Zero" Nil Nil) Nil)) Nil
+> numTree testTree => Node 0 (Node 1 (Node 2 Nil Nil) (Node 1 (Node 0 Nil Nil) Nil)) Nil
+
+-}

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/State/Strict.hs

@@ -0,0 +1,425 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.State.Strict
+-- 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
+--
+-- Strict state monads, passing an updatable state through a computation.
+-- See below for examples.
+--
+-- Some computations may not require the full power of state transformers:
+--
+-- * For a read-only state, see "Control.Monad.Trans.Reader".
+--
+-- * To accumulate a value without using it on the way, see
+--   "Control.Monad.Trans.Writer".
+--
+-- In this version, sequencing of computations is strict (but computations
+-- are not strict in the state unless you force it with 'seq' or the like).
+-- For a lazy version with the same interface, see
+-- "Control.Monad.Trans.State.Lazy".
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.State.Strict (
+    -- * The State monad
+    State,
+    state,
+    runState,
+    evalState,
+    execState,
+    mapState,
+    withState,
+    -- * The StateT monad transformer
+    StateT(..),
+    evalStateT,
+    execStateT,
+    mapStateT,
+    withStateT,
+    -- * State operations
+    get,
+    put,
+    modify,
+    modify',
+    gets,
+    -- * Lifting other operations
+    liftCallCC,
+    liftCallCC',
+    liftCatch,
+    liftListen,
+    liftPass,
+    -- * Examples
+    -- ** State monads
+    -- $examples
+
+    -- ** Counting
+    -- $counting
+
+    -- ** Labelling trees
+    -- $labelling
+  ) 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
+
+-- ---------------------------------------------------------------------------
+-- | A state monad parameterized by the type @s@ of the state to carry.
+--
+-- The 'return' function leaves the state unchanged, while @>>=@ uses
+-- the final state of the first computation as the initial state of
+-- the second.
+type State s = StateT s Identity
+
+-- | Construct a state monad computation from a function.
+-- (The inverse of 'runState'.)
+state :: (Monad m)
+      => (s -> (a, s))  -- ^pure state transformer
+      -> StateT s m a   -- ^equivalent state-passing computation
+state f = StateT (return . f)
+{-# INLINE state #-}
+
+-- | Unwrap a state monad computation as a function.
+-- (The inverse of 'state'.)
+runState :: State s a   -- ^state-passing computation to execute
+         -> s           -- ^initial state
+         -> (a, s)      -- ^return value and final state
+runState m = runIdentity . runStateT m
+{-# INLINE runState #-}
+
+-- | Evaluate a state computation with the given initial state
+-- and return the final value, discarding the final state.
+--
+-- * @'evalState' m s = 'fst' ('runState' m s)@
+evalState :: State s a  -- ^state-passing computation to execute
+          -> s          -- ^initial value
+          -> a          -- ^return value of the state computation
+evalState m s = fst (runState m s)
+{-# INLINE evalState #-}
+
+-- | Evaluate a state computation with the given initial state
+-- and return the final state, discarding the final value.
+--
+-- * @'execState' m s = 'snd' ('runState' m s)@
+execState :: State s a  -- ^state-passing computation to execute
+          -> s          -- ^initial value
+          -> s          -- ^final state
+execState m s = snd (runState m s)
+{-# INLINE execState #-}
+
+-- | Map both the return value and final state of a computation using
+-- the given function.
+--
+-- * @'runState' ('mapState' f m) = f . 'runState' m@
+mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
+mapState f = mapStateT (Identity . f . runIdentity)
+{-# INLINE mapState #-}
+
+-- | @'withState' f m@ executes action @m@ on a state modified by
+-- applying @f@.
+--
+-- * @'withState' f m = 'modify' f >> m@
+withState :: (s -> s) -> State s a -> State s a
+withState = withStateT
+{-# INLINE withState #-}
+
+-- ---------------------------------------------------------------------------
+-- | A state transformer monad parameterized by:
+--
+--   * @s@ - The state.
+--
+--   * @m@ - The inner monad.
+--
+-- The 'return' function leaves the state unchanged, while @>>=@ uses
+-- the final state of the first computation as the initial state of
+-- the second.
+newtype StateT s m a = StateT { runStateT :: s -> m (a,s) }
+
+-- | Evaluate a state computation with the given initial state
+-- and return the final value, discarding the final state.
+--
+-- * @'evalStateT' m s = 'liftM' 'fst' ('runStateT' m s)@
+evalStateT :: (Monad m) => StateT s m a -> s -> m a
+evalStateT m s = do
+    (a, _) <- runStateT m s
+    return a
+{-# INLINE evalStateT #-}
+
+-- | Evaluate a state computation with the given initial state
+-- and return the final state, discarding the final value.
+--
+-- * @'execStateT' m s = 'liftM' 'snd' ('runStateT' m s)@
+execStateT :: (Monad m) => StateT s m a -> s -> m s
+execStateT m s = do
+    (_, s') <- runStateT m s
+    return s'
+{-# INLINE execStateT #-}
+
+-- | Map both the return value and final state of a computation using
+-- the given function.
+--
+-- * @'runStateT' ('mapStateT' f m) = f . 'runStateT' m@
+mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
+mapStateT f m = StateT $ f . runStateT m
+{-# INLINE mapStateT #-}
+
+-- | @'withStateT' f m@ executes action @m@ on a state modified by
+-- applying @f@.
+--
+-- * @'withStateT' f m = 'modify' f >> m@
+withStateT :: (s -> s) -> StateT s m a -> StateT s m a
+withStateT f m = StateT $ runStateT m . f
+{-# INLINE withStateT #-}
+
+instance (Functor m) => Functor (StateT s m) where
+    fmap f m = StateT $ \ s ->
+        fmap (\ (a, s') -> (f a, s')) $ runStateT m s
+    {-# INLINE fmap #-}
+
+instance (Functor m, Monad m) => Applicative (StateT s m) where
+    pure a = StateT $ \ s -> return (a, s)
+    {-# INLINE pure #-}
+    StateT mf <*> StateT mx = StateT $ \ s -> do
+        (f, s') <- mf s
+        (x, s'') <- mx s'
+        return (f x, s'')
+    {-# INLINE (<*>) #-}
+    m *> k = m >>= \_ -> k
+    {-# INLINE (*>) #-}
+
+instance (Functor m, MonadPlus m) => Alternative (StateT s m) where
+    empty = StateT $ \ _ -> mzero
+    {-# INLINE empty #-}
+    StateT m <|> StateT n = StateT $ \ s -> m s `mplus` n s
+    {-# INLINE (<|>) #-}
+
+instance (Monad m) => Monad (StateT s m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return a = StateT $ \ s -> return (a, s)
+    {-# INLINE return #-}
+#endif
+    m >>= k  = StateT $ \ s -> do
+        (a, s') <- runStateT m s
+        runStateT (k a) s'
+    {-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
+    fail str = StateT $ \ _ -> fail str
+    {-# INLINE fail #-}
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Fail.MonadFail m) => Fail.MonadFail (StateT s m) where
+    fail str = StateT $ \ _ -> Fail.fail str
+    {-# INLINE fail #-}
+#endif
+
+instance (MonadPlus m) => MonadPlus (StateT s m) where
+    mzero       = StateT $ \ _ -> mzero
+    {-# INLINE mzero #-}
+    StateT m `mplus` StateT n = StateT $ \ s -> m s `mplus` n s
+    {-# INLINE mplus #-}
+
+instance (MonadFix m) => MonadFix (StateT s m) where
+    mfix f = StateT $ \ s -> mfix $ \ ~(a, _) -> runStateT (f a) s
+    {-# INLINE mfix #-}
+
+instance MonadTrans (StateT s) where
+    lift m = StateT $ \ s -> do
+        a <- m
+        return (a, s)
+    {-# INLINE lift #-}
+
+instance (MonadIO m) => MonadIO (StateT s m) where
+    liftIO = lift . liftIO
+    {-# INLINE liftIO #-}
+
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (StateT s m) where
+    contramap f m = StateT $ \s ->
+      contramap (\ (a, s') -> (f a, s')) $ runStateT m s
+    {-# INLINE contramap #-}
+#endif
+
+-- | Fetch the current value of the state within the monad.
+get :: (Monad m) => StateT s m s
+get = state $ \ s -> (s, s)
+{-# INLINE get #-}
+
+-- | @'put' s@ sets the state within the monad to @s@.
+put :: (Monad m) => s -> StateT s m ()
+put s = state $ \ _ -> ((), s)
+{-# INLINE put #-}
+
+-- | @'modify' f@ is an action that updates the state to the result of
+-- applying @f@ to the current state.
+--
+-- * @'modify' f = 'get' >>= ('put' . f)@
+modify :: (Monad m) => (s -> s) -> StateT s m ()
+modify f = state $ \ s -> ((), f s)
+{-# INLINE modify #-}
+
+-- | A variant of 'modify' in which the computation is strict in the
+-- new state.
+--
+-- * @'modify'' f = 'get' >>= (('$!') 'put' . f)@
+modify' :: (Monad m) => (s -> s) -> StateT s m ()
+modify' f = do
+    s <- get
+    put $! f s
+{-# INLINE modify' #-}
+
+-- | Get a specific component of the state, using a projection function
+-- supplied.
+--
+-- * @'gets' f = 'liftM' f 'get'@
+gets :: (Monad m) => (s -> a) -> StateT s m a
+gets f = state $ \ s -> (f s, s)
+{-# INLINE gets #-}
+
+-- | Uniform lifting of a @callCC@ operation to the new monad.
+-- This version rolls back to the original state on entering the
+-- continuation.
+liftCallCC :: CallCC m (a,s) (b,s) -> CallCC (StateT s m) a b
+liftCallCC callCC f = StateT $ \ s ->
+    callCC $ \ c ->
+    runStateT (f (\ a -> StateT $ \ _ -> c (a, s))) s
+{-# INLINE liftCallCC #-}
+
+-- | In-situ lifting of a @callCC@ operation to the new monad.
+-- This version uses the current state on entering the continuation.
+-- It does not satisfy the uniformity property (see "Control.Monad.Signatures").
+liftCallCC' :: CallCC m (a,s) (b,s) -> CallCC (StateT s m) a b
+liftCallCC' callCC f = StateT $ \ s ->
+    callCC $ \ c ->
+    runStateT (f (\ a -> StateT $ \ s' -> c (a, s'))) s
+{-# INLINE liftCallCC' #-}
+
+-- | Lift a @catchE@ operation to the new monad.
+liftCatch :: Catch e m (a,s) -> Catch e (StateT s m) a
+liftCatch catchE m h =
+    StateT $ \ s -> runStateT m s `catchE` \ e -> runStateT (h e) s
+{-# INLINE liftCatch #-}
+
+-- | Lift a @listen@ operation to the new monad.
+liftListen :: (Monad m) => Listen w m (a,s) -> Listen w (StateT s m) a
+liftListen listen m = StateT $ \ s -> do
+    ((a, s'), w) <- listen (runStateT m s)
+    return ((a, w), s')
+{-# INLINE liftListen #-}
+
+-- | Lift a @pass@ operation to the new monad.
+liftPass :: (Monad m) => Pass w m (a,s) -> Pass w (StateT s m) a
+liftPass pass m = StateT $ \ s -> pass $ do
+    ((a, f), s') <- runStateT m s
+    return ((a, s'), f)
+{-# INLINE liftPass #-}
+
+{- $examples
+
+Parser from ParseLib with Hugs:
+
+> type Parser a = StateT String [] a
+>    ==> StateT (String -> [(a,String)])
+
+For example, item can be written as:
+
+> item = do (x:xs) <- get
+>        put xs
+>        return x
+>
+> type BoringState s a = StateT s Identity a
+>      ==> StateT (s -> Identity (a,s))
+>
+> type StateWithIO s a = StateT s IO a
+>      ==> StateT (s -> IO (a,s))
+>
+> type StateWithErr s a = StateT s Maybe a
+>      ==> StateT (s -> Maybe (a,s))
+
+-}
+
+{- $counting
+
+A function to increment a counter.
+Taken from the paper \"Generalising Monads to Arrows\",
+John Hughes (<http://www.cse.chalmers.se/~rjmh/>), November 1998:
+
+> tick :: State Int Int
+> tick = do n <- get
+>           put (n+1)
+>           return n
+
+Add one to the given number using the state monad:
+
+> plusOne :: Int -> Int
+> plusOne n = execState tick n
+
+A contrived addition example. Works only with positive numbers:
+
+> plus :: Int -> Int -> Int
+> plus n x = execState (sequence $ replicate n tick) x
+
+-}
+
+{- $labelling
+
+An example from /The Craft of Functional Programming/, Simon
+Thompson (<http://www.cs.kent.ac.uk/people/staff/sjt/>),
+Addison-Wesley 1999: \"Given an arbitrary tree, transform it to a
+tree of integers in which the original elements are replaced by
+natural numbers, starting from 0.  The same element has to be
+replaced by the same number at every occurrence, and when we meet
+an as-yet-unvisited element we have to find a \'new\' number to match
+it with:\"
+
+> data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show, Eq)
+> type Table a = [a]
+
+> numberTree :: Eq a => Tree a -> State (Table a) (Tree Int)
+> numberTree Nil = return Nil
+> numberTree (Node x t1 t2) = do
+>     num <- numberNode x
+>     nt1 <- numberTree t1
+>     nt2 <- numberTree t2
+>     return (Node num nt1 nt2)
+>   where
+>     numberNode :: Eq a => a -> State (Table a) Int
+>     numberNode x = do
+>         table <- get
+>         case elemIndex x table of
+>             Nothing -> do
+>                 put (table ++ [x])
+>                 return (length table)
+>             Just i -> return i
+
+numTree applies numberTree with an initial state:
+
+> numTree :: (Eq a) => Tree a -> Tree Int
+> numTree t = evalState (numberTree t) []
+
+> testTree = Node "Zero" (Node "One" (Node "Two" Nil Nil) (Node "One" (Node "Zero" Nil Nil) Nil)) Nil
+> numTree testTree => Node 0 (Node 1 (Node 2 Nil Nil) (Node 1 (Node 0 Nil Nil) Nil)) Nil
+
+-}

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.Writer
+-- 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
+--
+-- The WriterT monad transformer.
+-- This version builds its output lazily; for a constant-space version
+-- with almost the same interface, see "Control.Monad.Trans.Writer.CPS".
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.Writer (
+    module Control.Monad.Trans.Writer.Lazy
+  ) where
+
+import Control.Monad.Trans.Writer.Lazy

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer/CPS.hs

@@ -0,0 +1,283 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.Writer.CPS
+-- Copyright   :  (c) Daniel Mendler 2016,
+--                (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
+--
+-- The strict 'WriterT' monad transformer, which adds collection of
+-- outputs (such as a count or string output) to a given monad.
+--
+-- This monad transformer provides only limited access to the output
+-- during the computation. For more general access, use
+-- "Control.Monad.Trans.State" instead.
+--
+-- This version builds its output strictly and uses continuation-passing-style
+-- to achieve constant space usage. This transformer can be used as a
+-- drop-in replacement for "Control.Monad.Trans.Writer.Strict".
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.Writer.CPS (
+    -- * The Writer monad
+    Writer,
+    writer,
+    runWriter,
+    execWriter,
+    mapWriter,
+    -- * The WriterT monad transformer
+    WriterT,
+    writerT,
+    runWriterT,
+    execWriterT,
+    mapWriterT,
+    -- * Writer operations
+    tell,
+    listen,
+    listens,
+    pass,
+    censor,
+    -- * Lifting other operations
+    liftCallCC,
+    liftCatch,
+  ) where
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Fix
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+import Control.Monad.Signatures
+import Data.Functor.Identity
+
+#if !(MIN_VERSION_base(4,8,0))
+import Data.Monoid
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+import qualified Control.Monad.Fail as Fail
+#endif
+
+-- ---------------------------------------------------------------------------
+-- | A writer monad parameterized by the type @w@ of output to accumulate.
+--
+-- The 'return' function produces the output 'mempty', while '>>='
+-- combines the outputs of the subcomputations using 'mappend'.
+type Writer w = WriterT w Identity
+
+-- | Construct a writer computation from a (result, output) pair.
+-- (The inverse of 'runWriter'.)
+writer :: (Monoid w, Monad m) => (a, w) -> WriterT w m a
+writer (a, w') = WriterT $ \ w ->
+    let wt = w `mappend` w' in wt `seq` return (a, wt)
+{-# INLINE writer #-}
+
+-- | Unwrap a writer computation as a (result, output) pair.
+-- (The inverse of 'writer'.)
+runWriter :: (Monoid w) => Writer w a -> (a, w)
+runWriter = runIdentity . runWriterT
+{-# INLINE runWriter #-}
+
+-- | Extract the output from a writer computation.
+--
+-- * @'execWriter' m = 'snd' ('runWriter' m)@
+execWriter :: (Monoid w) => Writer w a -> w
+execWriter = runIdentity . execWriterT
+{-# INLINE execWriter #-}
+
+-- | Map both the return value and output of a computation using
+-- the given function.
+--
+-- * @'runWriter' ('mapWriter' f m) = f ('runWriter' m)@
+mapWriter :: (Monoid w, Monoid w') =>
+    ((a, w) -> (b, w')) -> Writer w a -> Writer w' b
+mapWriter f = mapWriterT (Identity . f . runIdentity)
+{-# INLINE mapWriter #-}
+
+-- ---------------------------------------------------------------------------
+-- | A writer monad parameterized by:
+--
+--   * @w@ - the output to accumulate.
+--
+--   * @m@ - The inner monad.
+--
+-- The 'return' function produces the output 'mempty', while '>>='
+-- combines the outputs of the subcomputations using 'mappend'.
+
+newtype WriterT w m a = WriterT { unWriterT :: w -> m (a, w) }
+
+-- | Construct a writer computation from a (result, output) computation.
+-- (The inverse of 'runWriterT'.)
+writerT :: (Functor m, Monoid w) => m (a, w) -> WriterT w m a
+writerT f = WriterT $ \ w ->
+    (\ (a, w') -> let wt = w `mappend` w' in wt `seq` (a, wt)) <$> f
+{-# INLINE writerT #-}
+
+-- | Unwrap a writer computation.
+-- (The inverse of 'writerT'.)
+runWriterT :: (Monoid w) => WriterT w m a -> m (a, w)
+runWriterT m = unWriterT m mempty
+{-# INLINE runWriterT #-}
+
+-- | Extract the output from a writer computation.
+--
+-- * @'execWriterT' m = 'liftM' 'snd' ('runWriterT' m)@
+execWriterT :: (Monad m, Monoid w) => WriterT w m a -> m w
+execWriterT m = do
+    (_, w) <- runWriterT m
+    return w
+{-# INLINE execWriterT #-}
+
+-- | Map both the return value and output of a computation using
+-- the given function.
+--
+-- * @'runWriterT' ('mapWriterT' f m) = f ('runWriterT' m)@
+mapWriterT :: (Monad n, Monoid w, Monoid w') =>
+    (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
+mapWriterT f m = WriterT $ \ w -> do
+    (a, w') <- f (runWriterT m)
+    let wt = w `mappend` w'
+    wt `seq` return (a, wt)
+{-# INLINE mapWriterT #-}
+
+instance (Functor m) => Functor (WriterT w m) where
+    fmap f m = WriterT $ \ w -> (\ (a, w') -> (f a, w')) <$> unWriterT m w
+    {-# INLINE fmap #-}
+
+instance (Functor m, Monad m) => Applicative (WriterT w m) where
+    pure a = WriterT $ \ w -> return (a, w)
+    {-# INLINE pure #-}
+
+    WriterT mf <*> WriterT mx = WriterT $ \ w -> do
+        (f, w') <- mf w
+        (x, w'') <- mx w'
+        return (f x, w'')
+    {-# INLINE (<*>) #-}
+
+instance (Functor m, MonadPlus m) => Alternative (WriterT w m) where
+    empty = WriterT $ const mzero
+    {-# INLINE empty #-}
+
+    WriterT m <|> WriterT n = WriterT $ \ w -> m w `mplus` n w
+    {-# INLINE (<|>) #-}
+
+instance (Monad m) => Monad (WriterT w m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return a = WriterT $ \ w -> return (a, w)
+    {-# INLINE return #-}
+#endif
+
+    m >>= k = WriterT $ \ w -> do
+        (a, w') <- unWriterT m w
+        unWriterT (k a) w'
+    {-# INLINE (>>=) #-}
+
+#if !(MIN_VERSION_base(4,13,0))
+    fail msg = WriterT $ \ _ -> fail msg
+    {-# INLINE fail #-}
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Fail.MonadFail m) => Fail.MonadFail (WriterT w m) where
+    fail msg = WriterT $ \ _ -> Fail.fail msg
+    {-# INLINE fail #-}
+#endif
+
+instance (Functor m, MonadPlus m) => MonadPlus (WriterT w m) where
+    mzero = empty
+    {-# INLINE mzero #-}
+    mplus = (<|>)
+    {-# INLINE mplus #-}
+
+instance (MonadFix m) => MonadFix (WriterT w m) where
+    mfix f = WriterT $ \ w -> mfix $ \ ~(a, _) -> unWriterT (f a) w
+    {-# INLINE mfix #-}
+
+instance MonadTrans (WriterT w) where
+    lift m = WriterT $ \ w -> do
+        a <- m
+        return (a, w)
+    {-# INLINE lift #-}
+
+instance (MonadIO m) => MonadIO (WriterT w m) where
+    liftIO = lift . liftIO
+    {-# INLINE liftIO #-}
+
+-- | @'tell' w@ is an action that produces the output @w@.
+tell :: (Monoid w, Monad m) => w -> WriterT w m ()
+tell w = writer ((), w)
+{-# INLINE tell #-}
+
+-- | @'listen' m@ is an action that executes the action @m@ and adds its
+-- output to the value of the computation.
+--
+-- * @'runWriterT' ('listen' m) = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runWriterT' m)@
+listen :: (Monoid w, Monad m) => WriterT w m a -> WriterT w m (a, w)
+listen = listens id
+{-# INLINE listen #-}
+
+-- | @'listens' f m@ is an action that executes the action @m@ and adds
+-- the result of applying @f@ to the output to the value of the computation.
+--
+-- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@
+--
+-- * @'runWriterT' ('listens' f m) = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runWriterT' m)@
+listens :: (Monoid w, Monad m) =>
+    (w -> b) -> WriterT w m a -> WriterT w m (a, b)
+listens f m = WriterT $ \ w -> do
+    (a, w') <- runWriterT m
+    let wt = w `mappend` w'
+    wt `seq` return ((a, f w'), wt)
+{-# INLINE listens #-}
+
+-- | @'pass' m@ is an action that executes the action @m@, which returns
+-- a value and a function, and returns the value, applying the function
+-- to the output.
+--
+-- * @'runWriterT' ('pass' m) = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runWriterT' m)@
+pass :: (Monoid w, Monoid w', Monad m) =>
+    WriterT w m (a, w -> w') -> WriterT w' m a
+pass m = WriterT $ \ w -> do
+    ((a, f), w') <- runWriterT m
+    let wt = w `mappend` f w'
+    wt `seq` return (a, wt)
+{-# INLINE pass #-}
+
+-- | @'censor' f m@ is an action that executes the action @m@ and
+-- applies the function @f@ to its output, leaving the return value
+-- unchanged.
+--
+-- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@
+--
+-- * @'runWriterT' ('censor' f m) = 'liftM' (\\ (a, w) -> (a, f w)) ('runWriterT' m)@
+censor :: (Monoid w, Monad m) => (w -> w) -> WriterT w m a -> WriterT w m a
+censor f m = WriterT $ \ w -> do
+    (a, w') <- runWriterT m
+    let wt = w `mappend` f w'
+    wt `seq` return (a, wt)
+{-# INLINE censor #-}
+
+-- | Uniform lifting of a @callCC@ operation to the new monad.
+-- This version rolls back to the original state on entering the
+-- continuation.
+liftCallCC :: CallCC m (a, w) (b, w) -> CallCC (WriterT w m) a b
+liftCallCC callCC f = WriterT $ \ w ->
+    callCC $ \ c -> unWriterT (f (\ a -> WriterT $ \ _ -> c (a, w))) w
+{-# INLINE liftCallCC #-}
+
+-- | Lift a @catchE@ operation to the new monad.
+liftCatch :: Catch e m (a, w) -> Catch e (WriterT w m) a
+liftCatch catchE m h = WriterT $ \ w ->
+    unWriterT m w `catchE` \ e -> unWriterT (h e) w
+{-# INLINE liftCatch #-}

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer/Lazy.hs

@@ -0,0 +1,313 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.Writer.Lazy
+-- 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
+--
+-- The lazy 'WriterT' monad transformer, which adds collection of
+-- outputs (such as a count or string output) to a given monad.
+--
+-- This monad transformer provides only limited access to the output
+-- during the computation.  For more general access, use
+-- "Control.Monad.Trans.State" instead.
+--
+-- This version builds its output lazily; for a constant-space version
+-- with almost the same interface, see "Control.Monad.Trans.Writer.CPS".
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.Writer.Lazy (
+    -- * The Writer monad
+    Writer,
+    writer,
+    runWriter,
+    execWriter,
+    mapWriter,
+    -- * The WriterT monad transformer
+    WriterT(..),
+    execWriterT,
+    mapWriterT,
+    -- * Writer operations
+    tell,
+    listen,
+    listens,
+    pass,
+    censor,
+    -- * Lifting other operations
+    liftCallCC,
+    liftCatch,
+  ) where
+
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+import Data.Functor.Classes
+#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
+import Control.Monad.Signatures
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
+import Data.Foldable
+import Data.Monoid
+import Data.Traversable (Traversable(traverse))
+import Prelude hiding (null, length)
+
+-- ---------------------------------------------------------------------------
+-- | A writer monad parameterized by the type @w@ of output to accumulate.
+--
+-- The 'return' function produces the output 'mempty', while @>>=@
+-- combines the outputs of the subcomputations using 'mappend'.
+type Writer w = WriterT w Identity
+
+-- | Construct a writer computation from a (result, output) pair.
+-- (The inverse of 'runWriter'.)
+writer :: (Monad m) => (a, w) -> WriterT w m a
+writer = WriterT . return
+{-# INLINE writer #-}
+
+-- | Unwrap a writer computation as a (result, output) pair.
+-- (The inverse of 'writer'.)
+runWriter :: Writer w a -> (a, w)
+runWriter = runIdentity . runWriterT
+{-# INLINE runWriter #-}
+
+-- | Extract the output from a writer computation.
+--
+-- * @'execWriter' m = 'snd' ('runWriter' m)@
+execWriter :: Writer w a -> w
+execWriter m = snd (runWriter m)
+{-# INLINE execWriter #-}
+
+-- | Map both the return value and output of a computation using
+-- the given function.
+--
+-- * @'runWriter' ('mapWriter' f m) = f ('runWriter' m)@
+mapWriter :: ((a, w) -> (b, w')) -> Writer w a -> Writer w' b
+mapWriter f = mapWriterT (Identity . f . runIdentity)
+{-# INLINE mapWriter #-}
+
+-- ---------------------------------------------------------------------------
+-- | A writer monad parameterized by:
+--
+--   * @w@ - the output to accumulate.
+--
+--   * @m@ - The inner monad.
+--
+-- The 'return' function produces the output 'mempty', while @>>=@
+-- combines the outputs of the subcomputations using 'mappend'.
+newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }
+
+instance (Eq w, Eq1 m) => Eq1 (WriterT w m) where
+    liftEq eq (WriterT m1) (WriterT m2) = liftEq (liftEq2 eq (==)) m1 m2
+    {-# INLINE liftEq #-}
+
+instance (Ord w, Ord1 m) => Ord1 (WriterT w m) where
+    liftCompare comp (WriterT m1) (WriterT m2) =
+        liftCompare (liftCompare2 comp compare) m1 m2
+    {-# INLINE liftCompare #-}
+
+instance (Read w, Read1 m) => Read1 (WriterT w m) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "WriterT" WriterT
+      where
+        rp' = liftReadsPrec2 rp rl readsPrec readList
+        rl' = liftReadList2 rp rl readsPrec readList
+
+instance (Show w, Show1 m) => Show1 (WriterT w m) where
+    liftShowsPrec sp sl d (WriterT m) =
+        showsUnaryWith (liftShowsPrec sp' sl') "WriterT" d m
+      where
+        sp' = liftShowsPrec2 sp sl showsPrec showList
+        sl' = liftShowList2 sp sl showsPrec showList
+
+instance (Eq w, Eq1 m, Eq a) => Eq (WriterT w m a) where (==) = eq1
+instance (Ord w, Ord1 m, Ord a) => Ord (WriterT w m a) where compare = compare1
+instance (Read w, Read1 m, Read a) => Read (WriterT w m a) where
+    readsPrec = readsPrec1
+instance (Show w, Show1 m, Show a) => Show (WriterT w m a) where
+    showsPrec = showsPrec1
+
+-- | Extract the output from a writer computation.
+--
+-- * @'execWriterT' m = 'liftM' 'snd' ('runWriterT' m)@
+execWriterT :: (Monad m) => WriterT w m a -> m w
+execWriterT m = do
+    ~(_, w) <- runWriterT m
+    return w
+{-# INLINE execWriterT #-}
+
+-- | Map both the return value and output of a computation using
+-- the given function.
+--
+-- * @'runWriterT' ('mapWriterT' f m) = f ('runWriterT' m)@
+mapWriterT :: (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
+mapWriterT f m = WriterT $ f (runWriterT m)
+{-# INLINE mapWriterT #-}
+
+instance (Functor m) => Functor (WriterT w m) where
+    fmap f = mapWriterT $ fmap $ \ ~(a, w) -> (f a, w)
+    {-# INLINE fmap #-}
+
+instance (Foldable f) => Foldable (WriterT w f) where
+    foldMap f = foldMap (f . fst) . runWriterT
+    {-# INLINE foldMap #-}
+#if MIN_VERSION_base(4,8,0)
+    null (WriterT t) = null t
+    length (WriterT t) = length t
+#endif
+
+instance (Traversable f) => Traversable (WriterT w f) where
+    traverse f = fmap WriterT . traverse f' . runWriterT where
+       f' (a, b) = fmap (\ c -> (c, b)) (f a)
+    {-# INLINE traverse #-}
+
+instance (Monoid w, Applicative m) => Applicative (WriterT w m) where
+    pure a  = WriterT $ pure (a, mempty)
+    {-# INLINE pure #-}
+    f <*> v = WriterT $ liftA2 k (runWriterT f) (runWriterT v)
+      where k ~(a, w) ~(b, w') = (a b, w `mappend` w')
+    {-# INLINE (<*>) #-}
+
+instance (Monoid w, Alternative m) => Alternative (WriterT w m) where
+    empty   = WriterT empty
+    {-# INLINE empty #-}
+    m <|> n = WriterT $ runWriterT m <|> runWriterT n
+    {-# INLINE (<|>) #-}
+
+instance (Monoid w, Monad m) => Monad (WriterT w m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return a = writer (a, mempty)
+    {-# INLINE return #-}
+#endif
+    m >>= k  = WriterT $ do
+        ~(a, w)  <- runWriterT m
+        ~(b, w') <- runWriterT (k a)
+        return (b, w `mappend` w')
+    {-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
+    fail msg = WriterT $ fail msg
+    {-# INLINE fail #-}
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (WriterT w m) where
+    fail msg = WriterT $ Fail.fail msg
+    {-# INLINE fail #-}
+#endif
+
+instance (Monoid w, MonadPlus m) => MonadPlus (WriterT w m) where
+    mzero       = WriterT mzero
+    {-# INLINE mzero #-}
+    m `mplus` n = WriterT $ runWriterT m `mplus` runWriterT n
+    {-# INLINE mplus #-}
+
+instance (Monoid w, MonadFix m) => MonadFix (WriterT w m) where
+    mfix m = WriterT $ mfix $ \ ~(a, _) -> runWriterT (m a)
+    {-# INLINE mfix #-}
+
+instance (Monoid w) => MonadTrans (WriterT w) where
+    lift m = WriterT $ do
+        a <- m
+        return (a, mempty)
+    {-# INLINE lift #-}
+
+instance (Monoid w, MonadIO m) => MonadIO (WriterT w m) where
+    liftIO = lift . liftIO
+    {-# INLINE liftIO #-}
+
+#if MIN_VERSION_base(4,4,0)
+instance (Monoid w, MonadZip m) => MonadZip (WriterT w m) where
+    mzipWith f (WriterT x) (WriterT y) = WriterT $
+        mzipWith (\ ~(a, w) ~(b, w') -> (f a b, w `mappend` w')) x y
+    {-# INLINE mzipWith #-}
+#endif
+
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (WriterT w m) where
+    contramap f = mapWriterT $ contramap $ \ ~(a, w) -> (f a, w)
+    {-# INLINE contramap #-}
+#endif
+
+-- | @'tell' w@ is an action that produces the output @w@.
+tell :: (Monad m) => w -> WriterT w m ()
+tell w = writer ((), w)
+{-# INLINE tell #-}
+
+-- | @'listen' m@ is an action that executes the action @m@ and adds its
+-- output to the value of the computation.
+--
+-- * @'runWriterT' ('listen' m) = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runWriterT' m)@
+listen :: (Monad m) => WriterT w m a -> WriterT w m (a, w)
+listen m = WriterT $ do
+    ~(a, w) <- runWriterT m
+    return ((a, w), w)
+{-# INLINE listen #-}
+
+-- | @'listens' f m@ is an action that executes the action @m@ and adds
+-- the result of applying @f@ to the output to the value of the computation.
+--
+-- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@
+--
+-- * @'runWriterT' ('listens' f m) = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runWriterT' m)@
+listens :: (Monad m) => (w -> b) -> WriterT w m a -> WriterT w m (a, b)
+listens f m = WriterT $ do
+    ~(a, w) <- runWriterT m
+    return ((a, f w), w)
+{-# INLINE listens #-}
+
+-- | @'pass' m@ is an action that executes the action @m@, which returns
+-- a value and a function, and returns the value, applying the function
+-- to the output.
+--
+-- * @'runWriterT' ('pass' m) = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runWriterT' m)@
+pass :: (Monad m) => WriterT w m (a, w -> w) -> WriterT w m a
+pass m = WriterT $ do
+    ~((a, f), w) <- runWriterT m
+    return (a, f w)
+{-# INLINE pass #-}
+
+-- | @'censor' f m@ is an action that executes the action @m@ and
+-- applies the function @f@ to its output, leaving the return value
+-- unchanged.
+--
+-- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@
+--
+-- * @'runWriterT' ('censor' f m) = 'liftM' (\\ (a, w) -> (a, f w)) ('runWriterT' m)@
+censor :: (Monad m) => (w -> w) -> WriterT w m a -> WriterT w m a
+censor f m = WriterT $ do
+    ~(a, w) <- runWriterT m
+    return (a, f w)
+{-# INLINE censor #-}
+
+-- | Lift a @callCC@ operation to the new monad.
+liftCallCC :: (Monoid w) => CallCC m (a,w) (b,w) -> CallCC (WriterT w m) a b
+liftCallCC callCC f = WriterT $
+    callCC $ \ c ->
+    runWriterT (f (\ a -> WriterT $ c (a, mempty)))
+{-# INLINE liftCallCC #-}
+
+-- | Lift a @catchE@ operation to the new monad.
+liftCatch :: Catch e m (a,w) -> Catch e (WriterT w m) a
+liftCatch catchE m h =
+    WriterT $ runWriterT m `catchE` \ e -> runWriterT (h e)
+{-# INLINE liftCatch #-}

third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Writer/Strict.hs

@@ -0,0 +1,316 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.Writer.Strict
+-- 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
+--
+-- The strict 'WriterT' monad transformer, which adds collection of
+-- outputs (such as a count or string output) to a given monad.
+--
+-- This monad transformer provides only limited access to the output
+-- during the computation.  For more general access, use
+-- "Control.Monad.Trans.State" instead.
+--
+-- This version builds its output strictly; for a lazy version with
+-- the same interface, see "Control.Monad.Trans.Writer.Lazy".
+-- Although the output is built strictly, it is not possible to
+-- achieve constant space behaviour with this transformer: for that,
+-- use "Control.Monad.Trans.Writer.CPS" instead.
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.Writer.Strict (
+    -- * The Writer monad
+    Writer,
+    writer,
+    runWriter,
+    execWriter,
+    mapWriter,
+    -- * The WriterT monad transformer
+    WriterT(..),
+    execWriterT,
+    mapWriterT,
+    -- * Writer operations
+    tell,
+    listen,
+    listens,
+    pass,
+    censor,
+    -- * Lifting other operations
+    liftCallCC,
+    liftCatch,
+  ) where
+
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+import Data.Functor.Classes
+#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
+import Control.Monad.Signatures
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
+import Data.Foldable
+import Data.Monoid
+import Data.Traversable (Traversable(traverse))
+import Prelude hiding (null, length)
+
+-- ---------------------------------------------------------------------------
+-- | A writer monad parameterized by the type @w@ of output to accumulate.
+--
+-- The 'return' function produces the output 'mempty', while @>>=@
+-- combines the outputs of the subcomputations using 'mappend'.
+type Writer w = WriterT w Identity
+
+-- | Construct a writer computation from a (result, output) pair.
+-- (The inverse of 'runWriter'.)
+writer :: (Monad m) => (a, w) -> WriterT w m a
+writer = WriterT . return
+{-# INLINE writer #-}
+
+-- | Unwrap a writer computation as a (result, output) pair.
+-- (The inverse of 'writer'.)
+runWriter :: Writer w a -> (a, w)
+runWriter = runIdentity . runWriterT
+{-# INLINE runWriter #-}
+
+-- | Extract the output from a writer computation.
+--
+-- * @'execWriter' m = 'snd' ('runWriter' m)@
+execWriter :: Writer w a -> w
+execWriter m = snd (runWriter m)
+{-# INLINE execWriter #-}
+
+-- | Map both the return value and output of a computation using
+-- the given function.
+--
+-- * @'runWriter' ('mapWriter' f m) = f ('runWriter' m)@
+mapWriter :: ((a, w) -> (b, w')) -> Writer w a -> Writer w' b
+mapWriter f = mapWriterT (Identity . f . runIdentity)
+{-# INLINE mapWriter #-}
+
+-- ---------------------------------------------------------------------------
+-- | A writer monad parameterized by:
+--
+--   * @w@ - the output to accumulate.
+--
+--   * @m@ - The inner monad.
+--
+-- The 'return' function produces the output 'mempty', while @>>=@
+-- combines the outputs of the subcomputations using 'mappend'.
+newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }
+
+instance (Eq w, Eq1 m) => Eq1 (WriterT w m) where
+    liftEq eq (WriterT m1) (WriterT m2) = liftEq (liftEq2 eq (==)) m1 m2
+    {-# INLINE liftEq #-}
+
+instance (Ord w, Ord1 m) => Ord1 (WriterT w m) where
+    liftCompare comp (WriterT m1) (WriterT m2) =
+        liftCompare (liftCompare2 comp compare) m1 m2
+    {-# INLINE liftCompare #-}
+
+instance (Read w, Read1 m) => Read1 (WriterT w m) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "WriterT" WriterT
+      where
+        rp' = liftReadsPrec2 rp rl readsPrec readList
+        rl' = liftReadList2 rp rl readsPrec readList
+
+instance (Show w, Show1 m) => Show1 (WriterT w m) where
+    liftShowsPrec sp sl d (WriterT m) =
+        showsUnaryWith (liftShowsPrec sp' sl') "WriterT" d m
+      where
+        sp' = liftShowsPrec2 sp sl showsPrec showList
+        sl' = liftShowList2 sp sl showsPrec showList
+
+instance (Eq w, Eq1 m, Eq a) => Eq (WriterT w m a) where (==) = eq1
+instance (Ord w, Ord1 m, Ord a) => Ord (WriterT w m a) where compare = compare1
+instance (Read w, Read1 m, Read a) => Read (WriterT w m a) where
+    readsPrec = readsPrec1
+instance (Show w, Show1 m, Show a) => Show (WriterT w m a) where
+    showsPrec = showsPrec1
+
+-- | Extract the output from a writer computation.
+--
+-- * @'execWriterT' m = 'liftM' 'snd' ('runWriterT' m)@
+execWriterT :: (Monad m) => WriterT w m a -> m w
+execWriterT m = do
+    (_, w) <- runWriterT m
+    return w
+{-# INLINE execWriterT #-}
+
+-- | Map both the return value and output of a computation using
+-- the given function.
+--
+-- * @'runWriterT' ('mapWriterT' f m) = f ('runWriterT' m)@
+mapWriterT :: (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
+mapWriterT f m = WriterT $ f (runWriterT m)
+{-# INLINE mapWriterT #-}
+
+instance (Functor m) => Functor (WriterT w m) where
+    fmap f = mapWriterT $ fmap $ \ (a, w) -> (f a, w)
+    {-# INLINE fmap #-}
+
+instance (Foldable f) => Foldable (WriterT w f) where
+    foldMap f = foldMap (f . fst) . runWriterT
+    {-# INLINE foldMap #-}
+#if MIN_VERSION_base(4,8,0)
+    null (WriterT t) = null t
+    length (WriterT t) = length t
+#endif
+
+instance (Traversable f) => Traversable (WriterT w f) where
+    traverse f = fmap WriterT . traverse f' . runWriterT where
+       f' (a, b) = fmap (\ c -> (c, b)) (f a)
+    {-# INLINE traverse #-}
+
+instance (Monoid w, Applicative m) => Applicative (WriterT w m) where
+    pure a  = WriterT $ pure (a, mempty)
+    {-# INLINE pure #-}
+    f <*> v = WriterT $ liftA2 k (runWriterT f) (runWriterT v)
+      where k (a, w) (b, w') = (a b, w `mappend` w')
+    {-# INLINE (<*>) #-}
+
+instance (Monoid w, Alternative m) => Alternative (WriterT w m) where
+    empty   = WriterT empty
+    {-# INLINE empty #-}
+    m <|> n = WriterT $ runWriterT m <|> runWriterT n
+    {-# INLINE (<|>) #-}
+
+instance (Monoid w, Monad m) => Monad (WriterT w m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return a = writer (a, mempty)
+    {-# INLINE return #-}
+#endif
+    m >>= k  = WriterT $ do
+        (a, w)  <- runWriterT m
+        (b, w') <- runWriterT (k a)
+        return (b, w `mappend` w')
+    {-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
+    fail msg = WriterT $ fail msg
+    {-# INLINE fail #-}
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (WriterT w m) where
+    fail msg = WriterT $ Fail.fail msg
+    {-# INLINE fail #-}
+#endif
+
+instance (Monoid w, MonadPlus m) => MonadPlus (WriterT w m) where
+    mzero       = WriterT mzero
+    {-# INLINE mzero #-}
+    m `mplus` n = WriterT $ runWriterT m `mplus` runWriterT n
+    {-# INLINE mplus #-}
+
+instance (Monoid w, MonadFix m) => MonadFix (WriterT w m) where
+    mfix m = WriterT $ mfix $ \ ~(a, _) -> runWriterT (m a)
+    {-# INLINE mfix #-}
+
+instance (Monoid w) => MonadTrans (WriterT w) where
+    lift m = WriterT $ do
+        a <- m
+        return (a, mempty)
+    {-# INLINE lift #-}
+
+instance (Monoid w, MonadIO m) => MonadIO (WriterT w m) where
+    liftIO = lift . liftIO
+    {-# INLINE liftIO #-}
+
+#if MIN_VERSION_base(4,4,0)
+instance (Monoid w, MonadZip m) => MonadZip (WriterT w m) where
+    mzipWith f (WriterT x) (WriterT y) = WriterT $
+        mzipWith (\ (a, w) (b, w') -> (f a b, w `mappend` w')) x y
+    {-# INLINE mzipWith #-}
+#endif
+
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (WriterT w m) where
+    contramap f = mapWriterT $ contramap $ \ (a, w) -> (f a, w)
+    {-# INLINE contramap #-}
+#endif
+
+-- | @'tell' w@ is an action that produces the output @w@.
+tell :: (Monad m) => w -> WriterT w m ()
+tell w = writer ((), w)
+{-# INLINE tell #-}
+
+-- | @'listen' m@ is an action that executes the action @m@ and adds its
+-- output to the value of the computation.
+--
+-- * @'runWriterT' ('listen' m) = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runWriterT' m)@
+listen :: (Monad m) => WriterT w m a -> WriterT w m (a, w)
+listen m = WriterT $ do
+    (a, w) <- runWriterT m
+    return ((a, w), w)
+{-# INLINE listen #-}
+
+-- | @'listens' f m@ is an action that executes the action @m@ and adds
+-- the result of applying @f@ to the output to the value of the computation.
+--
+-- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@
+--
+-- * @'runWriterT' ('listens' f m) = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runWriterT' m)@
+listens :: (Monad m) => (w -> b) -> WriterT w m a -> WriterT w m (a, b)
+listens f m = WriterT $ do
+    (a, w) <- runWriterT m
+    return ((a, f w), w)
+{-# INLINE listens #-}
+
+-- | @'pass' m@ is an action that executes the action @m@, which returns
+-- a value and a function, and returns the value, applying the function
+-- to the output.
+--
+-- * @'runWriterT' ('pass' m) = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runWriterT' m)@
+pass :: (Monad m) => WriterT w m (a, w -> w) -> WriterT w m a
+pass m = WriterT $ do
+    ((a, f), w) <- runWriterT m
+    return (a, f w)
+{-# INLINE pass #-}
+
+-- | @'censor' f m@ is an action that executes the action @m@ and
+-- applies the function @f@ to its output, leaving the return value
+-- unchanged.
+--
+-- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@
+--
+-- * @'runWriterT' ('censor' f m) = 'liftM' (\\ (a, w) -> (a, f w)) ('runWriterT' m)@
+censor :: (Monad m) => (w -> w) -> WriterT w m a -> WriterT w m a
+censor f m = WriterT $ do
+    (a, w) <- runWriterT m
+    return (a, f w)
+{-# INLINE censor #-}
+
+-- | Lift a @callCC@ operation to the new monad.
+liftCallCC :: (Monoid w) => CallCC m (a,w) (b,w) -> CallCC (WriterT w m) a b
+liftCallCC callCC f = WriterT $
+    callCC $ \ c ->
+    runWriterT (f (\ a -> WriterT $ c (a, mempty)))
+{-# INLINE liftCallCC #-}
+
+-- | Lift a @catchE@ operation to the new monad.
+liftCatch :: Catch e m (a,w) -> Catch e (WriterT w m) a
+liftCatch catchE m h =
+    WriterT $ runWriterT m `catchE` \ e -> runWriterT (h e)
+{-# INLINE liftCatch #-}