LGTM, thanks.
On Thu, Feb 6, 2014 at 10:52 AM, Klaus Aehlig <[email protected]> wrote: > From: Petr Pudlak <[email protected]> > > There is often need to manipulate these errors, for example to convert a > String > from Result into an exception. These functions make this easier. > > Function 'toErrorStr' lifts 'Result' to any 'MonadError'. This is useful > for converting 'Result' into 'ResultT' or any other similar monad stack. > > Functions 'catchErrorT' and 'handleErrorT' catch errors just as > 'catchError' > does, but also allow to change the error type. > > Functions `withError` and `withErrorT` allow to modify an error within > GenericResult or ResultT. This is convenient when combining functions > with different error types, for example to convert between strings and > exceptions. > > Furthemore, 'failError' generalize 'Bad'. It can be used anywhere 'Bad' > is, and > in any 'MonadError' instance. > > Signed-off-by: Petr Pudlak <[email protected]> > Reviewed-by: Klaus Aehlig <[email protected]> > > Cherry-pick of 565821d1804f8734bdd2959e367 > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > src/Ganeti/BasicTypes.hs | 74 > ++++++++++++++++++++++++++++++++++++++++++++++-- > 1 file changed, 72 insertions(+), 2 deletions(-) > > diff --git a/src/Ganeti/BasicTypes.hs b/src/Ganeti/BasicTypes.hs > index 193041b..919266e 100644 > --- a/src/Ganeti/BasicTypes.hs > +++ b/src/Ganeti/BasicTypes.hs > @@ -26,7 +26,11 @@ module Ganeti.BasicTypes > , genericResult > , Result > , ResultT(..) > + , mkResultT > + , withError > + , withErrorT > , resultT > + , toErrorStr > , Error(..) -- re-export from Control.Monad.Error > , isOk > , isBad > @@ -34,6 +38,10 @@ module Ganeti.BasicTypes > , justBad > , eitherToResult > , annotateResult > + , annotateError > + , failError > + , catchErrorT > + , handleErrorT > , iterateOk > , select > , LookupResult(..) > @@ -70,6 +78,7 @@ data GenericResult a b > genericResult :: (a -> c) -> (b -> c) -> GenericResult a b -> c > genericResult f _ (Bad a) = f a > genericResult _ g (Ok b) = g b > +{-# INLINE genericResult #-} > > -- | Type alias for a string Result. > type Result = GenericResult String > @@ -95,7 +104,9 @@ instance (Error a, Monoid a) => MonadPlus > (GenericResult a) where > > instance (Error a) => MonadError a (GenericResult a) where > throwError = Bad > + {-# INLINE throwError #-} > catchError x h = genericResult h (const x) x > + {-# INLINE catchError #-} > > instance Applicative (GenericResult a) where > pure = Ok > @@ -109,6 +120,10 @@ instance (Error a, Monoid a) => Alternative > (GenericResult a) where > > -- | This is a monad transformation for Result. It's implementation is > -- based on the implementations of MaybeT and ErrorT. > +-- > +-- 'ResultT' is very similar to @ErrorT@, but with one subtle difference: > +-- If 'mplus' combines two failing operations, errors of both of them > +-- are combined. > newtype ResultT a m b = ResultT {runResultT :: m (GenericResult a b)} > > -- | Eliminates a 'ResultT' value given appropriate continuations > @@ -137,7 +152,7 @@ instance (Monad m, Error a) => Monad (ResultT a m) > where > > instance (Monad m, Error a) => MonadError a (ResultT a m) where > throwError = resultT . Bad > - catchError x h = elimResultT h return x > + catchError = catchErrorT > > instance MonadTrans (ResultT a) where > lift = ResultT . liftM Ok > @@ -156,10 +171,38 @@ instance (Monad m, Error a, Monoid a) => Alternative > (ResultT a m) where > empty = mzero > (<|>) = mplus > > +-- | Changes the error message of a result value, if present. > +-- Note that since 'GenericResult' is also a 'MonadError', this function > +-- is a generalization of > +-- @(Error e') => (e' -> e) -> GenericResult e' a -> GenericResult e a@ > +withError :: (MonadError e m) => (e' -> e) -> GenericResult e' a -> m a > +withError f = genericResult (throwError . f) return > + > +-- | Changes the error message of a @ResultT@ value, if present. > +withErrorT :: (Monad m, Error e) > + => (e' -> e) -> ResultT e' m a -> ResultT e m a > +withErrorT f = ResultT . liftM (withError f) . runResultT > + > -- | Lift a `Result` value to a `ResultT`. > resultT :: Monad m => GenericResult a b -> ResultT a m b > resultT = ResultT . return > > +-- | An alias for @withError strMsg@, which is often used to lift a pure > error > +-- to a monad stack. See also 'annotateResult'. > +toErrorStr :: (MonadError e m, Error e) => Result a -> m a > +toErrorStr = withError strMsg > + > +-- | Converts a monadic result with a 'String' message into > +-- a 'ResultT' with an arbitrary 'Error'. > +-- > +-- Expects that the given action has already taken care of any possible > +-- errors. In particular, if applied on @IO (Result a)@, any exceptions > +-- should be handled by the given action. > +-- > +-- See also 'toErrorStr'. > +mkResultT :: (Monad m, Error e) => m (Result a) -> ResultT e m a > +mkResultT = ResultT . liftM toErrorStr > + > -- | Simple checker for whether a 'GenericResult' is OK. > isOk :: GenericResult a b -> Bool > isOk (Ok _) = True > @@ -182,11 +225,38 @@ eitherToResult :: Either a b -> GenericResult a b > eitherToResult (Left s) = Bad s > eitherToResult (Right v) = Ok v > > --- | Annotate a Result with an ownership information. > +--- | Annotate a Result with an ownership information. > annotateResult :: String -> Result a -> Result a > annotateResult owner (Bad s) = Bad $ owner ++ ": " ++ s > annotateResult _ v = v > > +-- | Annotate an error with an ownership information inside a > 'MonadError'. > +-- See also 'annotateResult'. > +annotateError :: (MonadError e m, Error e, Monoid e) => String -> m a -> > m a > +annotateError owner = > + flip catchError (throwError . mappend (strMsg $ owner ++ ": ")) > +{-# INLINE annotateError #-} > + > +-- | Throws a 'String' message as an error in a 'MonadError'. > +-- This is a generalization of 'Bad'. > +-- It's similar to 'fail', but works within a 'MonadError', avoiding the > +-- unsafe nature of 'fail'. > +failError :: (MonadError e m, Error e) => String -> m a > +failError = throwError . strMsg > + > +-- | A synonym for @flip@ 'catchErrorT'. > +handleErrorT :: (Monad m, Error e) > + => (e' -> ResultT e m a) -> ResultT e' m a -> ResultT e m a > +handleErrorT handler = elimResultT handler return > +{-# INLINE handleErrorT #-} > + > +-- | Catches an error in a @ResultT@ value. This is similar to > 'catchError', > +-- but in addition allows to change the error type. > +catchErrorT :: (Monad m, Error e) > + => ResultT e' m a -> (e' -> ResultT e m a) -> ResultT e m a > +catchErrorT = flip handleErrorT > +{-# INLINE catchErrorT #-} > + > -- | Iterate while Ok. > iterateOk :: (a -> GenericResult b a) -> a -> [a] > iterateOk f a = genericResult (const []) ((:) a . iterateOk f) (f a) > -- > 1.9.0.rc1.175.g0b1dcb5 > >
