1 files changed, 188 insertions, 0 deletions
diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Identity.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Identity.hs
new file mode 100644
index 0000000000..2a0db5e5a1
--- /dev/null
+++ b/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 #-}