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

third_party/bazel/rules_haskell/examples/transformers/BUILD.bazel

@@ -0,0 +1,19 @@
+load(
+    "@io_tweag_rules_haskell//haskell:haskell.bzl",
+    "haskell_cc_import",
+    "haskell_library",
+    "haskell_toolchain_library",
+)
+
+haskell_toolchain_library(name = "base")
+
+haskell_library(
+    name = "transformers",
+    srcs = glob([
+        "Data/**/*.hs",
+        "Control/**/*.hs",
+    ]),
+    version = "0",
+    visibility = ["//visibility:public"],
+    deps = [":base"],
+)

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

third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Constant.hs

@@ -0,0 +1,152 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 706
+{-# LANGUAGE PolyKinds #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Constant
+-- Copyright   :  (c) Ross Paterson 2010
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- The constant functor.
+-----------------------------------------------------------------------------
+
+module Data.Functor.Constant (
+    Constant(..),
+  ) where
+
+import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
+
+import Control.Applicative
+import Data.Foldable
+import Data.Monoid (Monoid(..))
+import Data.Traversable (Traversable(traverse))
+#if MIN_VERSION_base(4,8,0)
+import Data.Bifunctor (Bifunctor(..))
+#endif
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup(..))
+#endif
+#if MIN_VERSION_base(4,10,0)
+import Data.Bifoldable (Bifoldable(..))
+import Data.Bitraversable (Bitraversable(..))
+#endif
+import Prelude hiding (null, length)
+
+-- | Constant functor.
+newtype Constant a b = Constant { getConstant :: a }
+    deriving (Eq, Ord)
+
+-- These instances would be equivalent to the derived instances of the
+-- newtype if the field were removed.
+
+instance (Read a) => Read (Constant a b) where
+    readsPrec = readsData $
+         readsUnaryWith readsPrec "Constant" Constant
+
+instance (Show a) => Show (Constant a b) where
+    showsPrec d (Constant x) = showsUnaryWith showsPrec "Constant" d x
+
+-- Instances of lifted Prelude classes
+
+instance Eq2 Constant where
+    liftEq2 eq _ (Constant x) (Constant y) = eq x y
+    {-# INLINE liftEq2 #-}
+
+instance Ord2 Constant where
+    liftCompare2 comp _ (Constant x) (Constant y) = comp x y
+    {-# INLINE liftCompare2 #-}
+
+instance Read2 Constant where
+    liftReadsPrec2 rp _ _ _ = readsData $
+         readsUnaryWith rp "Constant" Constant
+
+instance Show2 Constant where
+    liftShowsPrec2 sp _ _ _ d (Constant x) = showsUnaryWith sp "Constant" d x
+
+instance (Eq a) => Eq1 (Constant a) where
+    liftEq = liftEq2 (==)
+    {-# INLINE liftEq #-}
+instance (Ord a) => Ord1 (Constant a) where
+    liftCompare = liftCompare2 compare
+    {-# INLINE liftCompare #-}
+instance (Read a) => Read1 (Constant a) where
+    liftReadsPrec = liftReadsPrec2 readsPrec readList
+    {-# INLINE liftReadsPrec #-}
+instance (Show a) => Show1 (Constant a) where
+    liftShowsPrec = liftShowsPrec2 showsPrec showList
+    {-# INLINE liftShowsPrec #-}
+
+instance Functor (Constant a) where
+    fmap _ (Constant x) = Constant x
+    {-# INLINE fmap #-}
+
+instance Foldable (Constant a) where
+    foldMap _ (Constant _) = mempty
+    {-# INLINE foldMap #-}
+#if MIN_VERSION_base(4,8,0)
+    null (Constant _) = True
+    length (Constant _) = 0
+#endif
+
+instance Traversable (Constant a) where
+    traverse _ (Constant x) = pure (Constant x)
+    {-# INLINE traverse #-}
+
+#if MIN_VERSION_base(4,9,0)
+instance (Semigroup a) => Semigroup (Constant a b) where
+    Constant x <> Constant y = Constant (x <> y)
+    {-# INLINE (<>) #-}
+#endif
+
+instance (Monoid a) => Applicative (Constant a) where
+    pure _ = Constant mempty
+    {-# INLINE pure #-}
+    Constant x <*> Constant y = Constant (x `mappend` y)
+    {-# INLINE (<*>) #-}
+
+instance (Monoid a) => Monoid (Constant a b) where
+    mempty = Constant mempty
+    {-# INLINE mempty #-}
+#if !MIN_VERSION_base(4,11,0)
+    -- From base-4.11, Monoid(mappend) defaults to Semigroup((<>))
+    Constant x `mappend` Constant y = Constant (x `mappend` y)
+    {-# INLINE mappend #-}
+#endif
+
+#if MIN_VERSION_base(4,8,0)
+instance Bifunctor Constant where
+    first f (Constant x) = Constant (f x)
+    {-# INLINE first #-}
+    second _ (Constant x) = Constant x
+    {-# INLINE second #-}
+#endif
+
+#if MIN_VERSION_base(4,10,0)
+instance Bifoldable Constant where
+    bifoldMap f _ (Constant a) = f a
+    {-# INLINE bifoldMap #-}
+
+instance Bitraversable Constant where
+    bitraverse f _ (Constant a) = Constant <$> f a
+    {-# INLINE bitraverse #-}
+#endif
+
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant (Constant a) where
+    contramap _ (Constant a) = Constant a
+    {-# INLINE contramap #-}
+#endif

third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Reverse.hs

@@ -0,0 +1,143 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 706
+{-# LANGUAGE PolyKinds #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Reverse
+-- 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 whose elements are notionally in the reverse order
+-- from the original functor.
+-----------------------------------------------------------------------------
+
+module Data.Functor.Reverse (
+    Reverse(..),
+  ) where
+
+import Control.Applicative.Backwards
+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 Control.Monad
+#if MIN_VERSION_base(4,9,0)
+import qualified Control.Monad.Fail as Fail
+#endif
+import Data.Foldable
+import Data.Traversable
+import Data.Monoid
+
+-- | The same functor, but with 'Foldable' and 'Traversable' instances
+-- that process the elements in the reverse order.
+newtype Reverse f a = Reverse { getReverse :: f a }
+
+instance (Eq1 f) => Eq1 (Reverse f) where
+    liftEq eq (Reverse x) (Reverse y) = liftEq eq x y
+    {-# INLINE liftEq #-}
+
+instance (Ord1 f) => Ord1 (Reverse f) where
+    liftCompare comp (Reverse x) (Reverse y) = liftCompare comp x y
+    {-# INLINE liftCompare #-}
+
+instance (Read1 f) => Read1 (Reverse f) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp rl) "Reverse" Reverse
+
+instance (Show1 f) => Show1 (Reverse f) where
+    liftShowsPrec sp sl d (Reverse x) =
+        showsUnaryWith (liftShowsPrec sp sl) "Reverse" d x
+
+instance (Eq1 f, Eq a) => Eq (Reverse f a) where (==) = eq1
+instance (Ord1 f, Ord a) => Ord (Reverse f a) where compare = compare1
+instance (Read1 f, Read a) => Read (Reverse f a) where readsPrec = readsPrec1
+instance (Show1 f, Show a) => Show (Reverse f a) where showsPrec = showsPrec1
+
+-- | Derived instance.
+instance (Functor f) => Functor (Reverse f) where
+    fmap f (Reverse a) = Reverse (fmap f a)
+    {-# INLINE fmap #-}
+
+-- | Derived instance.
+instance (Applicative f) => Applicative (Reverse f) where
+    pure a = Reverse (pure a)
+    {-# INLINE pure #-}
+    Reverse f <*> Reverse a = Reverse (f <*> a)
+    {-# INLINE (<*>) #-}
+
+-- | Derived instance.
+instance (Alternative f) => Alternative (Reverse f) where
+    empty = Reverse empty
+    {-# INLINE empty #-}
+    Reverse x <|> Reverse y = Reverse (x <|> y)
+    {-# INLINE (<|>) #-}
+
+-- | Derived instance.
+instance (Monad m) => Monad (Reverse m) where
+#if !(MIN_VERSION_base(4,8,0))
+    return a = Reverse (return a)
+    {-# INLINE return #-}
+#endif
+    m >>= f = Reverse (getReverse m >>= getReverse . f)
+    {-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
+    fail msg = Reverse (fail msg)
+    {-# INLINE fail #-}
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance (Fail.MonadFail m) => Fail.MonadFail (Reverse m) where
+    fail msg = Reverse (Fail.fail msg)
+    {-# INLINE fail #-}
+#endif
+
+-- | Derived instance.
+instance (MonadPlus m) => MonadPlus (Reverse m) where
+    mzero = Reverse mzero
+    {-# INLINE mzero #-}
+    Reverse x `mplus` Reverse y = Reverse (x `mplus` y)
+    {-# INLINE mplus #-}
+
+-- | Fold from right to left.
+instance (Foldable f) => Foldable (Reverse f) where
+    foldMap f (Reverse t) = getDual (foldMap (Dual . f) t)
+    {-# INLINE foldMap #-}
+    foldr f z (Reverse t) = foldl (flip f) z t
+    {-# INLINE foldr #-}
+    foldl f z (Reverse t) = foldr (flip f) z t
+    {-# INLINE foldl #-}
+    foldr1 f (Reverse t) = foldl1 (flip f) t
+    {-# INLINE foldr1 #-}
+    foldl1 f (Reverse t) = foldr1 (flip f) t
+    {-# INLINE foldl1 #-}
+#if MIN_VERSION_base(4,8,0)
+    null (Reverse t) = null t
+    length (Reverse t) = length t
+#endif
+
+-- | Traverse from right to left.
+instance (Traversable f) => Traversable (Reverse f) where
+    traverse f (Reverse t) =
+        fmap Reverse . forwards $ traverse (Backwards . f) t
+    {-# INLINE traverse #-}
+
+#if MIN_VERSION_base(4,12,0)
+-- | Derived instance.
+instance Contravariant f => Contravariant (Reverse f) where
+    contramap f = Reverse . contramap f . getReverse
+    {-# INLINE contramap #-}
+#endif

third_party/bazel/rules_haskell/examples/transformers/LICENSE

@@ -0,0 +1,31 @@
+The Glasgow Haskell Compiler License
+
+Copyright 2004, The University Court of the University of Glasgow.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.

third_party/bazel/rules_haskell/examples/transformers/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

third_party/bazel/rules_haskell/examples/transformers/changelog

@@ -0,0 +1,124 @@
+-*-change-log-*-
+
+0.5.6.2 Ross Paterson <R.Paterson@city.ac.uk> Feb 2019
+	* Further backward compatability fix
+
+0.5.6.1 Ross Paterson <R.Paterson@city.ac.uk> Feb 2019
+	* Backward compatability fix for MonadFix ListT instance
+
+0.5.6.0 Ross Paterson <R.Paterson@city.ac.uk> Feb 2019
+	* Generalized type of except
+	* Added Control.Monad.Trans.Writer.CPS and Control.Monad.Trans.RWS.CPS
+	* Added Contravariant instances
+	* Added MonadFix instance for ListT
+
+0.5.5.0 Ross Paterson <R.Paterson@city.ac.uk> Oct 2017
+	* Added mapSelect and mapSelectT
+	* Renamed selectToCont to selectToContT for consistency
+	* Defined explicit method definitions to fix space leaks
+	* Added missing Semigroup instance to `Constant` functor
+
+0.5.4.0 Ross Paterson <R.Paterson@city.ac.uk> Feb 2017
+	* Migrate Bifoldable and Bitraversable instances for Constant
+
+0.5.3.1 Ross Paterson <R.Paterson@city.ac.uk> Feb 2017
+	* Fixed for pre-AMP environments
+
+0.5.3.0 Ross Paterson <R.Paterson@city.ac.uk> Feb 2017
+	* Added AccumT and SelectT monad transformers
+	* Deprecated ListT
+	* Added Monad (and related) instances for Reverse
+	* Added elimLift and eitherToErrors
+	* Added specialized definitions of several methods for efficiency
+	* Removed specialized definition of sequenceA for Reverse
+	* Backported Eq1/Ord1/Read1/Show1 instances for Proxy
+
+0.5.2.0 Ross Paterson <R.Paterson@city.ac.uk> Feb 2016
+	* Re-added orphan instances for Either to deprecated module
+	* Added lots of INLINE pragmas
+
+0.5.1.0 Ross Paterson <R.Paterson@city.ac.uk> Jan 2016
+	* Bump minor version number, required by added instances
+
+0.5.0.2 Ross Paterson <R.Paterson@city.ac.uk> Jan 2016
+	* Backported extra instances for Identity
+
+0.5.0.1 Ross Paterson <R.Paterson@city.ac.uk> Jan 2016
+	* Tightened GHC bounds for PolyKinds and DeriveDataTypeable
+
+0.5.0.0 Ross Paterson <R.Paterson@city.ac.uk> Dec 2015
+	* Control.Monad.IO.Class in base for GHC >= 8.0
+	* Data.Functor.{Classes,Compose,Product,Sum} in base for GHC >= 8.0
+	* Added PolyKinds for GHC >= 7.4
+	* Added instances of base classes MonadZip and MonadFail
+	* Changed liftings of Prelude classes to use explicit dictionaries
+
+0.4.3.0 Ross Paterson <R.Paterson@city.ac.uk> Mar 2015
+	* Added Eq1, Ord1, Show1 and Read1 instances for Const
+
+0.4.2.0 Ross Paterson <ross@soi.city.ac.uk> Nov 2014
+	* Dropped compatibility with base-1.x
+	* Data.Functor.Identity in base for GHC >= 7.10
+	* Added mapLift and runErrors to Control.Applicative.Lift
+	* Added AutoDeriveTypeable for GHC >= 7.10
+	* Expanded messages from mfix on ExceptT and MaybeT
+
+0.4.1.0 Ross Paterson <ross@soi.city.ac.uk> May 2014
+	* Reverted to record syntax for newtypes until next major release
+
+0.4.0.0 Ross Paterson <ross@soi.city.ac.uk> May 2014
+	* Added Sum type
+	* Added modify', a strict version of modify, to the state monads
+	* Added ExceptT and deprecated ErrorT
+	* Added infixr 9 `Compose` to match (.)
+	* Added Eq, Ord, Read and Show instances where possible
+	* Replaced record syntax for newtypes with separate inverse functions
+	* Added delimited continuation functions to ContT
+	* Added instance Alternative IO to ErrorT
+	* Handled disappearance of Control.Monad.Instances
+
+0.3.0.0 Ross Paterson <ross@soi.city.ac.uk> Mar 2012
+	* Added type synonyms for signatures of complex operations
+	* Generalized state, reader and writer constructor functions
+	* Added Lift, Backwards/Reverse
+	* Added MonadFix instances for IdentityT and MaybeT
+	* Added Foldable and Traversable instances
+	* Added Monad instances for Product
+
+0.2.2.1 Ross Paterson <ross@soi.city.ac.uk> Oct 2013
+	* Backport of fix for disappearance of Control.Monad.Instances
+
+0.2.2.0 Ross Paterson <ross@soi.city.ac.uk> Sep 2010
+	* Handled move of Either instances to base package
+
+0.2.1.0 Ross Paterson <ross@soi.city.ac.uk> Apr 2010
+	* Added Alternative instance for Compose
+	* Added Data.Functor.Product
+
+0.2.0.0 Ross Paterson <ross@soi.city.ac.uk> Mar 2010
+	* Added Constant and Compose
+	* Renamed modules to avoid clash with mtl
+	* Removed Monad constraint from Monad instance for ContT
+
+0.1.4.0 Ross Paterson <ross@soi.city.ac.uk> Mar 2009
+	* Adjusted lifting of Identity and Maybe transformers
+
+0.1.3.0 Ross Paterson <ross@soi.city.ac.uk> Mar 2009
+	* Added IdentityT transformer
+	* Added Applicative and Alternative instances for (Either e)
+
+0.1.1.0 Ross Paterson <ross@soi.city.ac.uk> Jan 2009
+	* Made all Functor instances assume Functor
+
+0.1.0.1 Ross Paterson <ross@soi.city.ac.uk> Jan 2009
+	* Adjusted dependencies
+
+0.1.0.0 Ross Paterson <ross@soi.city.ac.uk> Jan 2009
+	* Two versions of lifting of callcc through StateT
+	* Added Applicative instances
+
+0.0.1.0 Ross Paterson <ross@soi.city.ac.uk> Jan 2009
+	* Added constructors state, etc for simple monads
+
+0.0.0.0 Ross Paterson <ross@soi.city.ac.uk> Jan 2009
+	* Split Haskell 98 transformers from the mtl

third_party/bazel/rules_haskell/examples/transformers/legacy/pre709/Data/Functor/Identity.hs

@@ -0,0 +1,259 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 700
+{-# LANGUAGE DeriveDataTypeable #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE Trustworthy #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 706
+{-# LANGUAGE PolyKinds #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DataKinds #-}
+#endif
+#if MIN_VERSION_base(4,7,0)
+-- We need to implement bitSize for the Bits instance, but it's deprecated.
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Identity
+-- Copyright   :  (c) Andy Gill 2001,
+--                (c) Oregon Graduate Institute of Science and Technology 2001
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  ross@soi.city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- The identity functor and monad.
+--
+-- This trivial type constructor serves two purposes:
+--
+-- * It can be used with functions parameterized by functor or monad classes.
+--
+-- * It can be used as a base monad to which a series of monad
+--   transformers may be applied to construct a composite monad.
+--   Most monad transformer modules include the special case of
+--   applying the transformer to 'Identity'.  For example, @State s@
+--   is an abbreviation for @StateT s 'Identity'@.
+-----------------------------------------------------------------------------
+
+module Data.Functor.Identity (
+    Identity(..),
+  ) where
+
+import Data.Bits
+import Control.Applicative
+import Control.Arrow (Arrow((***)))
+import Control.Monad.Fix
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith, munzip))
+#endif
+import Data.Foldable (Foldable(foldMap))
+import Data.Monoid (Monoid(mempty, mappend))
+import Data.String (IsString(fromString))
+import Data.Traversable (Traversable(traverse))
+#if __GLASGOW_HASKELL__ >= 700
+import Data.Data
+#endif
+import Data.Ix (Ix(..))
+import Foreign (Storable(..), castPtr)
+#if __GLASGOW_HASKELL__ >= 702
+import GHC.Generics
+#endif
+
+-- | Identity functor and monad. (a non-strict monad)
+newtype Identity a = Identity { runIdentity :: a }
+    deriving ( Eq, Ord
+#if __GLASGOW_HASKELL__ >= 700
+             , Data, Typeable
+#endif
+#if __GLASGOW_HASKELL__ >= 702
+             , Generic
+#endif
+#if __GLASGOW_HASKELL__ >= 706
+             , Generic1
+#endif
+             )
+
+instance (Bits a) => Bits (Identity a) where
+    Identity x .&. Identity y     = Identity (x .&. y)
+    Identity x .|. Identity y     = Identity (x .|. y)
+    xor (Identity x) (Identity y) = Identity (xor x y)
+    complement   (Identity x)     = Identity (complement x)
+    shift        (Identity x) i   = Identity (shift    x i)
+    rotate       (Identity x) i   = Identity (rotate   x i)
+    setBit       (Identity x) i   = Identity (setBit   x i)
+    clearBit     (Identity x) i   = Identity (clearBit x i)
+    shiftL       (Identity x) i   = Identity (shiftL   x i)
+    shiftR       (Identity x) i   = Identity (shiftR   x i)
+    rotateL      (Identity x) i   = Identity (rotateL  x i)
+    rotateR      (Identity x) i   = Identity (rotateR  x i)
+    testBit      (Identity x) i   = testBit x i
+    bitSize      (Identity x)     = bitSize x
+    isSigned     (Identity x)     = isSigned x
+    bit i                         = Identity (bit i)
+#if MIN_VERSION_base(4,5,0)
+    unsafeShiftL (Identity x) i   = Identity (unsafeShiftL x i)
+    unsafeShiftR (Identity x) i   = Identity (unsafeShiftR x i)
+    popCount     (Identity x)     = popCount x
+#endif
+#if MIN_VERSION_base(4,7,0)
+    zeroBits                      = Identity zeroBits
+    bitSizeMaybe (Identity x)     = bitSizeMaybe x
+#endif
+
+instance (Bounded a) => Bounded (Identity a) where
+    minBound = Identity minBound
+    maxBound = Identity maxBound
+
+instance (Enum a) => Enum (Identity a) where
+    succ (Identity x)     = Identity (succ x)
+    pred (Identity x)     = Identity (pred x)
+    toEnum i              = Identity (toEnum i)
+    fromEnum (Identity x) = fromEnum x
+    enumFrom (Identity x) = map Identity (enumFrom x)
+    enumFromThen (Identity x) (Identity y) = map Identity (enumFromThen x y)
+    enumFromTo   (Identity x) (Identity y) = map Identity (enumFromTo   x y)
+    enumFromThenTo (Identity x) (Identity y) (Identity z) =
+        map Identity (enumFromThenTo x y z)
+
+#if MIN_VERSION_base(4,7,0)
+instance (FiniteBits a) => FiniteBits (Identity a) where
+    finiteBitSize (Identity x) = finiteBitSize x
+#endif
+
+instance (Floating a) => Floating (Identity a) where
+    pi                                = Identity pi
+    exp   (Identity x)                = Identity (exp x)
+    log   (Identity x)                = Identity (log x)
+    sqrt  (Identity x)                = Identity (sqrt x)
+    sin   (Identity x)                = Identity (sin x)
+    cos   (Identity x)                = Identity (cos x)
+    tan   (Identity x)                = Identity (tan x)
+    asin  (Identity x)                = Identity (asin x)
+    acos  (Identity x)                = Identity (acos x)
+    atan  (Identity x)                = Identity (atan x)
+    sinh  (Identity x)                = Identity (sinh x)
+    cosh  (Identity x)                = Identity (cosh x)
+    tanh  (Identity x)                = Identity (tanh x)
+    asinh (Identity x)                = Identity (asinh x)
+    acosh (Identity x)                = Identity (acosh x)
+    atanh (Identity x)                = Identity (atanh x)
+    Identity x ** Identity y          = Identity (x ** y)
+    logBase (Identity x) (Identity y) = Identity (logBase x y)
+
+instance (Fractional a) => Fractional (Identity a) where
+    Identity x / Identity y = Identity (x / y)
+    recip (Identity x)      = Identity (recip x)
+    fromRational r          = Identity (fromRational r)
+
+instance (IsString a) => IsString (Identity a) where
+    fromString s = Identity (fromString s)
+
+instance (Ix a) => Ix (Identity a) where
+    range     (Identity x, Identity y) = map Identity (range (x, y))
+    index     (Identity x, Identity y) (Identity i) = index     (x, y) i
+    inRange   (Identity x, Identity y) (Identity e) = inRange   (x, y) e
+    rangeSize (Identity x, Identity y) = rangeSize (x, y)
+
+instance (Integral a) => Integral (Identity a) where
+    quot    (Identity x) (Identity y) = Identity (quot x y)
+    rem     (Identity x) (Identity y) = Identity (rem  x y)
+    div     (Identity x) (Identity y) = Identity (div  x y)
+    mod     (Identity x) (Identity y) = Identity (mod  x y)
+    quotRem (Identity x) (Identity y) = (Identity *** Identity) (quotRem x y)
+    divMod  (Identity x) (Identity y) = (Identity *** Identity) (divMod  x y)
+    toInteger (Identity x)            = toInteger x
+
+instance (Monoid a) => Monoid (Identity a) where
+    mempty = Identity mempty
+    mappend (Identity x) (Identity y) = Identity (mappend x y)
+
+instance (Num a) => Num (Identity a) where
+    Identity x + Identity y = Identity (x + y)
+    Identity x - Identity y = Identity (x - y)
+    Identity x * Identity y = Identity (x * y)
+    negate (Identity x)     = Identity (negate x)
+    abs    (Identity x)     = Identity (abs    x)
+    signum (Identity x)     = Identity (signum x)
+    fromInteger n           = Identity (fromInteger n)
+
+instance (Real a) => Real (Identity a) where
+    toRational (Identity x) = toRational x
+
+instance (RealFloat a) => RealFloat (Identity a) where
+    floatRadix     (Identity x)     = floatRadix     x
+    floatDigits    (Identity x)     = floatDigits    x
+    floatRange     (Identity x)     = floatRange     x
+    decodeFloat    (Identity x)     = decodeFloat    x
+    exponent       (Identity x)     = exponent       x
+    isNaN          (Identity x)     = isNaN          x
+    isInfinite     (Identity x)     = isInfinite     x
+    isDenormalized (Identity x)     = isDenormalized x
+    isNegativeZero (Identity x)     = isNegativeZero x
+    isIEEE         (Identity x)     = isIEEE         x
+    significand    (Identity x)     = significand (Identity x)
+    scaleFloat s   (Identity x)     = Identity (scaleFloat s x)
+    encodeFloat m n                 = Identity (encodeFloat m n)
+    atan2 (Identity x) (Identity y) = Identity (atan2 x y)
+
+instance (RealFrac a) => RealFrac (Identity a) where
+    properFraction (Identity x) = (id *** Identity) (properFraction x)
+    truncate       (Identity x) = truncate x
+    round          (Identity x) = round    x
+    ceiling        (Identity x) = ceiling  x
+    floor          (Identity x) = floor    x
+
+instance (Storable a) => Storable (Identity a) where
+    sizeOf    (Identity x)       = sizeOf x
+    alignment (Identity x)       = alignment x
+    peekElemOff p i              = fmap Identity (peekElemOff (castPtr p) i)
+    pokeElemOff p i (Identity x) = pokeElemOff (castPtr p) i x
+    peekByteOff p i              = fmap Identity (peekByteOff p i)
+    pokeByteOff p i (Identity x) = pokeByteOff p i x
+    peek p                       = fmap runIdentity (peek (castPtr p))
+    poke p (Identity x)          = poke (castPtr p) x
+
+-- These instances would be equivalent to the derived instances of the
+-- newtype if the field were removed.
+
+instance (Read a) => Read (Identity a) where
+    readsPrec d = readParen (d > 10) $ \ r ->
+        [(Identity x,t) | ("Identity",s) <- lex r, (x,t) <- readsPrec 11 s]
+
+instance (Show a) => Show (Identity a) where
+    showsPrec d (Identity x) = showParen (d > 10) $
+        showString "Identity " . showsPrec 11 x
+
+-- ---------------------------------------------------------------------------
+-- Identity instances for Functor and Monad
+
+instance Functor Identity where
+    fmap f m = Identity (f (runIdentity m))
+
+instance Foldable Identity where
+    foldMap f (Identity x) = f x
+
+instance Traversable Identity where
+    traverse f (Identity x) = Identity <$> f x
+
+instance Applicative Identity where
+    pure a = Identity a
+    Identity f <*> Identity x = Identity (f x)
+
+instance Monad Identity where
+    return a = Identity a
+    m >>= k  = k (runIdentity m)
+
+instance MonadFix Identity where
+    mfix f = Identity (fix (runIdentity . f))
+
+#if MIN_VERSION_base(4,4,0)
+instance MonadZip Identity where
+    mzipWith f (Identity x) (Identity y) = Identity (f x y)
+    munzip (Identity (a, b)) = (Identity a, Identity b)
+#endif

third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Control/Monad/IO/Class.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StandaloneDeriving #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.IO.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
+--
+-- Class of monads based on @IO@.
+-----------------------------------------------------------------------------
+
+module Control.Monad.IO.Class (
+    MonadIO(..)
+  ) where
+
+#if __GLASGOW_HASKELL__ >= 708
+import Data.Typeable
+#endif
+
+-- | Monads in which 'IO' computations may be embedded.
+-- Any monad built by applying a sequence of monad transformers to the
+-- 'IO' monad will be an instance of this class.
+--
+-- Instances should satisfy the following laws, which state that 'liftIO'
+-- is a transformer of monads:
+--
+-- * @'liftIO' . 'return' = 'return'@
+--
+-- * @'liftIO' (m >>= f) = 'liftIO' m >>= ('liftIO' . f)@
+
+class (Monad m) => MonadIO m where
+    -- | Lift a computation from the 'IO' monad.
+    liftIO :: IO a -> m a
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable MonadIO
+#endif
+
+instance MonadIO IO where
+    liftIO = id

third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Classes.hs

@@ -0,0 +1,529 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StandaloneDeriving #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Classes
+-- Copyright   :  (c) Ross Paterson 2013
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Liftings of the Prelude classes 'Eq', 'Ord', 'Read' and 'Show' to
+-- unary and binary type constructors.
+--
+-- These classes are needed to express the constraints on arguments of
+-- transformers in portable Haskell.  Thus for a new transformer @T@,
+-- one might write instances like
+--
+-- > instance (Eq1 f) => Eq1 (T f) where ...
+-- > instance (Ord1 f) => Ord1 (T f) where ...
+-- > instance (Read1 f) => Read1 (T f) where ...
+-- > instance (Show1 f) => Show1 (T f) where ...
+--
+-- If these instances can be defined, defining instances of the base
+-- classes is mechanical:
+--
+-- > instance (Eq1 f, Eq a) => Eq (T f a) where (==) = eq1
+-- > instance (Ord1 f, Ord a) => Ord (T f a) where compare = compare1
+-- > instance (Read1 f, Read a) => Read (T f a) where readsPrec = readsPrec1
+-- > instance (Show1 f, Show a) => Show (T f a) where showsPrec = showsPrec1
+--
+-----------------------------------------------------------------------------
+
+module Data.Functor.Classes (
+    -- * Liftings of Prelude classes
+    -- ** For unary constructors
+    Eq1(..), eq1,
+    Ord1(..), compare1,
+    Read1(..), readsPrec1,
+    Show1(..), showsPrec1,
+    -- ** For binary constructors
+    Eq2(..), eq2,
+    Ord2(..), compare2,
+    Read2(..), readsPrec2,
+    Show2(..), showsPrec2,
+    -- * Helper functions
+    -- $example
+    readsData,
+    readsUnaryWith,
+    readsBinaryWith,
+    showsUnaryWith,
+    showsBinaryWith,
+    -- ** Obsolete helpers
+    readsUnary,
+    readsUnary1,
+    readsBinary1,
+    showsUnary,
+    showsUnary1,
+    showsBinary1,
+  ) where
+
+import Control.Applicative (Const(Const))
+import Data.Functor.Identity (Identity(Identity))
+import Data.Monoid (mappend)
+#if MIN_VERSION_base(4,7,0)
+import Data.Proxy (Proxy(Proxy))
+#endif
+#if __GLASGOW_HASKELL__ >= 708
+import Data.Typeable
+#endif
+import Text.Show (showListWith)
+
+-- | Lifting of the 'Eq' class to unary type constructors.
+class Eq1 f where
+    -- | Lift an equality test through the type constructor.
+    --
+    -- The function will usually be applied to an equality function,
+    -- but the more general type ensures that the implementation uses
+    -- it to compare elements of the first container with elements of
+    -- the second.
+    liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Eq1
+#endif
+
+-- | Lift the standard @('==')@ function through the type constructor.
+eq1 :: (Eq1 f, Eq a) => f a -> f a -> Bool
+eq1 = liftEq (==)
+
+-- | Lifting of the 'Ord' class to unary type constructors.
+class (Eq1 f) => Ord1 f where
+    -- | Lift a 'compare' function through the type constructor.
+    --
+    -- The function will usually be applied to a comparison function,
+    -- but the more general type ensures that the implementation uses
+    -- it to compare elements of the first container with elements of
+    -- the second.
+    liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Ord1
+#endif
+
+-- | Lift the standard 'compare' function through the type constructor.
+compare1 :: (Ord1 f, Ord a) => f a -> f a -> Ordering
+compare1 = liftCompare compare
+
+-- | Lifting of the 'Read' class to unary type constructors.
+class Read1 f where
+    -- | 'readsPrec' function for an application of the type constructor
+    -- based on 'readsPrec' and 'readList' functions for the argument type.
+    liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
+
+    -- | 'readList' function for an application of the type constructor
+    -- based on 'readsPrec' and 'readList' functions for the argument type.
+    -- The default implementation using standard list syntax is correct
+    -- for most types.
+    liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
+    liftReadList rp rl = readListWith (liftReadsPrec rp rl 0)
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Read1
+#endif
+
+-- | Read a list (using square brackets and commas), given a function
+-- for reading elements.
+readListWith :: ReadS a -> ReadS [a]
+readListWith rp =
+    readParen False (\r -> [pr | ("[",s) <- lex r, pr <- readl s])
+  where
+    readl s = [([],t) | ("]",t) <- lex s] ++
+        [(x:xs,u) | (x,t) <- rp s, (xs,u) <- readl' t]
+    readl' s = [([],t) | ("]",t) <- lex s] ++
+        [(x:xs,v) | (",",t) <- lex s, (x,u) <- rp t, (xs,v) <- readl' u]
+
+-- | Lift the standard 'readsPrec' and 'readList' functions through the
+-- type constructor.
+readsPrec1 :: (Read1 f, Read a) => Int -> ReadS (f a)
+readsPrec1 = liftReadsPrec readsPrec readList
+
+-- | Lifting of the 'Show' class to unary type constructors.
+class Show1 f where
+    -- | 'showsPrec' function for an application of the type constructor
+    -- based on 'showsPrec' and 'showList' functions for the argument type.
+    liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
+        Int -> f a -> ShowS
+
+    -- | 'showList' function for an application of the type constructor
+    -- based on 'showsPrec' and 'showList' functions for the argument type.
+    -- The default implementation using standard list syntax is correct
+    -- for most types.
+    liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
+        [f a] -> ShowS
+    liftShowList sp sl = showListWith (liftShowsPrec sp sl 0)
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Show1
+#endif
+
+-- | Lift the standard 'showsPrec' and 'showList' functions through the
+-- type constructor.
+showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS
+showsPrec1 = liftShowsPrec showsPrec showList
+
+-- | Lifting of the 'Eq' class to binary type constructors.
+class Eq2 f where
+    -- | Lift equality tests through the type constructor.
+    --
+    -- The function will usually be applied to equality functions,
+    -- but the more general type ensures that the implementation uses
+    -- them to compare elements of the first container with elements of
+    -- the second.
+    liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Eq2
+#endif
+
+-- | Lift the standard @('==')@ function through the type constructor.
+eq2 :: (Eq2 f, Eq a, Eq b) => f a b -> f a b -> Bool
+eq2 = liftEq2 (==) (==)
+
+-- | Lifting of the 'Ord' class to binary type constructors.
+class (Eq2 f) => Ord2 f where
+    -- | Lift 'compare' functions through the type constructor.
+    --
+    -- The function will usually be applied to comparison functions,
+    -- but the more general type ensures that the implementation uses
+    -- them to compare elements of the first container with elements of
+    -- the second.
+    liftCompare2 :: (a -> b -> Ordering) -> (c -> d -> Ordering) ->
+        f a c -> f b d -> Ordering
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Ord2
+#endif
+
+-- | Lift the standard 'compare' function through the type constructor.
+compare2 :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Ordering
+compare2 = liftCompare2 compare compare
+
+-- | Lifting of the 'Read' class to binary type constructors.
+class Read2 f where
+    -- | 'readsPrec' function for an application of the type constructor
+    -- based on 'readsPrec' and 'readList' functions for the argument types.
+    liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] ->
+        (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (f a b)
+
+    -- | 'readList' function for an application of the type constructor
+    -- based on 'readsPrec' and 'readList' functions for the argument types.
+    -- The default implementation using standard list syntax is correct
+    -- for most types.
+    liftReadList2 :: (Int -> ReadS a) -> ReadS [a] ->
+        (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
+    liftReadList2 rp1 rl1 rp2 rl2 =
+        readListWith (liftReadsPrec2 rp1 rl1 rp2 rl2 0)
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Read2
+#endif
+
+-- | Lift the standard 'readsPrec' function through the type constructor.
+readsPrec2 :: (Read2 f, Read a, Read b) => Int -> ReadS (f a b)
+readsPrec2 = liftReadsPrec2 readsPrec readList readsPrec readList
+
+-- | Lifting of the 'Show' class to binary type constructors.
+class Show2 f where
+    -- | 'showsPrec' function for an application of the type constructor
+    -- based on 'showsPrec' and 'showList' functions for the argument types.
+    liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
+        (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> f a b -> ShowS
+
+    -- | 'showList' function for an application of the type constructor
+    -- based on 'showsPrec' and 'showList' functions for the argument types.
+    -- The default implementation using standard list syntax is correct
+    -- for most types.
+    liftShowList2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
+        (Int -> b -> ShowS) -> ([b] -> ShowS) -> [f a b] -> ShowS
+    liftShowList2 sp1 sl1 sp2 sl2 =
+        showListWith (liftShowsPrec2 sp1 sl1 sp2 sl2 0)
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Show2
+#endif
+
+-- | Lift the standard 'showsPrec' function through the type constructor.
+showsPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> ShowS
+showsPrec2 = liftShowsPrec2 showsPrec showList showsPrec showList
+
+-- Instances for Prelude type constructors
+
+instance Eq1 Maybe where
+    liftEq _ Nothing Nothing = True
+    liftEq _ Nothing (Just _) = False
+    liftEq _ (Just _) Nothing = False
+    liftEq eq (Just x) (Just y) = eq x y
+
+instance Ord1 Maybe where
+    liftCompare _ Nothing Nothing = EQ
+    liftCompare _ Nothing (Just _) = LT
+    liftCompare _ (Just _) Nothing = GT
+    liftCompare comp (Just x) (Just y) = comp x y
+
+instance Read1 Maybe where
+    liftReadsPrec rp _ d =
+         readParen False (\ r -> [(Nothing,s) | ("Nothing",s) <- lex r])
+         `mappend`
+         readsData (readsUnaryWith rp "Just" Just) d
+
+instance Show1 Maybe where
+    liftShowsPrec _ _ _ Nothing = showString "Nothing"
+    liftShowsPrec sp _ d (Just x) = showsUnaryWith sp "Just" d x
+
+instance Eq1 [] where
+    liftEq _ [] [] = True
+    liftEq _ [] (_:_) = False
+    liftEq _ (_:_) [] = False
+    liftEq eq (x:xs) (y:ys) = eq x y && liftEq eq xs ys
+
+instance Ord1 [] where
+    liftCompare _ [] [] = EQ
+    liftCompare _ [] (_:_) = LT
+    liftCompare _ (_:_) [] = GT
+    liftCompare comp (x:xs) (y:ys) = comp x y `mappend` liftCompare comp xs ys
+
+instance Read1 [] where
+    liftReadsPrec _ rl _ = rl
+
+instance Show1 [] where
+    liftShowsPrec _ sl _ = sl
+
+instance Eq2 (,) where
+    liftEq2 e1 e2 (x1, y1) (x2, y2) = e1 x1 x2 && e2 y1 y2
+
+instance Ord2 (,) where
+    liftCompare2 comp1 comp2 (x1, y1) (x2, y2) =
+        comp1 x1 x2 `mappend` comp2 y1 y2
+
+instance Read2 (,) where
+    liftReadsPrec2 rp1 _ rp2 _ _ = readParen False $ \ r ->
+        [((x,y), w) | ("(",s) <- lex r,
+                      (x,t)   <- rp1 0 s,
+                      (",",u) <- lex t,
+                      (y,v)   <- rp2 0 u,
+                      (")",w) <- lex v]
+
+instance Show2 (,) where
+    liftShowsPrec2 sp1 _ sp2 _ _ (x, y) =
+        showChar '(' . sp1 0 x . showChar ',' . sp2 0 y . showChar ')'
+
+instance (Eq a) => Eq1 ((,) a) where
+    liftEq = liftEq2 (==)
+
+instance (Ord a) => Ord1 ((,) a) where
+    liftCompare = liftCompare2 compare
+
+instance (Read a) => Read1 ((,) a) where
+    liftReadsPrec = liftReadsPrec2 readsPrec readList
+
+instance (Show a) => Show1 ((,) a) where
+    liftShowsPrec = liftShowsPrec2 showsPrec showList
+
+instance Eq2 Either where
+    liftEq2 e1 _ (Left x) (Left y) = e1 x y
+    liftEq2 _ _ (Left _) (Right _) = False
+    liftEq2 _ _ (Right _) (Left _) = False
+    liftEq2 _ e2 (Right x) (Right y) = e2 x y
+
+instance Ord2 Either where
+    liftCompare2 comp1 _ (Left x) (Left y) = comp1 x y
+    liftCompare2 _ _ (Left _) (Right _) = LT
+    liftCompare2 _ _ (Right _) (Left _) = GT
+    liftCompare2 _ comp2 (Right x) (Right y) = comp2 x y
+
+instance Read2 Either where
+    liftReadsPrec2 rp1 _ rp2 _ = readsData $
+         readsUnaryWith rp1 "Left" Left `mappend`
+         readsUnaryWith rp2 "Right" Right
+
+instance Show2 Either where
+    liftShowsPrec2 sp1 _ _ _ d (Left x) = showsUnaryWith sp1 "Left" d x
+    liftShowsPrec2 _ _ sp2 _ d (Right x) = showsUnaryWith sp2 "Right" d x
+
+instance (Eq a) => Eq1 (Either a) where
+    liftEq = liftEq2 (==)
+
+instance (Ord a) => Ord1 (Either a) where
+    liftCompare = liftCompare2 compare
+
+instance (Read a) => Read1 (Either a) where
+    liftReadsPrec = liftReadsPrec2 readsPrec readList
+
+instance (Show a) => Show1 (Either a) where
+    liftShowsPrec = liftShowsPrec2 showsPrec showList
+
+#if MIN_VERSION_base(4,7,0)
+instance Eq1 Proxy where
+    liftEq _ _ _ = True
+
+instance Ord1 Proxy where
+    liftCompare _ _ _ = EQ
+
+instance Show1 Proxy where
+    liftShowsPrec _ _ _ _ = showString "Proxy"
+
+instance Read1 Proxy where
+    liftReadsPrec _ _ d =
+        readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ])
+#endif
+
+-- Instances for other functors defined in the base package
+
+instance Eq1 Identity where
+    liftEq eq (Identity x) (Identity y) = eq x y
+
+instance Ord1 Identity where
+    liftCompare comp (Identity x) (Identity y) = comp x y
+
+instance Read1 Identity where
+    liftReadsPrec rp _ = readsData $
+         readsUnaryWith rp "Identity" Identity
+
+instance Show1 Identity where
+    liftShowsPrec sp _ d (Identity x) = showsUnaryWith sp "Identity" d x
+
+instance Eq2 Const where
+    liftEq2 eq _ (Const x) (Const y) = eq x y
+
+instance Ord2 Const where
+    liftCompare2 comp _ (Const x) (Const y) = comp x y
+
+instance Read2 Const where
+    liftReadsPrec2 rp _ _ _ = readsData $
+         readsUnaryWith rp "Const" Const
+
+instance Show2 Const where
+    liftShowsPrec2 sp _ _ _ d (Const x) = showsUnaryWith sp "Const" d x
+
+instance (Eq a) => Eq1 (Const a) where
+    liftEq = liftEq2 (==)
+instance (Ord a) => Ord1 (Const a) where
+    liftCompare = liftCompare2 compare
+instance (Read a) => Read1 (Const a) where
+    liftReadsPrec = liftReadsPrec2 readsPrec readList
+instance (Show a) => Show1 (Const a) where
+    liftShowsPrec = liftShowsPrec2 showsPrec showList
+
+-- Building blocks
+
+-- | @'readsData' p d@ is a parser for datatypes where each alternative
+-- begins with a data constructor.  It parses the constructor and
+-- passes it to @p@.  Parsers for various constructors can be constructed
+-- with 'readsUnary', 'readsUnary1' and 'readsBinary1', and combined with
+-- @mappend@ from the @Monoid@ class.
+readsData :: (String -> ReadS a) -> Int -> ReadS a
+readsData reader d =
+    readParen (d > 10) $ \ r -> [res | (kw,s) <- lex r, res <- reader kw s]
+
+-- | @'readsUnaryWith' rp n c n'@ matches the name of a unary data constructor
+-- and then parses its argument using @rp@.
+readsUnaryWith :: (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
+readsUnaryWith rp name cons kw s =
+    [(cons x,t) | kw == name, (x,t) <- rp 11 s]
+
+-- | @'readsBinaryWith' rp1 rp2 n c n'@ matches the name of a binary
+-- data constructor and then parses its arguments using @rp1@ and @rp2@
+-- respectively.
+readsBinaryWith :: (Int -> ReadS a) -> (Int -> ReadS b) ->
+    String -> (a -> b -> t) -> String -> ReadS t
+readsBinaryWith rp1 rp2 name cons kw s =
+    [(cons x y,u) | kw == name, (x,t) <- rp1 11 s, (y,u) <- rp2 11 t]
+
+-- | @'showsUnaryWith' sp n d x@ produces the string representation of a
+-- unary data constructor with name @n@ and argument @x@, in precedence
+-- context @d@.
+showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
+showsUnaryWith sp name d x = showParen (d > 10) $
+    showString name . showChar ' ' . sp 11 x
+
+-- | @'showsBinaryWith' sp1 sp2 n d x y@ produces the string
+-- representation of a binary data constructor with name @n@ and arguments
+-- @x@ and @y@, in precedence context @d@.
+showsBinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) ->
+    String -> Int -> a -> b -> ShowS
+showsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $
+    showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y
+
+-- Obsolete building blocks
+
+-- | @'readsUnary' n c n'@ matches the name of a unary data constructor
+-- and then parses its argument using 'readsPrec'.
+{-# DEPRECATED readsUnary "Use readsUnaryWith to define liftReadsPrec" #-}
+readsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t
+readsUnary name cons kw s =
+    [(cons x,t) | kw == name, (x,t) <- readsPrec 11 s]
+
+-- | @'readsUnary1' n c n'@ matches the name of a unary data constructor
+-- and then parses its argument using 'readsPrec1'.
+{-# DEPRECATED readsUnary1 "Use readsUnaryWith to define liftReadsPrec" #-}
+readsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t
+readsUnary1 name cons kw s =
+    [(cons x,t) | kw == name, (x,t) <- readsPrec1 11 s]
+
+-- | @'readsBinary1' n c n'@ matches the name of a binary data constructor
+-- and then parses its arguments using 'readsPrec1'.
+{-# DEPRECATED readsBinary1 "Use readsBinaryWith to define liftReadsPrec" #-}
+readsBinary1 :: (Read1 f, Read1 g, Read a) =>
+    String -> (f a -> g a -> t) -> String -> ReadS t
+readsBinary1 name cons kw s =
+    [(cons x y,u) | kw == name,
+        (x,t) <- readsPrec1 11 s, (y,u) <- readsPrec1 11 t]
+
+-- | @'showsUnary' n d x@ produces the string representation of a unary data
+-- constructor with name @n@ and argument @x@, in precedence context @d@.
+{-# DEPRECATED showsUnary "Use showsUnaryWith to define liftShowsPrec" #-}
+showsUnary :: (Show a) => String -> Int -> a -> ShowS
+showsUnary name d x = showParen (d > 10) $
+    showString name . showChar ' ' . showsPrec 11 x
+
+-- | @'showsUnary1' n d x@ produces the string representation of a unary data
+-- constructor with name @n@ and argument @x@, in precedence context @d@.
+{-# DEPRECATED showsUnary1 "Use showsUnaryWith to define liftShowsPrec" #-}
+showsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS
+showsUnary1 name d x = showParen (d > 10) $
+    showString name . showChar ' ' . showsPrec1 11 x
+
+-- | @'showsBinary1' n d x y@ produces the string representation of a binary
+-- data constructor with name @n@ and arguments @x@ and @y@, in precedence
+-- context @d@.
+{-# DEPRECATED showsBinary1 "Use showsBinaryWith to define liftShowsPrec" #-}
+showsBinary1 :: (Show1 f, Show1 g, Show a) =>
+    String -> Int -> f a -> g a -> ShowS
+showsBinary1 name d x y = showParen (d > 10) $
+    showString name . showChar ' ' . showsPrec1 11 x .
+        showChar ' ' . showsPrec1 11 y
+
+{- $example
+These functions can be used to assemble 'Read' and 'Show' instances for
+new algebraic types.  For example, given the definition
+
+> data T f a = Zero a | One (f a) | Two a (f a)
+
+a standard 'Read1' instance may be defined as
+
+> instance (Read1 f) => Read1 (T f) where
+>     liftReadsPrec rp rl = readsData $
+>         readsUnaryWith rp "Zero" Zero `mappend`
+>         readsUnaryWith (liftReadsPrec rp rl) "One" One `mappend`
+>         readsBinaryWith rp (liftReadsPrec rp rl) "Two" Two
+
+and the corresponding 'Show1' instance as
+
+> instance (Show1 f) => Show1 (T f) where
+>     liftShowsPrec sp _ d (Zero x) =
+>         showsUnaryWith sp "Zero" d x
+>     liftShowsPrec sp sl d (One x) =
+>         showsUnaryWith (liftShowsPrec sp sl) "One" d x
+>     liftShowsPrec sp sl d (Two x y) =
+>         showsBinaryWith sp (liftShowsPrec sp sl) "Two" d x y
+
+-}

third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Compose.hs

@@ -0,0 +1,154 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 706
+{-# LANGUAGE PolyKinds #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE KindSignatures #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Compose
+-- Copyright   :  (c) Ross Paterson 2010
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Composition of functors.
+-----------------------------------------------------------------------------
+
+module Data.Functor.Compose (
+    Compose(..),
+  ) where
+
+import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
+
+import Control.Applicative
+#if __GLASGOW_HASKELL__ >= 708
+import Data.Data
+#endif
+import Data.Foldable (Foldable(foldMap))
+import Data.Traversable (Traversable(traverse))
+#if __GLASGOW_HASKELL__ >= 702
+import GHC.Generics
+#endif
+
+infixr 9 `Compose`
+
+-- | Right-to-left composition of functors.
+-- The composition of applicative functors is always applicative,
+-- but the composition of monads is not always a monad.
+newtype Compose f g a = Compose { getCompose :: f (g a) }
+
+#if __GLASGOW_HASKELL__ >= 702
+deriving instance Generic (Compose f g a)
+
+instance Functor f => Generic1 (Compose f g) where
+    type Rep1 (Compose f g) =
+      D1 MDCompose
+        (C1 MCCompose
+          (S1 MSCompose (f :.: Rec1 g)))
+    from1 (Compose x) = M1 (M1 (M1 (Comp1 (fmap Rec1 x))))
+    to1 (M1 (M1 (M1 x))) = Compose (fmap unRec1 (unComp1 x))
+
+data MDCompose
+data MCCompose
+data MSCompose
+
+instance Datatype MDCompose where
+    datatypeName _ = "Compose"
+    moduleName   _ = "Data.Functor.Compose"
+# if __GLASGOW_HASKELL__ >= 708
+    isNewtype    _ = True
+# endif
+
+instance Constructor MCCompose where
+    conName     _ = "Compose"
+    conIsRecord _ = True
+
+instance Selector MSCompose where
+    selName _ = "getCompose"
+#endif
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Compose
+deriving instance (Data (f (g a)), Typeable f, Typeable g, Typeable a)
+               => Data (Compose (f :: * -> *) (g :: * -> *) (a :: *))
+#endif
+
+-- Instances of lifted Prelude classes
+
+instance (Eq1 f, Eq1 g) => Eq1 (Compose f g) where
+    liftEq eq (Compose x) (Compose y) = liftEq (liftEq eq) x y
+
+instance (Ord1 f, Ord1 g) => Ord1 (Compose f g) where
+    liftCompare comp (Compose x) (Compose y) =
+        liftCompare (liftCompare comp) x y
+
+instance (Read1 f, Read1 g) => Read1 (Compose f g) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "Compose" Compose
+      where
+        rp' = liftReadsPrec rp rl
+        rl' = liftReadList rp rl
+
+instance (Show1 f, Show1 g) => Show1 (Compose f g) where
+    liftShowsPrec sp sl d (Compose x) =
+        showsUnaryWith (liftShowsPrec sp' sl') "Compose" d x
+      where
+        sp' = liftShowsPrec sp sl
+        sl' = liftShowList sp sl
+
+-- Instances of Prelude classes
+
+instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where
+    (==) = eq1
+
+instance (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where
+    compare = compare1
+
+instance (Read1 f, Read1 g, Read a) => Read (Compose f g a) where
+    readsPrec = readsPrec1
+
+instance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where
+    showsPrec = showsPrec1
+
+-- Functor instances
+
+instance (Functor f, Functor g) => Functor (Compose f g) where
+    fmap f (Compose x) = Compose (fmap (fmap f) x)
+
+instance (Foldable f, Foldable g) => Foldable (Compose f g) where
+    foldMap f (Compose t) = foldMap (foldMap f) t
+
+instance (Traversable f, Traversable g) => Traversable (Compose f g) where
+    traverse f (Compose t) = Compose <$> traverse (traverse f) t
+
+instance (Applicative f, Applicative g) => Applicative (Compose f g) where
+    pure x = Compose (pure (pure x))
+    Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)
+
+instance (Alternative f, Applicative g) => Alternative (Compose f g) where
+    empty = Compose empty
+    Compose x <|> Compose y = Compose (x <|> y)
+
+#if MIN_VERSION_base(4,12,0)
+instance (Functor f, Contravariant g) => Contravariant (Compose f g) where
+    contramap f (Compose fga) = Compose (fmap (contramap f) fga)
+#endif

third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Product.hs

@@ -0,0 +1,156 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 706
+{-# LANGUAGE PolyKinds #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE KindSignatures #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Product
+-- Copyright   :  (c) Ross Paterson 2010
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Products, lifted to functors.
+-----------------------------------------------------------------------------
+
+module Data.Functor.Product (
+    Product(..),
+  ) where
+
+import Control.Applicative
+import Control.Monad (MonadPlus(..))
+import Control.Monad.Fix (MonadFix(..))
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
+#if __GLASGOW_HASKELL__ >= 708
+import Data.Data
+#endif
+import Data.Foldable (Foldable(foldMap))
+import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
+import Data.Monoid (mappend)
+import Data.Traversable (Traversable(traverse))
+#if __GLASGOW_HASKELL__ >= 702
+import GHC.Generics
+#endif
+
+-- | Lifted product of functors.
+data Product f g a = Pair (f a) (g a)
+
+#if __GLASGOW_HASKELL__ >= 702
+deriving instance Generic (Product f g a)
+
+instance Generic1 (Product f g) where
+    type Rep1 (Product f g) =
+      D1 MDProduct
+        (C1 MCPair
+          (S1 NoSelector (Rec1 f) :*: S1 NoSelector (Rec1 g)))
+    from1 (Pair f g) = M1 (M1 (M1 (Rec1 f) :*: M1 (Rec1 g)))
+    to1 (M1 (M1 (M1 f :*: M1 g))) = Pair (unRec1 f) (unRec1 g)
+
+data MDProduct
+data MCPair
+
+instance Datatype MDProduct where
+    datatypeName _ = "Product"
+    moduleName   _ = "Data.Functor.Product"
+
+instance Constructor MCPair where
+    conName _ = "Pair"
+#endif
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Product
+deriving instance (Data (f a), Data (g a), Typeable f, Typeable g, Typeable a)
+               => Data (Product (f :: * -> *) (g :: * -> *) (a :: *))
+#endif
+
+instance (Eq1 f, Eq1 g) => Eq1 (Product f g) where
+    liftEq eq (Pair x1 y1) (Pair x2 y2) = liftEq eq x1 x2 && liftEq eq y1 y2
+
+instance (Ord1 f, Ord1 g) => Ord1 (Product f g) where
+    liftCompare comp (Pair x1 y1) (Pair x2 y2) =
+        liftCompare comp x1 x2 `mappend` liftCompare comp y1 y2
+
+instance (Read1 f, Read1 g) => Read1 (Product f g) where
+    liftReadsPrec rp rl = readsData $
+        readsBinaryWith (liftReadsPrec rp rl) (liftReadsPrec rp rl) "Pair" Pair
+
+instance (Show1 f, Show1 g) => Show1 (Product f g) where
+    liftShowsPrec sp sl d (Pair x y) =
+        showsBinaryWith (liftShowsPrec sp sl) (liftShowsPrec sp sl) "Pair" d x y
+
+instance (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a)
+    where (==) = eq1
+instance (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where
+    compare = compare1
+instance (Read1 f, Read1 g, Read a) => Read (Product f g a) where
+    readsPrec = readsPrec1
+instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where
+    showsPrec = showsPrec1
+
+instance (Functor f, Functor g) => Functor (Product f g) where
+    fmap f (Pair x y) = Pair (fmap f x) (fmap f y)
+
+instance (Foldable f, Foldable g) => Foldable (Product f g) where
+    foldMap f (Pair x y) = foldMap f x `mappend` foldMap f y
+
+instance (Traversable f, Traversable g) => Traversable (Product f g) where
+    traverse f (Pair x y) = Pair <$> traverse f x <*> traverse f y
+
+instance (Applicative f, Applicative g) => Applicative (Product f g) where
+    pure x = Pair (pure x) (pure x)
+    Pair f g <*> Pair x y = Pair (f <*> x) (g <*> y)
+
+instance (Alternative f, Alternative g) => Alternative (Product f g) where
+    empty = Pair empty empty
+    Pair x1 y1 <|> Pair x2 y2 = Pair (x1 <|> x2) (y1 <|> y2)
+
+instance (Monad f, Monad g) => Monad (Product f g) where
+#if !(MIN_VERSION_base(4,8,0))
+    return x = Pair (return x) (return x)
+#endif
+    Pair m n >>= f = Pair (m >>= fstP . f) (n >>= sndP . f)
+      where
+        fstP (Pair a _) = a
+        sndP (Pair _ b) = b
+
+instance (MonadPlus f, MonadPlus g) => MonadPlus (Product f g) where
+    mzero = Pair mzero mzero
+    Pair x1 y1 `mplus` Pair x2 y2 = Pair (x1 `mplus` x2) (y1 `mplus` y2)
+
+instance (MonadFix f, MonadFix g) => MonadFix (Product f g) where
+    mfix f = Pair (mfix (fstP . f)) (mfix (sndP . f))
+      where
+        fstP (Pair a _) = a
+        sndP (Pair _ b) = b
+
+#if MIN_VERSION_base(4,4,0)
+instance (MonadZip f, MonadZip g) => MonadZip (Product f g) where
+    mzipWith f (Pair x1 y1) (Pair x2 y2) = Pair (mzipWith f x1 x2) (mzipWith f y1 y2)
+#endif
+
+#if MIN_VERSION_base(4,12,0)
+instance (Contravariant f, Contravariant g) => Contravariant (Product f g) where
+    contramap f (Pair a b) = Pair (contramap f a) (contramap f b)
+#endif

third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Sum.hs

@@ -0,0 +1,136 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 706
+{-# LANGUAGE PolyKinds #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE KindSignatures #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Sum
+-- Copyright   :  (c) Ross Paterson 2014
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Sums, lifted to functors.
+-----------------------------------------------------------------------------
+
+module Data.Functor.Sum (
+    Sum(..),
+  ) where
+
+import Control.Applicative
+#if __GLASGOW_HASKELL__ >= 708
+import Data.Data
+#endif
+import Data.Foldable (Foldable(foldMap))
+import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
+import Data.Monoid (mappend)
+import Data.Traversable (Traversable(traverse))
+#if __GLASGOW_HASKELL__ >= 702
+import GHC.Generics
+#endif
+
+-- | Lifted sum of functors.
+data Sum f g a = InL (f a) | InR (g a)
+
+#if __GLASGOW_HASKELL__ >= 702
+deriving instance Generic (Sum f g a)
+
+instance Generic1 (Sum f g) where
+    type Rep1 (Sum f g) =
+      D1 MDSum (C1 MCInL (S1 NoSelector (Rec1 f))
+            :+: C1 MCInR (S1 NoSelector (Rec1 g)))
+    from1 (InL f) = M1 (L1 (M1 (M1 (Rec1 f))))
+    from1 (InR g) = M1 (R1 (M1 (M1 (Rec1 g))))
+    to1 (M1 (L1 (M1 (M1 f)))) = InL (unRec1 f)
+    to1 (M1 (R1 (M1 (M1 g)))) = InR (unRec1 g)
+
+data MDSum
+data MCInL
+data MCInR
+
+instance Datatype MDSum where
+    datatypeName _ = "Sum"
+    moduleName   _ = "Data.Functor.Sum"
+
+instance Constructor MCInL where
+    conName _ = "InL"
+
+instance Constructor MCInR where
+    conName _ = "InR"
+#endif
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Sum
+deriving instance (Data (f a), Data (g a), Typeable f, Typeable g, Typeable a)
+               => Data (Sum (f :: * -> *) (g :: * -> *) (a :: *))
+#endif
+
+instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where
+    liftEq eq (InL x1) (InL x2) = liftEq eq x1 x2
+    liftEq _ (InL _) (InR _) = False
+    liftEq _ (InR _) (InL _) = False
+    liftEq eq (InR y1) (InR y2) = liftEq eq y1 y2
+
+instance (Ord1 f, Ord1 g) => Ord1 (Sum f g) where
+    liftCompare comp (InL x1) (InL x2) = liftCompare comp x1 x2
+    liftCompare _ (InL _) (InR _) = LT
+    liftCompare _ (InR _) (InL _) = GT
+    liftCompare comp (InR y1) (InR y2) = liftCompare comp y1 y2
+
+instance (Read1 f, Read1 g) => Read1 (Sum f g) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp rl) "InL" InL `mappend`
+        readsUnaryWith (liftReadsPrec rp rl) "InR" InR
+
+instance (Show1 f, Show1 g) => Show1 (Sum f g) where
+    liftShowsPrec sp sl d (InL x) =
+        showsUnaryWith (liftShowsPrec sp sl) "InL" d x
+    liftShowsPrec sp sl d (InR y) =
+        showsUnaryWith (liftShowsPrec sp sl) "InR" d y
+
+instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where
+    (==) = eq1
+instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where
+    compare = compare1
+instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where
+    readsPrec = readsPrec1
+instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where
+    showsPrec = showsPrec1
+
+instance (Functor f, Functor g) => Functor (Sum f g) where
+    fmap f (InL x) = InL (fmap f x)
+    fmap f (InR y) = InR (fmap f y)
+
+instance (Foldable f, Foldable g) => Foldable (Sum f g) where
+    foldMap f (InL x) = foldMap f x
+    foldMap f (InR y) = foldMap f y
+
+instance (Traversable f, Traversable g) => Traversable (Sum f g) where
+    traverse f (InL x) = InL <$> traverse f x
+    traverse f (InR y) = InR <$> traverse f y
+
+#if MIN_VERSION_base(4,12,0)
+instance (Contravariant f, Contravariant g) => Contravariant (Sum f g) where
+    contramap f (InL xs) = InL (contramap f xs)
+    contramap f (InR ys) = InR (contramap f ys)
+#endif

third_party/bazel/rules_haskell/examples/transformers/transformers.cabal

@@ -0,0 +1,91 @@
+name:         transformers
+version:      0.5.6.2
+license:      BSD3
+license-file: LICENSE
+author:       Andy Gill, Ross Paterson
+maintainer:   Ross Paterson <R.Paterson@city.ac.uk>
+bug-reports:  http://hub.darcs.net/ross/transformers/issues
+category:     Control
+synopsis:     Concrete functor and monad transformers
+description:
+    A portable library of functor and monad transformers, inspired by
+    the paper
+    .
+    * \"Functional Programming with Overloading and Higher-Order
+    Polymorphism\", by Mark P Jones,
+    in /Advanced School of Functional Programming/, 1995
+    (<http://web.cecs.pdx.edu/~mpj/pubs/springschool.html>).
+    .
+    This package contains:
+    .
+    * the monad transformer class (in "Control.Monad.Trans.Class")
+    .
+    * concrete functor and monad transformers, each with associated
+      operations and functions to lift operations associated with other
+      transformers.
+    .
+    The package can be used on its own in portable Haskell code, in
+    which case operations need to be manually lifted through transformer
+    stacks (see "Control.Monad.Trans.Class" for some examples).
+    Alternatively, it can be used with the non-portable monad classes in
+    the @mtl@ or @monads-tf@ packages, which automatically lift operations
+    introduced by monad transformers through other transformers.
+build-type: Simple
+extra-source-files:
+    changelog
+cabal-version: >= 1.6
+
+source-repository head
+  type: darcs
+  location: http://hub.darcs.net/ross/transformers
+
+library
+  build-depends: base >= 2 && < 6
+  hs-source-dirs: .
+  if !impl(ghc>=7.9)
+    -- Data.Functor.Identity was moved into base-4.8.0.0 (GHC 7.10)
+    -- see also https://ghc.haskell.org/trac/ghc/ticket/9664
+    -- NB: using impl(ghc>=7.9) instead of fragile Cabal flags
+    hs-source-dirs: legacy/pre709
+    exposed-modules: Data.Functor.Identity
+  if !impl(ghc>=7.11)
+    -- modules moved into base-4.9.0 (GHC 8.0)
+    -- see https://ghc.haskell.org/trac/ghc/ticket/10773
+    -- see https://ghc.haskell.org/trac/ghc/ticket/11135
+    hs-source-dirs: legacy/pre711
+    exposed-modules:
+      Control.Monad.IO.Class
+      Data.Functor.Classes
+      Data.Functor.Compose
+      Data.Functor.Product
+      Data.Functor.Sum
+  if impl(ghc>=7.2 && <7.5)
+    -- Prior to GHC 7.5, GHC.Generics lived in ghc-prim
+    build-depends: ghc-prim
+  exposed-modules:
+    Control.Applicative.Backwards
+    Control.Applicative.Lift
+    Control.Monad.Signatures
+    Control.Monad.Trans.Accum
+    Control.Monad.Trans.Class
+    Control.Monad.Trans.Cont
+    Control.Monad.Trans.Except
+    Control.Monad.Trans.Error
+    Control.Monad.Trans.Identity
+    Control.Monad.Trans.List
+    Control.Monad.Trans.Maybe
+    Control.Monad.Trans.Reader
+    Control.Monad.Trans.RWS
+    Control.Monad.Trans.RWS.CPS
+    Control.Monad.Trans.RWS.Lazy
+    Control.Monad.Trans.RWS.Strict
+    Control.Monad.Trans.Select
+    Control.Monad.Trans.State
+    Control.Monad.Trans.State.Lazy
+    Control.Monad.Trans.State.Strict
+    Control.Monad.Trans.Writer
+    Control.Monad.Trans.Writer.CPS
+    Control.Monad.Trans.Writer.Lazy
+    Control.Monad.Trans.Writer.Strict
+    Data.Functor.Constant
+    Data.Functor.Reverse