about summary refs log tree commit diff
path: root/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Error.hs
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Error.hs')
-rw-r--r--third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Error.hs333
1 files changed, 0 insertions, 333 deletions
diff --git a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Error.hs b/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Error.hs
deleted file mode 100644
index 6eda4b3e01..0000000000
--- a/third_party/bazel/rules_haskell/examples/transformers/Control/Monad/Trans/Error.hs
+++ /dev/null
@@ -1,333 +0,0 @@
-{-# 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)))
-
--}