diff --git a/Control/Error.hs b/Control/Error.hs --- a/Control/Error.hs +++ b/Control/Error.hs @@ -1,101 +1,103 @@ -{-| 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 'String's - - * "Control.Error.Util": Utility functions and conversions between common - error-handling types - - * @Control.Monad.Trans.Either@: The 'EitherT' 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.Either, - 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.Either ( - EitherT(EitherT, runEitherT), - eitherT, - bimapEitherT, - mapEitherT, - hoistEither, - left, - right ) -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 ) +{-| 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 'String's + + * "Control.Error.Util": Utility functions and conversions between common + error-handling types + + * @Control.Monad.Trans.Either@: The 'EitherT' 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.Either, + 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.Either ( + EitherT(EitherT), + runEitherT, + eitherT, + bimapEitherT, + mapEitherT, + hoistEither, + left, + right ) +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 ) diff --git a/Control/Error/Safe.hs b/Control/Error/Safe.hs --- a/Control/Error/Safe.hs +++ b/Control/Error/Safe.hs @@ -1,249 +1,249 @@ -{-| This module extends the @safe@ library's functions with corresponding - versions compatible with 'Either' and 'EitherT', and also provides a few - 'Maybe'-compatible functions missing from @safe@. - - I suffix the 'Either'-compatible functions with @Err@ and prefix the - 'EitherT'-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 - - * 'EitherT' (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, - - -- * EitherT-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) -import Control.Monad (MonadPlus(mzero)) -import Control.Monad.Trans.Either (EitherT, hoistEither) -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 'EitherT' monad -tryTail :: (Monad m) => e -> [a] -> EitherT e m [a] -tryTail e xs = hoistEither $ tailErr e xs - --- | An 'init' that fails in the 'EitherT' monad -tryInit :: (Monad m) => e -> [a] -> EitherT e m [a] -tryInit e xs = hoistEither $ initErr e xs - --- | A 'head' that fails in the 'EitherT' monad -tryHead :: (Monad m) => e -> [a] -> EitherT e m a -tryHead e xs = hoistEither $ headErr e xs - --- | A 'last' that fails in the 'EitherT' monad -tryLast :: (Monad m) => e -> [a] -> EitherT e m a -tryLast e xs = hoistEither $ lastErr e xs - --- | A 'minimum' that fails in the 'EitherT' monad -tryMinimum :: (Monad m, Ord a) => e -> [a] -> EitherT e m a -tryMinimum e xs = hoistEither $ maximumErr e xs - --- | A 'maximum' that fails in the 'EitherT' monad -tryMaximum :: (Monad m, Ord a) => e -> [a] -> EitherT e m a -tryMaximum e xs = hoistEither $ maximumErr e xs - --- | A 'foldr1' that fails in the 'EitherT' monad -tryFoldr1 :: (Monad m) => e -> (a -> a -> a) -> [a] -> EitherT e m a -tryFoldr1 e step xs = hoistEither $ foldr1Err e step xs - --- | A 'foldl1' that fails in the 'EitherT' monad -tryFoldl1 :: (Monad m) => e -> (a -> a -> a) -> [a] -> EitherT e m a -tryFoldl1 e step xs = hoistEither $ foldl1Err e step xs - --- | A 'foldl1'' that fails in the 'EitherT' monad -tryFoldl1' :: (Monad m) => e -> (a -> a -> a) -> [a] -> EitherT e m a -tryFoldl1' e step xs = hoistEither $ foldl1Err' e step xs - --- | A ('!!') that fails in the 'EitherT' monad -tryAt :: (Monad m) => e -> [a] -> Int -> EitherT e m a -tryAt e xs n = hoistEither $ atErr e xs n - --- | A 'read' that fails in the 'EitherT' monad -tryRead :: (Monad m, Read a) => e -> String -> EitherT e m a -tryRead e str = hoistEither $ readErr e str - --- | An assertion that fails in the 'EitherT' monad -tryAssert :: (Monad m) => e -> Bool -> EitherT e m () -tryAssert e p = hoistEither $ assertErr e p - --- | A 'fromJust' that fails in the 'EitherT' monad -tryJust :: (Monad m) => e -> Maybe a -> EitherT e m a -tryJust e m = hoistEither $ justErr e m - --- | A 'fromRight' that fails in the 'EitherT' monad -tryRight :: (Monad m) => Either e a -> EitherT 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 +{-| This module extends the @safe@ library's functions with corresponding + versions compatible with 'Either' and 'EitherT', and also provides a few + 'Maybe'-compatible functions missing from @safe@. + + I suffix the 'Either'-compatible functions with @Err@ and prefix the + 'EitherT'-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 + + * 'EitherT' (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, + + -- * EitherT-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) +import Control.Monad (MonadPlus(mzero)) +import Control.Monad.Trans.Either (EitherT, hoistEither) +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 'EitherT' monad +tryTail :: (Monad m) => e -> [a] -> EitherT e m [a] +tryTail e xs = hoistEither $ tailErr e xs + +-- | An 'init' that fails in the 'EitherT' monad +tryInit :: (Monad m) => e -> [a] -> EitherT e m [a] +tryInit e xs = hoistEither $ initErr e xs + +-- | A 'head' that fails in the 'EitherT' monad +tryHead :: (Monad m) => e -> [a] -> EitherT e m a +tryHead e xs = hoistEither $ headErr e xs + +-- | A 'last' that fails in the 'EitherT' monad +tryLast :: (Monad m) => e -> [a] -> EitherT e m a +tryLast e xs = hoistEither $ lastErr e xs + +-- | A 'minimum' that fails in the 'EitherT' monad +tryMinimum :: (Monad m, Ord a) => e -> [a] -> EitherT e m a +tryMinimum e xs = hoistEither $ maximumErr e xs + +-- | A 'maximum' that fails in the 'EitherT' monad +tryMaximum :: (Monad m, Ord a) => e -> [a] -> EitherT e m a +tryMaximum e xs = hoistEither $ maximumErr e xs + +-- | A 'foldr1' that fails in the 'EitherT' monad +tryFoldr1 :: (Monad m) => e -> (a -> a -> a) -> [a] -> EitherT e m a +tryFoldr1 e step xs = hoistEither $ foldr1Err e step xs + +-- | A 'foldl1' that fails in the 'EitherT' monad +tryFoldl1 :: (Monad m) => e -> (a -> a -> a) -> [a] -> EitherT e m a +tryFoldl1 e step xs = hoistEither $ foldl1Err e step xs + +-- | A 'foldl1'' that fails in the 'EitherT' monad +tryFoldl1' :: (Monad m) => e -> (a -> a -> a) -> [a] -> EitherT e m a +tryFoldl1' e step xs = hoistEither $ foldl1Err' e step xs + +-- | A ('!!') that fails in the 'EitherT' monad +tryAt :: (Monad m) => e -> [a] -> Int -> EitherT e m a +tryAt e xs n = hoistEither $ atErr e xs n + +-- | A 'read' that fails in the 'EitherT' monad +tryRead :: (Monad m, Read a) => e -> String -> EitherT e m a +tryRead e str = hoistEither $ readErr e str + +-- | An assertion that fails in the 'EitherT' monad +tryAssert :: (Monad m) => e -> Bool -> EitherT e m () +tryAssert e p = hoistEither $ assertErr e p + +-- | A 'fromJust' that fails in the 'EitherT' monad +tryJust :: (Monad m) => e -> Maybe a -> EitherT e m a +tryJust e m = hoistEither $ justErr e m + +-- | A 'fromRight' that fails in the 'EitherT' monad +tryRight :: (Monad m) => Either e a -> EitherT 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 diff --git a/Control/Error/Script.hs b/Control/Error/Script.hs --- a/Control/Error/Script.hs +++ b/Control/Error/Script.hs @@ -1,58 +1,58 @@ -{-| - Use this module if you like to write simple scripts with 'String'-based - errors, but you prefer to use 'EitherT' 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.Either (EitherT(EitherT, runEitherT)) -import Control.Error.Util (errLn) -import Data.EitherR (fmapL) -import System.Exit (exitFailure) - --- Documentation -import Control.Monad.Trans.Class (lift) -import System.IO (stderr) - --- | An 'IO' action that can fail with a 'String' error message -type Script = EitherT String IO - -{-| Runs the 'Script' monad - - Prints the first error to 'stderr' and exits with 'exitFailure' --} -runScript :: Script a -> IO a -runScript s = do - e <- runEitherT s - case e of - Left e -> do - errLn e - exitFailure - Right a -> return a - -{-| 'scriptIO' resembles 'lift', except it catches all exceptions and converts - them to 'String's. - - Note that 'scriptIO' is compatible with the 'Script' monad. --} -scriptIO :: (MonadIO m) => IO a -> EitherT String m a -scriptIO = EitherT - . liftIO - . liftM (fmapL show) - . (try :: IO a -> IO (Either SomeException a)) +{-| + Use this module if you like to write simple scripts with 'String'-based + errors, but you prefer to use 'EitherT' 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.Either (EitherT(EitherT, runEitherT)) +import Control.Error.Util (errLn) +import Data.EitherR (fmapL) +import System.Exit (exitFailure) + +-- Documentation +import Control.Monad.Trans.Class (lift) +import System.IO (stderr) + +-- | An 'IO' action that can fail with a 'String' error message +type Script = EitherT String IO + +{-| Runs the 'Script' monad + + Prints the first error to 'stderr' and exits with 'exitFailure' +-} +runScript :: Script a -> IO a +runScript s = do + e <- runEitherT s + case e of + Left e -> do + errLn e + exitFailure + Right a -> return a + +{-| 'scriptIO' resembles 'lift', except it catches all exceptions and converts + them to 'String's. + + Note that 'scriptIO' is compatible with the 'Script' monad. +-} +scriptIO :: (MonadIO m) => IO a -> EitherT String m a +scriptIO = EitherT + . liftIO + . liftM (fmapL show) + . (try :: IO a -> IO (Either SomeException a)) diff --git a/Control/Error/Util.hs b/Control/Error/Util.hs --- a/Control/Error/Util.hs +++ b/Control/Error/Util.hs @@ -1,240 +1,240 @@ --- | This module exports miscellaneous error-handling functions. - -module Control.Error.Util ( - -- * Conversion - -- $conversion - hush, - hushT, - note, - noteT, - hoistMaybe, - (??), - (!?), - failWith, - failWithM, - - -- * Bool - bool, - - -- * Maybe - (?:), - - -- * MaybeT - maybeT, - just, - nothing, - isJustT, - isNothingT, - - -- * Either - isLeft, - isRight, - fmapR, - AllE(..), - AnyE(..), - - -- * EitherT - isLeftT, - isRightT, - fmapRT, - - -- * Error Reporting - err, - errLn, - - -- * Exceptions - tryIO, - syncIO - ) where - -import Control.Applicative (Applicative, pure, (<$>)) -import qualified Control.Exception as Ex -import Control.Monad (liftM) -import Control.Monad.IO.Class (MonadIO(liftIO)) -import Control.Monad.Trans.Either (EitherT(EitherT, runEitherT), eitherT) -import Control.Monad.Trans.Maybe (MaybeT(MaybeT, runMaybeT)) -import Data.Dynamic (Dynamic) -import Data.Monoid (Monoid(mempty, mappend)) -import Data.Maybe (fromMaybe) -import System.Exit (ExitCode) -import System.IO (hPutStr, hPutStrLn, stderr) - -{- $conversion - Use these functions to convert between 'Maybe', 'Either', 'MaybeT', and - 'EitherT'. - - Note that 'hoistEither' and 'eitherT' are provided by the @either@ package. --} --- | Suppress the 'Left' value of an 'Either' -hush :: Either a b -> Maybe b -hush = either (const Nothing) Just - --- | Suppress the 'Left' value of an 'EitherT' -hushT :: (Monad m) => EitherT a m b -> MaybeT m b -hushT = MaybeT . liftM hush . runEitherT - --- | 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 -> EitherT a m b -noteT a = EitherT . 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 'EitherT' monad -(??) :: Applicative m => Maybe a -> e -> EitherT e m a -(??) a e = EitherT (pure $ note e a) - --- | Convert an applicative 'Maybe' value into the 'EitherT' monad -(!?) :: Applicative m => m (Maybe a) -> e -> EitherT e m a -(!?) a e = EitherT (note e <$> a) - --- | An infix form of 'fromMaybe' with arguments flipped. -(?:) :: Maybe a -> a -> a -maybeA ?: b = fromMaybe b maybeA -{-# INLINABLE (?:) #-} - -{-| Convert a 'Maybe' value into the 'EitherT' monad - - Named version of ('??') with arguments flipped --} -failWith :: Applicative m => e -> Maybe a -> EitherT e m a -failWith e a = a ?? e - -{- | Convert an applicative 'Maybe' value into the 'EitherT' monad - - Named version of ('!?') with arguments flipped --} -failWithM :: Applicative m => e -> m (Maybe a) -> EitherT 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 } - -instance (Monoid e, Monoid r) => Monoid (AllE e r) where - mempty = AllE (Right mempty) - 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)) - -{-| 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 } - -instance (Monoid e, Monoid r) => Monoid (AnyE e r) where - mempty = AnyE (Right mempty) - 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)) - --- | Analogous to 'isLeft', but for 'EitherT' -isLeftT :: (Monad m) => EitherT a m b -> m Bool -isLeftT = eitherT (\_ -> return True) (\_ -> return False) -{-# INLINABLE isLeftT #-} - --- | Analogous to 'isRight', but for 'EitherT' -isRightT :: (Monad m) => EitherT a m b -> m Bool -isRightT = eitherT (\_ -> return False) (\_ -> return True) -{-# INLINABLE isRightT #-} - -{- | 'fmap' specialized to 'EitherT', given a name symmetric to - 'Data.EitherR.fmapLT' --} -fmapRT :: (Monad m) => (a -> b) -> EitherT l m a -> EitherT l m b -fmapRT = liftM - --- | Write a string to standard error -err :: String -> IO () -err = hPutStr stderr - --- | Write a string with a newline to standard error -errLn :: String -> IO () -errLn = hPutStrLn stderr - --- | Catch 'Ex.IOException's and convert them to the 'EitherT' monad -tryIO :: (MonadIO m) => IO a -> EitherT Ex.IOException m a -tryIO = EitherT . liftIO . Ex.try - -{-| Catch all exceptions, except for asynchronous exceptions found in @base@ - and convert them to the 'EitherT' monad --} -syncIO :: MonadIO m => IO a -> EitherT Ex.SomeException m a -syncIO a = EitherT . liftIO $ Ex.catches (Right <$> a) - [ Ex.Handler $ \e -> Ex.throw (e :: Ex.ArithException) - , Ex.Handler $ \e -> Ex.throw (e :: Ex.ArrayException) - , Ex.Handler $ \e -> Ex.throw (e :: Ex.AssertionFailed) - , Ex.Handler $ \e -> Ex.throw (e :: Ex.AsyncException) - , Ex.Handler $ \e -> Ex.throw (e :: Ex.BlockedIndefinitelyOnMVar) - , Ex.Handler $ \e -> Ex.throw (e :: Ex.BlockedIndefinitelyOnSTM) - , Ex.Handler $ \e -> Ex.throw (e :: Ex.Deadlock) - , Ex.Handler $ \e -> Ex.throw (e :: Dynamic) - , Ex.Handler $ \e -> Ex.throw (e :: Ex.ErrorCall) - , Ex.Handler $ \e -> Ex.throw (e :: ExitCode) - , Ex.Handler $ \e -> Ex.throw (e :: Ex.NestedAtomically) - , Ex.Handler $ \e -> Ex.throw (e :: Ex.NoMethodError) - , Ex.Handler $ \e -> Ex.throw (e :: Ex.NonTermination) - , Ex.Handler $ \e -> Ex.throw (e :: Ex.PatternMatchFail) - , Ex.Handler $ \e -> Ex.throw (e :: Ex.RecConError) - , Ex.Handler $ \e -> Ex.throw (e :: Ex.RecSelError) - , Ex.Handler $ \e -> Ex.throw (e :: Ex.RecUpdError) - , Ex.Handler $ return . Left - ] +-- | This module exports miscellaneous error-handling functions. + +module Control.Error.Util ( + -- * Conversion + -- $conversion + hush, + hushT, + note, + noteT, + hoistMaybe, + (??), + (!?), + failWith, + failWithM, + + -- * Bool + bool, + + -- * Maybe + (?:), + + -- * MaybeT + maybeT, + just, + nothing, + isJustT, + isNothingT, + + -- * Either + isLeft, + isRight, + fmapR, + AllE(..), + AnyE(..), + + -- * EitherT + isLeftT, + isRightT, + fmapRT, + + -- * Error Reporting + err, + errLn, + + -- * Exceptions + tryIO, + syncIO + ) where + +import Control.Applicative (Applicative, pure, (<$>)) +import qualified Control.Exception as Ex +import Control.Monad (liftM) +import Control.Monad.IO.Class (MonadIO(liftIO)) +import Control.Monad.Trans.Either (EitherT(EitherT), runEitherT, eitherT) +import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT) +import Data.Dynamic (Dynamic) +import Data.Monoid (Monoid(mempty, mappend)) +import Data.Maybe (fromMaybe) +import System.Exit (ExitCode) +import System.IO (hPutStr, hPutStrLn, stderr) + +{- $conversion + Use these functions to convert between 'Maybe', 'Either', 'MaybeT', and + 'EitherT'. + + Note that 'hoistEither' and 'eitherT' are provided by the @either@ package. +-} +-- | Suppress the 'Left' value of an 'Either' +hush :: Either a b -> Maybe b +hush = either (const Nothing) Just + +-- | Suppress the 'Left' value of an 'EitherT' +hushT :: (Monad m) => EitherT a m b -> MaybeT m b +hushT = MaybeT . liftM hush . runEitherT + +-- | 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 -> EitherT a m b +noteT a = EitherT . 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 'EitherT' monad +(??) :: Applicative m => Maybe a -> e -> EitherT e m a +(??) a e = EitherT (pure $ note e a) + +-- | Convert an applicative 'Maybe' value into the 'EitherT' monad +(!?) :: Applicative m => m (Maybe a) -> e -> EitherT e m a +(!?) a e = EitherT (note e <$> a) + +-- | An infix form of 'fromMaybe' with arguments flipped. +(?:) :: Maybe a -> a -> a +maybeA ?: b = fromMaybe b maybeA +{-# INLINABLE (?:) #-} + +{-| Convert a 'Maybe' value into the 'EitherT' monad + + Named version of ('??') with arguments flipped +-} +failWith :: Applicative m => e -> Maybe a -> EitherT e m a +failWith e a = a ?? e + +{- | Convert an applicative 'Maybe' value into the 'EitherT' monad + + Named version of ('!?') with arguments flipped +-} +failWithM :: Applicative m => e -> m (Maybe a) -> EitherT 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 } + +instance (Monoid e, Monoid r) => Monoid (AllE e r) where + mempty = AllE (Right mempty) + 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)) + +{-| 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 } + +instance (Monoid e, Monoid r) => Monoid (AnyE e r) where + mempty = AnyE (Right mempty) + 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)) + +-- | Analogous to 'isLeft', but for 'EitherT' +isLeftT :: (Monad m) => EitherT a m b -> m Bool +isLeftT = eitherT (\_ -> return True) (\_ -> return False) +{-# INLINABLE isLeftT #-} + +-- | Analogous to 'isRight', but for 'EitherT' +isRightT :: (Monad m) => EitherT a m b -> m Bool +isRightT = eitherT (\_ -> return False) (\_ -> return True) +{-# INLINABLE isRightT #-} + +{- | 'fmap' specialized to 'EitherT', given a name symmetric to + 'Data.EitherR.fmapLT' +-} +fmapRT :: (Monad m) => (a -> b) -> EitherT l m a -> EitherT l m b +fmapRT = liftM + +-- | Write a string to standard error +err :: String -> IO () +err = hPutStr stderr + +-- | Write a string with a newline to standard error +errLn :: String -> IO () +errLn = hPutStrLn stderr + +-- | Catch 'Ex.IOException's and convert them to the 'EitherT' monad +tryIO :: (MonadIO m) => IO a -> EitherT Ex.IOException m a +tryIO = EitherT . liftIO . Ex.try + +{-| Catch all exceptions, except for asynchronous exceptions found in @base@ + and convert them to the 'EitherT' monad +-} +syncIO :: MonadIO m => IO a -> EitherT Ex.SomeException m a +syncIO a = EitherT . liftIO $ Ex.catches (Right <$> a) + [ Ex.Handler $ \e -> Ex.throw (e :: Ex.ArithException) + , Ex.Handler $ \e -> Ex.throw (e :: Ex.ArrayException) + , Ex.Handler $ \e -> Ex.throw (e :: Ex.AssertionFailed) + , Ex.Handler $ \e -> Ex.throw (e :: Ex.AsyncException) + , Ex.Handler $ \e -> Ex.throw (e :: Ex.BlockedIndefinitelyOnMVar) + , Ex.Handler $ \e -> Ex.throw (e :: Ex.BlockedIndefinitelyOnSTM) + , Ex.Handler $ \e -> Ex.throw (e :: Ex.Deadlock) + , Ex.Handler $ \e -> Ex.throw (e :: Dynamic) + , Ex.Handler $ \e -> Ex.throw (e :: Ex.ErrorCall) + , Ex.Handler $ \e -> Ex.throw (e :: ExitCode) + , Ex.Handler $ \e -> Ex.throw (e :: Ex.NestedAtomically) + , Ex.Handler $ \e -> Ex.throw (e :: Ex.NoMethodError) + , Ex.Handler $ \e -> Ex.throw (e :: Ex.NonTermination) + , Ex.Handler $ \e -> Ex.throw (e :: Ex.PatternMatchFail) + , Ex.Handler $ \e -> Ex.throw (e :: Ex.RecConError) + , Ex.Handler $ \e -> Ex.throw (e :: Ex.RecSelError) + , Ex.Handler $ \e -> Ex.throw (e :: Ex.RecUpdError) + , Ex.Handler $ return . Left + ] diff --git a/Data/EitherR.hs b/Data/EitherR.hs --- a/Data/EitherR.hs +++ b/Data/EitherR.hs @@ -1,193 +1,193 @@ -{-| This module provides 'throwE' and 'catchE' for 'Either'. These two - functions reside here because 'throwE' and 'catchE' correspond to 'return' - and ('>>=') for the flipped 'Either' monad: 'EitherR'. Similarly, this - module defines 'throwT' and 'catchT' for 'EitherT', which correspond to the - 'Monad' operations for 'EitherRT'. - - These throw and catch functions improve upon @MonadError@ because: - - * 'catch' is more general and allows you to change the left value's type - - * They are Haskell98 - - More advanced users can use 'EitherR' and 'EitherRT' 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: - -> runEitherRT $ 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 'flipE' 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 - throwE, - catchE, - handleE, - fmapL, - - -- ** Flip alternative - flipE, - - -- * EitherRT - EitherRT(..), - - -- ** Operations in the EitherRT monad - succeedT, - - -- ** Conversions to the EitherT monad - throwT, - catchT, - handleT, - 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.Either (EitherT(EitherT, runEitherT), left, right) -import Data.Monoid (Monoid(mempty, mappend)) - -{-| If \"@Either e r@\" is the error monad, then \"@EitherR r e@\" is the - corresponding success monad, where: - - * 'return' is 'throwE'. - - * ('>>=') is 'catchE'. - - * 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) - --- | 'throwE' in the error monad corresponds to 'return' in the success monad -throwE :: e -> Either e r -throwE e = runEitherR (return e) - --- | 'catchE' in the error monad corresponds to ('>>=') in the success monad -catchE :: Either a r -> (a -> Either b r) -> Either b r -e `catchE` f = runEitherR $ EitherR e >>= \a -> EitherR (f a) - --- | 'catchE' with the arguments flipped -handleE :: (a -> Either b r) -> Either a r -> Either b r -handleE = flip catchE - --- | 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' -flipE :: Either a b -> Either b a -flipE e = case e of - Left a -> Right a - Right b -> Left b - --- | 'EitherR' converted into a monad transformer -newtype EitherRT r m e = EitherRT { runEitherRT :: EitherT e m r } - -instance (Monad m) => Functor (EitherRT r m) where - fmap = liftM - -instance (Monad m) => Applicative (EitherRT r m) where - pure = return - (<*>) = ap - -instance (Monad m) => Monad (EitherRT r m) where - return e = EitherRT (left e) - m >>= f = EitherRT $ EitherT $ do - x <- runEitherT $ runEitherRT m - runEitherT $ runEitherRT $ case x of - Left e -> f e - Right r -> EitherRT (right r) - -instance (Monad m, Monoid r) => Alternative (EitherRT r m) where - empty = EitherRT $ EitherT $ return $ Right mempty - e1 <|> e2 = EitherRT $ EitherT $ do - x1 <- runEitherT $ runEitherRT e1 - case x1 of - Left l -> return (Left l) - Right r1 -> do - x2 <- runEitherT $ runEitherRT e2 - case x2 of - Left l -> return (Left l) - Right r2 -> return (Right (mappend r1 r2)) - -instance (Monad m, Monoid r) => MonadPlus (EitherRT r m) where - mzero = empty - mplus = (<|>) - -instance MonadTrans (EitherRT r) where - lift = EitherRT . EitherT . liftM Left - -instance (MonadIO m) => MonadIO (EitherRT r m) where - liftIO = lift . liftIO - --- | Complete error handling, returning a result -succeedT :: (Monad m) => r -> EitherRT r m e -succeedT r = EitherRT (return r) - --- | 'throwT' in the error monad corresponds to 'return' in the success monad -throwT :: (Monad m) => e -> EitherT e m r -throwT e = runEitherRT (return e) - --- | 'catchT' in the error monad corresponds to ('>>=') in the success monad -catchT :: (Monad m) => EitherT a m r -> (a -> EitherT b m r) -> EitherT b m r -e `catchT` f = runEitherRT $ EitherRT e >>= \a -> EitherRT (f a) - --- | 'catchT' with the arguments flipped -handleT :: (Monad m) => (a -> EitherT b m r) -> EitherT a m r -> EitherT b m r -handleT = flip catchT - --- | Map a function over the 'Left' value of an 'EitherT' -fmapLT :: (Monad m) => (a -> b) -> EitherT a m r -> EitherT b m r -fmapLT f = runEitherRT . fmap f . EitherRT - --- | Flip the type variables of an 'EitherT' -flipET :: (Monad m) => EitherT a m b -> EitherT b m a -flipET = EitherT . liftM flipE . runEitherT +{-| This module provides 'throwE' and 'catchE' for 'Either'. These two + functions reside here because 'throwE' and 'catchE' correspond to 'return' + and ('>>=') for the flipped 'Either' monad: 'EitherR'. Similarly, this + module defines 'throwT' and 'catchT' for 'EitherT', which correspond to the + 'Monad' operations for 'EitherRT'. + + These throw and catch functions improve upon @MonadError@ because: + + * 'catch' is more general and allows you to change the left value's type + + * They are Haskell98 + + More advanced users can use 'EitherR' and 'EitherRT' 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: + +> runEitherRT $ 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 'flipE' 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 + throwE, + catchE, + handleE, + fmapL, + + -- ** Flip alternative + flipE, + + -- * EitherRT + EitherRT(..), + + -- ** Operations in the EitherRT monad + succeedT, + + -- ** Conversions to the EitherT monad + throwT, + catchT, + handleT, + 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.Either (EitherT(EitherT, runEitherT), left, right) +import Data.Monoid (Monoid(mempty, mappend)) + +{-| If \"@Either e r@\" is the error monad, then \"@EitherR r e@\" is the + corresponding success monad, where: + + * 'return' is 'throwE'. + + * ('>>=') is 'catchE'. + + * 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) + +-- | 'throwE' in the error monad corresponds to 'return' in the success monad +throwE :: e -> Either e r +throwE e = runEitherR (return e) + +-- | 'catchE' in the error monad corresponds to ('>>=') in the success monad +catchE :: Either a r -> (a -> Either b r) -> Either b r +e `catchE` f = runEitherR $ EitherR e >>= \a -> EitherR (f a) + +-- | 'catchE' with the arguments flipped +handleE :: (a -> Either b r) -> Either a r -> Either b r +handleE = flip catchE + +-- | 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' +flipE :: Either a b -> Either b a +flipE e = case e of + Left a -> Right a + Right b -> Left b + +-- | 'EitherR' converted into a monad transformer +newtype EitherRT r m e = EitherRT { runEitherRT :: EitherT e m r } + +instance (Monad m) => Functor (EitherRT r m) where + fmap = liftM + +instance (Monad m) => Applicative (EitherRT r m) where + pure = return + (<*>) = ap + +instance (Monad m) => Monad (EitherRT r m) where + return e = EitherRT (left e) + m >>= f = EitherRT $ EitherT $ do + x <- runEitherT $ runEitherRT m + runEitherT $ runEitherRT $ case x of + Left e -> f e + Right r -> EitherRT (right r) + +instance (Monad m, Monoid r) => Alternative (EitherRT r m) where + empty = EitherRT $ EitherT $ return $ Right mempty + e1 <|> e2 = EitherRT $ EitherT $ do + x1 <- runEitherT $ runEitherRT e1 + case x1 of + Left l -> return (Left l) + Right r1 -> do + x2 <- runEitherT $ runEitherRT e2 + case x2 of + Left l -> return (Left l) + Right r2 -> return (Right (mappend r1 r2)) + +instance (Monad m, Monoid r) => MonadPlus (EitherRT r m) where + mzero = empty + mplus = (<|>) + +instance MonadTrans (EitherRT r) where + lift = EitherRT . EitherT . liftM Left + +instance (MonadIO m) => MonadIO (EitherRT r m) where + liftIO = lift . liftIO + +-- | Complete error handling, returning a result +succeedT :: (Monad m) => r -> EitherRT r m e +succeedT r = EitherRT (return r) + +-- | 'throwT' in the error monad corresponds to 'return' in the success monad +throwT :: (Monad m) => e -> EitherT e m r +throwT e = runEitherRT (return e) + +-- | 'catchT' in the error monad corresponds to ('>>=') in the success monad +catchT :: (Monad m) => EitherT a m r -> (a -> EitherT b m r) -> EitherT b m r +e `catchT` f = runEitherRT $ EitherRT e >>= \a -> EitherRT (f a) + +-- | 'catchT' with the arguments flipped +handleT :: (Monad m) => (a -> EitherT b m r) -> EitherT a m r -> EitherT b m r +handleT = flip catchT + +-- | Map a function over the 'Left' value of an 'EitherT' +fmapLT :: (Monad m) => (a -> b) -> EitherT a m r -> EitherT b m r +fmapLT f = runEitherRT . fmap f . EitherRT + +-- | Flip the type variables of an 'EitherT' +flipET :: (Monad m) => EitherT a m b -> EitherT b m a +flipET = EitherT . liftM flipE . runEitherT diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,24 +1,24 @@ -Copyright (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. +Copyright (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. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/errors.cabal b/errors.cabal --- a/errors.cabal +++ b/errors.cabal @@ -1,35 +1,35 @@ -Name: errors -Version: 1.4.6 -Cabal-Version: >=1.8.0.2 -Build-Type: Simple -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 -Source-Repository head - Type: git - Location: https://github.com/Gabriel439/Haskell-Errors-Library - -Library - Build-Depends: - base >= 4 && < 5 , - either >= 3.1 && < 5 , - safe >= 0.3.3 && < 0.4, - transformers >= 0.2 && < 0.4 - Exposed-Modules: - Control.Error, - Control.Error.Safe, - Control.Error.Script, - Control.Error.Util, - Data.EitherR - GHC-Options: -O2 +Name: errors +Version: 1.4.7 +Cabal-Version: >=1.8.0.2 +Build-Type: Simple +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 +Source-Repository head + Type: git + Location: https://github.com/Gabriel439/Haskell-Errors-Library + +Library + Build-Depends: + base >= 4 && < 5 , + either >= 3.1 && < 5 , + safe >= 0.3.3 && < 0.4, + transformers >= 0.2 && < 0.5 + Exposed-Modules: + Control.Error, + Control.Error.Safe, + Control.Error.Script, + Control.Error.Util, + Data.EitherR + GHC-Options: -O2