151 |
151 |
(>>=) = flip (elimResultT throwError)
|
152 |
152 |
|
153 |
153 |
instance (Monad m, Error a) => MonadError a (ResultT a m) where
|
154 |
|
throwError = resultT . Bad
|
|
154 |
throwError = ResultT . return . Bad
|
155 |
155 |
catchError = catchErrorT
|
156 |
156 |
|
157 |
157 |
instance MonadTrans (ResultT a) where
|
... | ... | |
183 |
183 |
=> (e' -> e) -> ResultT e' m a -> ResultT e m a
|
184 |
184 |
withErrorT f = ResultT . liftM (withError f) . runResultT
|
185 |
185 |
|
186 |
|
-- | Lift a `Result` value to a `ResultT`.
|
187 |
|
resultT :: Monad m => GenericResult a b -> ResultT a m b
|
188 |
|
resultT = ResultT . return
|
|
186 |
-- | Lift a 'Result' value to any 'MonadError'. Since 'ResultT' is itself its
|
|
187 |
-- instance, it's a generalization of
|
|
188 |
-- @Monad m => GenericResult a b -> ResultT a m b@.
|
|
189 |
resultT :: (MonadError e m) => GenericResult e a -> m a
|
|
190 |
resultT = genericResult throwError return
|
|
191 |
{-# INLINE resultT #-}
|
189 |
192 |
|
190 |
193 |
-- | An alias for @withError strMsg@, which is often used to lift a pure error
|
191 |
194 |
-- to a monad stack. See also 'annotateResult'.
|
... | ... | |
225 |
228 |
eitherToResult (Left s) = Bad s
|
226 |
229 |
eitherToResult (Right v) = Ok v
|
227 |
230 |
|
228 |
|
--- | Annotate a Result with an ownership information.
|
229 |
|
annotateResult :: String -> Result a -> Result a
|
230 |
|
annotateResult owner (Bad s) = Bad $ owner ++ ": " ++ s
|
231 |
|
annotateResult _ v = v
|
|
231 |
-- | Annotate an error with an ownership information, lifting it to a
|
|
232 |
-- 'MonadError'. Since 'Result' is an instance of 'MonadError' itself,
|
|
233 |
-- it's a generalization of type @String -> Result a -> Result a@.
|
|
234 |
-- See also 'toErrorStr'.
|
|
235 |
annotateResult :: (MonadError e m, Error e) => String -> Result a -> m a
|
|
236 |
annotateResult owner = toErrorStr . annotateError owner
|
232 |
237 |
|
233 |
238 |
-- | Annotate an error with an ownership information inside a 'MonadError'.
|
234 |
239 |
-- See also 'annotateResult'.
|