From bd6af6b98c5ab4f4812c30de2b79db58b51da2ab Mon Sep 17 00:00:00 2001 From: crumbtoo Date: Wed, 27 Mar 2024 11:26:45 -0600 Subject: [PATCH] errorful bleedOut --- src/Control/Monad/Errorful.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/Control/Monad/Errorful.hs b/src/Control/Monad/Errorful.hs index 9f78471..70c4a71 100644 --- a/src/Control/Monad/Errorful.hs +++ b/src/Control/Monad/Errorful.hs @@ -41,10 +41,15 @@ runErrorful m = coerce (runErrorfulT m) class (Applicative m) => MonadErrorful e m | m -> e where addWound :: e -> m () addFatal :: e -> m a + -- | Turn any wounds into fatals + bleedOut :: m a -> m a instance (Applicative m) => MonadErrorful e (ErrorfulT e m) where addWound e = ErrorfulT $ pure (Just (), [e]) addFatal e = ErrorfulT $ pure (Nothing, [e]) + bleedOut m = ErrorfulT $ runErrorfulT m <&> \case + (a, []) -> (a, []) + (_, es) -> (Nothing, es) instance MonadTrans (ErrorfulT e) where lift m = ErrorfulT ((\x -> (Just x,[])) <$> m) @@ -86,6 +91,7 @@ hoistErrorfulT nt (ErrorfulT m) = ErrorfulT (nt m) instance (Monad m, MonadErrorful e m) => MonadErrorful e (ReaderT r m) where addWound = lift . addWound addFatal = lift . addFatal + bleedOut = mapReaderT bleedOut instance (Monad m, MonadState s m) => MonadState s (ErrorfulT e m) where state = lift . state