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