errors-2.3.0/0000755000000000000000000000000013275340471011224 5ustar0000000000000000errors-2.3.0/Setup.hs0000644000000000000000000000005613275340471012661 0ustar0000000000000000import Distribution.Simple main = defaultMain errors-2.3.0/LICENSE0000644000000000000000000000276613275340471012244 0ustar0000000000000000Copyright (c) 2012, 2013, Gabriel Gonzalez 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 the name of Gabriel Gonzalez nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT OWNER OR 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. errors-2.3.0/CHANGELOG.md0000644000000000000000000000441313275340471013037 0ustar0000000000000000# 2.3.0 * BREAKING CHANGE: `syncIO` now expects a `MonadIO` constraint instead of `UnexceptionalIO` * `syncIO` also changes how it detects asynchronous exceptions. It now decides based on whether or not an exception inherits from `SomeAsyncException` * See: https://github.com/Gabriel439/Haskell-Errors-Library/pull/53 # 2.2.5 * Increase upper bound on `exceptions` # 2.2.4 * Increase upper bound on `exceptions` # 2.2.3 * Increase upper bound on `transformers-compat` # 2.2.2 * Support GHC 8.4 through compatibility with Semigroup/Monoid proposal # 2.2.1 * Add precedence and fixity for `(?:)` # 2.2.0 * BREAKING CHANGE: Use `Text` instead of `String` * Add `handleExceptT` # 2.1.3 * Support older versions of `ghc` # 2.1.2 * Increase upper bound on `transformers` dependency # 2.1.1 * Increase upper bound on `transformers-compat` # 2.1.0 * Change `syncio` to use `unexceptionalio` to prove that all synchronous exceptions were caught and handled # 2.0.0 * Switch from `EitherT` to `ExceptT` # 1.4.7 * Increase upper bound on `transformers` from `0.4` to `0.5` # 1.4.6 * Add `bool` * Add `(?:)` * Add `isJustT` * Add `isNothingT` * Add `isLeftT` * Add `isRightT` # 1.4.5 * Increase upper bound on `either` from `4.1` to `5` # 1.4.4 * Add `failWith` * Add `failWithM` # 1.4.3 * Add `AllE` * Add `AnyE` * Increase upper bound on `either` from `3.5` to `4.1` # 1.4.2 * Add `(??)` * Add `(!?)` * Add `syncIO` # 1.4.1 * Re-export `EitherT` * Re-export `MaybeT` # 1.4.0 * Add `maybeT` * Add `just` * Add `nothing` * Add upper bound to `either` * Add upper bound to `safe` * Add upper bound to `transformers` # 1.3.1 * Increase lower bound on `transformers` from `0.2` to `0.3.0.0` # 1.3.0 * Add `assertMay` * Add `rightMay` * Add `justErr` * Add `tryJust` * Add `tryRight` * Add `MonadPlus` functions to `Control.Error.Safe` * Add `isLeft` * Add `isRight` * Add `fmapR` * Add `fmapRT` * Add `err` * Add `errLn` * Add `flipE` * Add `flipET` * Rename `tryIO` to `scriptIO` * Remove `tryMaybe` * Remove `tryEither` * Rename `liftMaybe` to `hoistMaybe` * Rename `liftEither` to `hoistEither` # 1.2.1 * Add lower bound to `either` # 1.2.0 * Remove `right` * Remove `left` # 1.1.1 * Cosmetic changes # 1.1.0 * Add `left` # 1.0.0 * Initial release errors-2.3.0/errors.cabal0000644000000000000000000000253313275340471013527 0ustar0000000000000000Name: errors Version: 2.3.0 Cabal-Version: >=1.8.0.2 Build-Type: Simple Tested-With: GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 License: BSD3 License-File: LICENSE Copyright: 2012, 2013 Gabriel Gonzalez Author: Gabriel Gonzalez Maintainer: Gabriel439@gmail.com Bug-Reports: https://github.com/Gabriel439/Haskell-Errors-Library/issues Synopsis: Simplified error-handling Description: The one-stop shop for all your error-handling needs! Just import "Control.Error". . This library encourages an error-handling style that directly uses the type system, rather than out-of-band exceptions. Category: Control, Error Handling extra-source-files: CHANGELOG.md Source-Repository head Type: git Location: https://github.com/Gabriel439/Haskell-Errors-Library Library Build-Depends: base >= 4.7 && < 5 , exceptions >= 0.6 && < 0.11, text < 1.3 , transformers >= 0.2 && < 0.6 , transformers-compat >= 0.4 && < 0.7 if impl(ghc <= 7.6.3) Build-Depends: safe >= 0.3.3 && < 0.3.10 else Build-Depends: safe >= 0.3.3 && < 0.4 Exposed-Modules: Control.Error, Control.Error.Safe, Control.Error.Script, Control.Error.Util, Data.EitherR errors-2.3.0/Data/0000755000000000000000000000000013275340471012075 5ustar0000000000000000errors-2.3.0/Data/EitherR.hs0000644000000000000000000001375113275340471014002 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| This module provides 'throwEither' and 'catchEither' for 'Either'. These two functions reside here because 'throwEither' and 'catchEither' correspond to 'return' and ('>>=') for the flipped 'Either' monad: 'EitherR'. Additionally, this module defines 'handleE' as the flipped version of 'catchE' for 'ExceptT'. 'throwEither' and 'catchEither' improve upon @MonadError@ because: * 'catchEither' is more general than 'catch' and allows you to change the left value's type * Both are Haskell98 More advanced users can use 'EitherR' and 'ExceptRT' to program in an entirely symmetric \"success monad\" where exceptional results are the norm and successful results terminate the computation. This allows you to chain error-handlers using @do@ notation and pass around exceptional values of varying types until you can finally recover from the error: > runExceptRT $ do > e2 <- ioExceptionHandler e1 > bool <- arithmeticExceptionhandler e2 > when bool $ lift $ putStrLn "DEBUG: Arithmetic handler did something" If any of the above error handlers 'succeed', no other handlers are tried. If you choose not to typefully distinguish between the error and sucess monad, then use 'flipEither' and 'flipET', which swap the type variables without changing the type. -} module Data.EitherR ( -- * EitherR EitherR(..), -- ** Operations in the EitherR monad succeed, -- ** Conversions to the Either monad throwEither, catchEither, handleEither, fmapL, -- ** Flip alternative flipEither, -- * ExceptRT ExceptRT(..), -- ** Operations in the ExceptRT monad succeedT, -- ** Conversions to the ExceptT monad handleE, fmapLT, -- ** Flip alternative flipET, ) where import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>))) import Control.Monad (liftM, ap, MonadPlus(mzero, mplus)) import Control.Monad.Trans.Class (MonadTrans(lift)) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT, throwE, catchE) import Data.Monoid (Monoid(mempty, mappend)) import qualified Control.Monad.Trans.Except {-| If \"@Either e r@\" is the error monad, then \"@EitherR r e@\" is the corresponding success monad, where: * 'return' is 'throwEither'. * ('>>=') is 'catchEither'. * Successful results abort the computation -} newtype EitherR r e = EitherR { runEitherR :: Either e r } instance Functor (EitherR r) where fmap = liftM instance Applicative (EitherR r) where pure = return (<*>) = ap instance Monad (EitherR r) where return e = EitherR (Left e) EitherR m >>= f = case m of Left e -> f e Right r -> EitherR (Right r) instance (Monoid r) => Alternative (EitherR r) where empty = EitherR (Right mempty) e1@(EitherR (Left _)) <|> _ = e1 _ <|> e2@(EitherR (Left _)) = e2 EitherR (Right r1) <|> EitherR (Right r2) = EitherR (Right (mappend r1 r2)) instance (Monoid r) => MonadPlus (EitherR r) where mzero = empty mplus = (<|>) -- | Complete error handling, returning a result succeed :: r -> EitherR r e succeed r = EitherR (return r) -- | 'throwEither' in the error monad corresponds to 'return' in the success monad throwEither :: e -> Either e r throwEither e = runEitherR (return e) -- | 'catchEither' in the error monad corresponds to ('>>=') in the success monad catchEither :: Either a r -> (a -> Either b r) -> Either b r e `catchEither` f = runEitherR $ EitherR e >>= \a -> EitherR (f a) -- | 'catchEither' with the arguments flipped handleEither :: (a -> Either b r) -> Either a r -> Either b r handleEither = flip catchEither -- | Map a function over the 'Left' value of an 'Either' fmapL :: (a -> b) -> Either a r -> Either b r fmapL f = runEitherR . fmap f . EitherR -- | Flip the type variables of 'Either' flipEither :: Either a b -> Either b a flipEither e = case e of Left a -> Right a Right b -> Left b -- | 'EitherR' converted into a monad transformer newtype ExceptRT r m e = ExceptRT { runExceptRT :: ExceptT e m r } instance (Monad m) => Functor (ExceptRT r m) where fmap = liftM instance (Monad m) => Applicative (ExceptRT r m) where pure = return (<*>) = ap instance (Monad m) => Monad (ExceptRT r m) where return e = ExceptRT (throwE e) m >>= f = ExceptRT $ ExceptT $ do x <- runExceptT $ runExceptRT m runExceptT $ runExceptRT $ case x of Left e -> f e Right r -> ExceptRT (return r) instance (Monad m, Monoid r) => Alternative (ExceptRT r m) where empty = ExceptRT $ ExceptT $ return $ Right mempty e1 <|> e2 = ExceptRT $ ExceptT $ do x1 <- runExceptT $ runExceptRT e1 case x1 of Left l -> return (Left l) Right r1 -> do x2 <- runExceptT $ runExceptRT e2 case x2 of Left l -> return (Left l) Right r2 -> return (Right (mappend r1 r2)) instance (Monad m, Monoid r) => MonadPlus (ExceptRT r m) where mzero = empty mplus = (<|>) instance MonadTrans (ExceptRT r) where lift = ExceptRT . ExceptT . liftM Left instance (MonadIO m) => MonadIO (ExceptRT r m) where liftIO = lift . liftIO -- | Complete error handling, returning a result succeedT :: (Monad m) => r -> ExceptRT r m e succeedT r = ExceptRT (return r) -- | 'catchE' with the arguments flipped handleE :: (Monad m) => (a -> ExceptT b m r) -> ExceptT a m r -> ExceptT b m r handleE = flip catchE -- | Map a function over the 'Left' value of an 'ExceptT' #if MIN_VERSION_base(4,8,0) fmapLT :: Functor m => (a -> b) -> ExceptT a m r -> ExceptT b m r fmapLT = Control.Monad.Trans.Except.withExceptT #else fmapLT :: (Monad m) => (a -> b) -> ExceptT a m r -> ExceptT b m r fmapLT f = runExceptRT . fmap f . ExceptRT #endif -- | Flip the type variables of an 'ExceptT' flipET :: (Monad m) => ExceptT a m b -> ExceptT b m a flipET = ExceptT . liftM flipEither . runExceptT errors-2.3.0/Control/0000755000000000000000000000000013275340471012644 5ustar0000000000000000errors-2.3.0/Control/Error.hs0000644000000000000000000000443313275340471014275 0ustar0000000000000000{-| Import this module in your code to access the entire library's functionality: > import Control.Error This module exports the entire library as well as useful exports from other standard error-handling libraries: * "Control.Error.Safe": Generalizes the @safe@ library, including 'Either', 'EitherT', and 'MonadPlus' variations on total functions * "Control.Error.Script": Support for simple scripts that catch all errors and transform them to 'Text' * "Control.Error.Util": Utility functions and conversions between common error-handling types * @Control.Monad.Trans.Except@: The 'ExceptT' monad transformer * @Control.Monad.Trans.Maybe@: The 'MaybeT' monad transformer * @Data.Either@: 'Either' utility functions * "Data.EitherR": throw and catch functions, and their corresponding \"success\" monads * @Data.Maybe@: 'Maybe' utility functions * @Safe@: Total versions of partial Prelude functions This module does not re-export partial functions from other libraries. -} module Control.Error ( -- * Re-exports module Control.Error.Safe, module Control.Error.Script, module Control.Error.Util, module Control.Monad.Trans.Except, module Control.Monad.Trans.Maybe, module Data.Either, module Data.EitherR, module Data.Maybe, module Safe ) where import Control.Error.Safe import Control.Error.Script import Control.Error.Util import Control.Monad.Trans.Except ( ExceptT(ExceptT), runExceptT, throwE, catchE, mapExceptT, withExceptT ) import Control.Monad.Trans.Maybe ( MaybeT(MaybeT), runMaybeT, mapMaybeT, liftCallCC, liftCatch, liftListen, liftPass ) import Data.Either (either, lefts, rights, partitionEithers) import Data.EitherR import Data.Maybe ( maybe, isJust, isNothing, fromMaybe, listToMaybe, maybeToList, catMaybes, mapMaybe ) import Safe ( tailDef, tailMay, tailSafe, initDef, initMay, initSafe, headDef, headMay, lastDef, lastMay, minimumDef, minimumMay, maximumDef, maximumMay, foldr1Def, foldr1May, foldl1Def', foldl1May', fromJustDef, atDef, atMay, readDef, readMay, lookupJustDef, findJustDef ) errors-2.3.0/Control/Error/0000755000000000000000000000000013275340471013735 5ustar0000000000000000errors-2.3.0/Control/Error/Script.hs0000644000000000000000000000336213275340471015541 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-| Use this module if you like to write simple scripts with 'Text'-based errors, but you prefer to use 'ExceptT' to handle errors rather than @Control.Exception@. > import Control.Error > > main = runScript $ do > str <- scriptIO getLine > n <- tryRead "Read failed" str > scriptIO $ print (n + 1) -} module Control.Error.Script ( -- * The Script Monad Script, runScript, scriptIO ) where import Control.Exception (try, SomeException) import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT) import Control.Error.Util (errLn) import Data.EitherR (fmapL) import Data.Monoid ((<>)) import Data.Text (Text) import System.Environment (getProgName) import System.Exit (exitFailure) -- Documentation import Control.Monad.Trans.Class (lift) import System.IO (stderr) import qualified Data.Text -- | An 'IO' action that can fail with a 'Text' error message type Script = ExceptT Text IO {-| Runs the 'Script' monad Prints the first error to 'stderr' and exits with 'exitFailure' -} runScript :: Script a -> IO a runScript s = do e <- runExceptT s case e of Left e -> do let adapt str = Data.Text.pack str <> ": " <> e errLn =<< liftM adapt getProgName exitFailure Right a -> return a {-| 'scriptIO' resembles 'lift', except it catches all exceptions and converts them to 'Text' Note that 'scriptIO' is compatible with the 'Script' monad. -} scriptIO :: (MonadIO m) => IO a -> ExceptT Text m a scriptIO = ExceptT . liftIO . liftM (fmapL (Data.Text.pack . show)) . (try :: IO a -> IO (Either SomeException a)) errors-2.3.0/Control/Error/Safe.hs0000644000000000000000000001656213275340471015161 0ustar0000000000000000{-| This module extends the @safe@ library's functions with corresponding versions compatible with 'Either' and 'ExceptT', and also provides a few 'Maybe'-compatible functions missing from @safe@. I suffix the 'Either'-compatible functions with @Err@ and prefix the 'ExceptT'-compatible functions with @try@. Note that this library re-exports the 'Maybe' compatible functions from @safe@ in the "Control.Error" module, so they are not provided here. The \'@Z@\'-suffixed functions generalize the 'Maybe' functions to also work with anything that implements 'MonadPlus', including: * Lists * Most parsers * 'ExceptT' (if the left value is a 'Monoid') -} module Control.Error.Safe ( -- * Maybe-compatible functions assertMay, rightMay, -- * Either-compatible functions tailErr, initErr, headErr, lastErr, minimumErr, maximumErr, foldr1Err, foldl1Err, foldl1Err', atErr, readErr, assertErr, justErr, -- * ExceptT-compatible functions tryTail, tryInit, tryHead, tryLast, tryMinimum, tryMaximum, tryFoldr1, tryFoldl1, tryFoldl1', tryAt, tryRead, tryAssert, tryJust, tryRight, -- * MonadPlus-compatible functions tailZ, initZ, headZ, lastZ, minimumZ, maximumZ, foldr1Z, foldl1Z, foldl1Z', atZ, readZ, assertZ, justZ, rightZ ) where import Control.Error.Util (note, hoistEither) import Control.Monad (MonadPlus(mzero)) import Control.Monad.Trans.Except (ExceptT) import qualified Safe as S -- | An assertion that fails in the 'Maybe' monad assertMay :: Bool -> Maybe () assertMay = assertZ -- | A 'fromRight' that fails in the 'Maybe' monad rightMay :: Either e a -> Maybe a rightMay = rightZ -- | A 'tail' that fails in the 'Either' monad tailErr :: e -> [a] -> Either e [a] tailErr e = note e . S.tailMay -- | An 'init' that fails in the 'Either' monad initErr :: e -> [a] -> Either e [a] initErr e = note e . S.initMay -- | A 'head' that fails in the 'Either' monad headErr :: e -> [a] -> Either e a headErr e = note e . S.headMay -- | A 'last' that fails in the 'Either' monad lastErr :: e -> [a] -> Either e a lastErr e = note e . S.lastMay -- | A 'minimum' that fails in the 'Either' monad minimumErr :: (Ord a) => e -> [a] -> Either e a minimumErr e = note e . S.minimumMay -- | A 'maximum' that fails in the 'Either' monad maximumErr :: (Ord a) => e -> [a] -> Either e a maximumErr e = note e . S.maximumMay -- | A 'foldr1' that fails in the 'Either' monad foldr1Err :: e -> (a -> a -> a) -> [a] -> Either e a foldr1Err e step xs = note e $ S.foldr1May step xs -- | A 'foldl1' that fails in the 'Either' monad foldl1Err :: e -> (a -> a -> a) -> [a] -> Either e a foldl1Err e step xs = note e $ S.foldl1May step xs -- | A 'foldl1'' that fails in the 'Either' monad foldl1Err' :: e -> (a -> a -> a) -> [a] -> Either e a foldl1Err' e step xs = note e $ S.foldl1May' step xs -- | A ('!!') that fails in the 'Either' monad atErr :: e -> [a] -> Int -> Either e a atErr e xs n = note e $ S.atMay xs n -- | A 'read' that fails in the 'Either' monad readErr :: (Read a) => e -> String -> Either e a readErr e = note e . S.readMay -- | An assertion that fails in the 'Either' monad assertErr :: e -> Bool -> Either e () assertErr e p = if p then Right () else Left e -- | A 'fromJust' that fails in the 'Either' monad justErr :: e -> Maybe a -> Either e a justErr e = maybe (Left e) Right -- | A 'tail' that fails in the 'ExceptT' monad tryTail :: (Monad m) => e -> [a] -> ExceptT e m [a] tryTail e xs = hoistEither $ tailErr e xs -- | An 'init' that fails in the 'ExceptT' monad tryInit :: (Monad m) => e -> [a] -> ExceptT e m [a] tryInit e xs = hoistEither $ initErr e xs -- | A 'head' that fails in the 'ExceptT' monad tryHead :: (Monad m) => e -> [a] -> ExceptT e m a tryHead e xs = hoistEither $ headErr e xs -- | A 'last' that fails in the 'ExceptT' monad tryLast :: (Monad m) => e -> [a] -> ExceptT e m a tryLast e xs = hoistEither $ lastErr e xs -- | A 'minimum' that fails in the 'ExceptT' monad tryMinimum :: (Monad m, Ord a) => e -> [a] -> ExceptT e m a tryMinimum e xs = hoistEither $ maximumErr e xs -- | A 'maximum' that fails in the 'ExceptT' monad tryMaximum :: (Monad m, Ord a) => e -> [a] -> ExceptT e m a tryMaximum e xs = hoistEither $ maximumErr e xs -- | A 'foldr1' that fails in the 'ExceptT' monad tryFoldr1 :: (Monad m) => e -> (a -> a -> a) -> [a] -> ExceptT e m a tryFoldr1 e step xs = hoistEither $ foldr1Err e step xs -- | A 'foldl1' that fails in the 'ExceptT' monad tryFoldl1 :: (Monad m) => e -> (a -> a -> a) -> [a] -> ExceptT e m a tryFoldl1 e step xs = hoistEither $ foldl1Err e step xs -- | A 'foldl1'' that fails in the 'ExceptT' monad tryFoldl1' :: (Monad m) => e -> (a -> a -> a) -> [a] -> ExceptT e m a tryFoldl1' e step xs = hoistEither $ foldl1Err' e step xs -- | A ('!!') that fails in the 'ExceptT' monad tryAt :: (Monad m) => e -> [a] -> Int -> ExceptT e m a tryAt e xs n = hoistEither $ atErr e xs n -- | A 'read' that fails in the 'ExceptT' monad tryRead :: (Monad m, Read a) => e -> String -> ExceptT e m a tryRead e str = hoistEither $ readErr e str -- | An assertion that fails in the 'ExceptT' monad tryAssert :: (Monad m) => e -> Bool -> ExceptT e m () tryAssert e p = hoistEither $ assertErr e p -- | A 'fromJust' that fails in the 'ExceptT' monad tryJust :: (Monad m) => e -> Maybe a -> ExceptT e m a tryJust e m = hoistEither $ justErr e m -- | A 'fromRight' that fails in the 'ExceptT' monad tryRight :: (Monad m) => Either e a -> ExceptT e m a tryRight = hoistEither -- | A 'tail' that fails using 'mzero' tailZ :: (MonadPlus m) => [a] -> m [a] tailZ = maybe mzero return . S.tailMay -- | An 'init' that fails using 'mzero' initZ :: (MonadPlus m) => [a] -> m [a] initZ = maybe mzero return . S.initMay -- | A 'head' that fails using 'mzero' headZ :: (MonadPlus m) => [a] -> m a headZ = maybe mzero return . S.headMay -- | A 'last' that fails using 'mzero' lastZ :: (MonadPlus m) => [a] -> m a lastZ = maybe mzero return . S.lastMay -- | A 'minimum' that fails using 'mzero' minimumZ :: (MonadPlus m) => (Ord a) => [a] -> m a minimumZ = maybe mzero return . S.minimumMay -- | A 'maximum' that fails using 'mzero' maximumZ :: (MonadPlus m) => (Ord a) => [a] -> m a maximumZ = maybe mzero return . S.maximumMay -- | A 'foldr1' that fails using 'mzero' foldr1Z :: (MonadPlus m) => (a -> a -> a) -> [a] -> m a foldr1Z step xs = maybe mzero return $ S.foldr1May step xs -- | A 'foldl1' that fails using 'mzero' foldl1Z :: (MonadPlus m) => (a -> a -> a) -> [a] -> m a foldl1Z step xs = maybe mzero return $ S.foldl1May step xs -- | A 'foldl1'' that fails using 'mzero' foldl1Z' :: (MonadPlus m) => (a -> a -> a) -> [a] -> m a foldl1Z' step xs = maybe mzero return $ S.foldl1May' step xs -- | A ('!!') that fails using 'mzero' atZ :: (MonadPlus m) => [a] -> Int -> m a atZ xs n = maybe mzero return $ S.atMay xs n -- | A 'read' that fails using 'mzero' readZ :: (MonadPlus m) => (Read a) => String -> m a readZ = maybe mzero return . S.readMay -- | An assertion that fails using 'mzero' assertZ :: (MonadPlus m) => Bool -> m () assertZ p = if p then return () else mzero -- | A 'fromJust' that fails using 'mzero' justZ :: (MonadPlus m) => Maybe a -> m a justZ = maybe mzero return -- | A 'fromRight' that fails using 'mzero' rightZ :: (MonadPlus m) => Either e a -> m a rightZ = either (const mzero) return errors-2.3.0/Control/Error/Util.hs0000644000000000000000000002042013275340471015204 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | This module exports miscellaneous error-handling functions. module Control.Error.Util ( -- * Conversion -- $conversion hush, hushT, note, noteT, hoistMaybe, hoistEither, (??), (!?), failWith, failWithM, -- * Bool bool, -- * Maybe (?:), -- * MaybeT maybeT, just, nothing, isJustT, isNothingT, -- * Either isLeft, isRight, fmapR, AllE(..), AnyE(..), -- * ExceptT isLeftT, isRightT, fmapRT, exceptT, bimapExceptT, -- * Error Reporting err, errLn, -- * Exceptions tryIO, handleExceptT, syncIO ) where import Control.Applicative (Applicative, pure, (<$>)) import Control.Exception (IOException, SomeException, Exception) import Control.Monad (liftM) import Control.Monad.Catch (MonadCatch, try) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT) import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT) import Data.Monoid (Monoid(mempty, mappend)) #if MIN_VERSION_base(4,9,0) import Data.Semigroup #endif import Data.Maybe (fromMaybe) import Data.Text (Text) import System.IO (stderr) import qualified Control.Exception as Exception import qualified Data.Text.IO -- | Fold an 'ExceptT' by providing one continuation for each constructor exceptT :: Monad m => (a -> m c) -> (b -> m c) -> ExceptT a m b -> m c exceptT f g (ExceptT m) = m >>= \z -> case z of Left a -> f a Right b -> g b {-# INLINEABLE exceptT #-} -- | Transform the left and right value bimapExceptT :: Functor m => (e -> f) -> (a -> b) -> ExceptT e m a -> ExceptT f m b bimapExceptT f g (ExceptT m) = ExceptT (fmap h m) where h (Left e) = Left (f e) h (Right a) = Right (g a) {-# INLINEABLE bimapExceptT #-} -- | Upgrade an 'Either' to an 'ExceptT' hoistEither :: Monad m => Either e a -> ExceptT e m a hoistEither = ExceptT . return {-# INLINEABLE hoistEither #-} {- $conversion Use these functions to convert between 'Maybe', 'Either', 'MaybeT', and 'ExceptT'. -} -- | Suppress the 'Left' value of an 'Either' hush :: Either a b -> Maybe b hush = either (const Nothing) Just -- | Suppress the 'Left' value of an 'ExceptT' hushT :: (Monad m) => ExceptT a m b -> MaybeT m b hushT = MaybeT . liftM hush . runExceptT -- | Tag the 'Nothing' value of a 'Maybe' note :: a -> Maybe b -> Either a b note a = maybe (Left a) Right -- | Tag the 'Nothing' value of a 'MaybeT' noteT :: (Monad m) => a -> MaybeT m b -> ExceptT a m b noteT a = ExceptT . liftM (note a) . runMaybeT -- | Lift a 'Maybe' to the 'MaybeT' monad hoistMaybe :: (Monad m) => Maybe b -> MaybeT m b hoistMaybe = MaybeT . return -- | Convert a 'Maybe' value into the 'ExceptT' monad (??) :: Applicative m => Maybe a -> e -> ExceptT e m a (??) a e = ExceptT (pure $ note e a) -- | Convert an applicative 'Maybe' value into the 'ExceptT' monad (!?) :: Applicative m => m (Maybe a) -> e -> ExceptT e m a (!?) a e = ExceptT (note e <$> a) -- | An infix form of 'fromMaybe' with arguments flipped. (?:) :: Maybe a -> a -> a maybeA ?: b = fromMaybe b maybeA {-# INLINABLE (?:) #-} infixr 0 ?: {-| Convert a 'Maybe' value into the 'ExceptT' monad Named version of ('??') with arguments flipped -} failWith :: Applicative m => e -> Maybe a -> ExceptT e m a failWith e a = a ?? e {- | Convert an applicative 'Maybe' value into the 'ExceptT' monad Named version of ('!?') with arguments flipped -} failWithM :: Applicative m => e -> m (Maybe a) -> ExceptT e m a failWithM e a = a !? e {- | Case analysis for the 'Bool' type. > bool a b c == if c then b else a -} bool :: a -> a -> Bool -> a bool a b = \c -> if c then b else a {-# INLINABLE bool #-} {-| Case analysis for 'MaybeT' Use the first argument if the 'MaybeT' computation fails, otherwise apply the function to the successful result. -} maybeT :: Monad m => m b -> (a -> m b) -> MaybeT m a -> m b maybeT mb kb (MaybeT ma) = ma >>= maybe mb kb -- | Analogous to 'Just' and equivalent to 'return' just :: (Monad m) => a -> MaybeT m a just a = MaybeT (return (Just a)) -- | Analogous to 'Nothing' and equivalent to 'mzero' nothing :: (Monad m) => MaybeT m a nothing = MaybeT (return Nothing) -- | Analogous to 'Data.Maybe.isJust', but for 'MaybeT' isJustT :: (Monad m) => MaybeT m a -> m Bool isJustT = maybeT (return False) (\_ -> return True) {-# INLINABLE isJustT #-} -- | Analogous to 'Data.Maybe.isNothing', but for 'MaybeT' isNothingT :: (Monad m) => MaybeT m a -> m Bool isNothingT = maybeT (return True) (\_ -> return False) {-# INLINABLE isNothingT #-} -- | Returns whether argument is a 'Left' isLeft :: Either a b -> Bool isLeft = either (const True) (const False) -- | Returns whether argument is a 'Right' isRight :: Either a b -> Bool isRight = either (const False) (const True) {- | 'fmap' specialized to 'Either', given a name symmetric to 'Data.EitherR.fmapL' -} fmapR :: (a -> b) -> Either l a -> Either l b fmapR = fmap {-| Run multiple 'Either' computations and succeed if all of them succeed 'mappend's all successes or failures -} newtype AllE e r = AllE { runAllE :: Either e r } #if MIN_VERSION_base(4,9,0) instance (Semigroup e, Semigroup r) => Semigroup (AllE e r) where AllE (Right x) <> AllE (Right y) = AllE (Right (x <> y)) AllE (Right _) <> AllE (Left y) = AllE (Left y) AllE (Left x) <> AllE (Right _) = AllE (Left x) AllE (Left x) <> AllE (Left y) = AllE (Left (x <> y)) #endif instance (Monoid e, Monoid r) => Monoid (AllE e r) where mempty = AllE (Right mempty) #if !(MIN_VERSION_base(4,11,0)) mappend (AllE (Right x)) (AllE (Right y)) = AllE (Right (mappend x y)) mappend (AllE (Right _)) (AllE (Left y)) = AllE (Left y) mappend (AllE (Left x)) (AllE (Right _)) = AllE (Left x) mappend (AllE (Left x)) (AllE (Left y)) = AllE (Left (mappend x y)) #endif {-| Run multiple 'Either' computations and succeed if any of them succeed 'mappend's all successes or failures -} newtype AnyE e r = AnyE { runAnyE :: Either e r } #if MIN_VERSION_base(4,9,0) instance (Semigroup e, Semigroup r) => Semigroup (AnyE e r) where AnyE (Right x) <> AnyE (Right y) = AnyE (Right (x <> y)) AnyE (Right x) <> AnyE (Left _) = AnyE (Right x) AnyE (Left _) <> AnyE (Right y) = AnyE (Right y) AnyE (Left x) <> AnyE (Left y) = AnyE (Left (x <> y)) #endif instance (Monoid e, Monoid r) => Monoid (AnyE e r) where mempty = AnyE (Right mempty) #if !(MIN_VERSION_base(4,11,0)) mappend (AnyE (Right x)) (AnyE (Right y)) = AnyE (Right (mappend x y)) mappend (AnyE (Right x)) (AnyE (Left _)) = AnyE (Right x) mappend (AnyE (Left _)) (AnyE (Right y)) = AnyE (Right y) mappend (AnyE (Left x)) (AnyE (Left y)) = AnyE (Left (mappend x y)) #endif -- | Analogous to 'isLeft', but for 'ExceptT' isLeftT :: (Monad m) => ExceptT a m b -> m Bool isLeftT = exceptT (\_ -> return True) (\_ -> return False) {-# INLINABLE isLeftT #-} -- | Analogous to 'isRight', but for 'ExceptT' isRightT :: (Monad m) => ExceptT a m b -> m Bool isRightT = exceptT (\_ -> return False) (\_ -> return True) {-# INLINABLE isRightT #-} {- | 'fmap' specialized to 'ExceptT', given a name symmetric to 'Data.EitherR.fmapLT' -} fmapRT :: (Monad m) => (a -> b) -> ExceptT l m a -> ExceptT l m b fmapRT = liftM -- | Write a string to standard error err :: Text -> IO () err = Data.Text.IO.hPutStr stderr -- | Write a string with a newline to standard error errLn :: Text -> IO () errLn = Data.Text.IO.hPutStrLn stderr -- | Catch 'IOException's and convert them to the 'ExceptT' monad tryIO :: MonadIO m => IO a -> ExceptT IOException m a tryIO = ExceptT . liftIO . Exception.try -- | Run a monad action which may throw an exception in the `ExceptT` monad handleExceptT :: (Exception e, Functor m, MonadCatch m) => (e -> x) -> m a -> ExceptT x m a handleExceptT handler = bimapExceptT handler id . ExceptT . try {-| Catch all exceptions, except for asynchronous exceptions found in @base@ and convert them to the 'ExceptT' monad -} syncIO :: MonadIO m => IO a -> ExceptT SomeException m a syncIO = ExceptT . liftIO . trySync trySync :: IO a -> IO (Either SomeException a) trySync io = (fmap Right io) `Exception.catch` \e -> case Exception.fromException e of Just (Exception.SomeAsyncException _) -> Exception.throwIO e Nothing -> return (Left e)