{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
module PFile.Error
( modifyError
, tellError
, liftIOWithError
, onIOError
, consumeWriterT
, fallback
, untilError
) where
import Control.Monad.Writer (MonadWriter (..), WriterT (..))
import Protolude
modifyError :: MonadError e2 m => (e1 -> e2) -> ExceptT e1 m a -> m a
modifyError :: forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError e1 -> e2
f = ExceptT e1 m a -> m (Either e1 a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e1 m a -> m (Either e1 a))
-> (Either e1 a -> m a) -> ExceptT e1 m a -> m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (e1 -> m a) -> (a -> m a) -> Either e1 a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e2 -> m a
forall a. e2 -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e2 -> m a) -> (e1 -> e2) -> e1 -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> e2
f) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
tellError :: MonadWriter [e2] m => (e1 -> e2) -> ExceptT e1 m a -> m ()
tellError :: forall e2 (m :: * -> *) e1 a.
MonadWriter [e2] m =>
(e1 -> e2) -> ExceptT e1 m a -> m ()
tellError e1 -> e2
f = ExceptT e1 m a -> m (Either e1 a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e1 m a -> m (Either e1 a))
-> (Either e1 a -> m ()) -> ExceptT e1 m a -> m ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (e1 -> m ()) -> (a -> m ()) -> Either e1 a -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([e2] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([e2] -> m ()) -> (e1 -> [e2]) -> e1 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e2 -> [e2] -> [e2]
forall a. a -> [a] -> [a]
: []) (e2 -> [e2]) -> (e1 -> e2) -> e1 -> [e2]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> e2
f) (m () -> a -> m ()
forall a b. a -> b -> a
const (m () -> a -> m ()) -> m () -> a -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
liftIOWithError :: (MonadError e m, MonadIO m) => IO a -> (IOException -> e) -> m a
liftIOWithError :: forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
liftIOWithError IO a
action IOException -> e
f = IO (Either IOException a) -> m (Either IOException a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO (Either IOException a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
action) m (Either IOException a) -> (Either IOException a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOException -> m a) -> (a -> m a) -> Either IOException a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> m a
forall a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> m a) -> (IOException -> e) -> IOException -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> e
f) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
onIOError :: IO a -> IO a -> IO a
onIOError :: forall a. IO a -> IO a -> IO a
onIOError IO a
action IO a
f = IO a
action IO a -> (IOException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a b. a -> b -> a
const @_ @IOException IO a
f
consumeWriterT ::
Monad m => (w -> m ()) -> ExceptT e (WriterT w m) a -> ExceptT e m a
consumeWriterT :: forall (m :: * -> *) w e a.
Monad m =>
(w -> m ()) -> ExceptT e (WriterT w m) a -> ExceptT e m a
consumeWriterT w -> m ()
f = (WriterT w m (Either e a) -> m (Either e a))
-> ExceptT e (WriterT w m) a -> ExceptT e m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT ((WriterT w m (Either e a) -> m (Either e a))
-> ExceptT e (WriterT w m) a -> ExceptT e m a)
-> (WriterT w m (Either e a) -> m (Either e a))
-> ExceptT e (WriterT w m) a
-> ExceptT e m a
forall a b. (a -> b) -> a -> b
$ WriterT w m (Either e a) -> m (Either e a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT w m (Either e a) -> m (Either e a, w))
-> ((Either e a, w) -> m (Either e a))
-> WriterT w m (Either e a)
-> m (Either e a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \(Either e a
y, w
w) -> Either e a
y Either e a -> m () -> m (Either e a)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ w -> m ()
f w
w
fallback :: Monad m => (e -> w -> m b) -> ExceptT e (WriterT w m) a -> m w
fallback :: forall (m :: * -> *) e w b a.
Monad m =>
(e -> w -> m b) -> ExceptT e (WriterT w m) a -> m w
fallback e -> w -> m b
f ExceptT e (WriterT w m) a
action = do
(Maybe e
maybeCause, w
result) <- ExceptT e (WriterT w m) a -> m (Maybe e, w)
forall (m :: * -> *) e w a.
Functor m =>
ExceptT e (WriterT w m) a -> m (Maybe e, w)
untilError ExceptT e (WriterT w m) a
action
Maybe e
maybeCause Maybe e -> (Maybe e -> m w) -> m w
forall a b. a -> (a -> b) -> b
& m w -> (e -> m w) -> Maybe e -> m w
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (w -> m w
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure w
result) (\e
cause -> w
result w -> m b -> m w
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ e -> w -> m b
f e
cause w
result)
untilError :: Functor m => ExceptT e (WriterT w m) a -> m (Maybe e, w)
untilError :: forall (m :: * -> *) e w a.
Functor m =>
ExceptT e (WriterT w m) a -> m (Maybe e, w)
untilError ExceptT e (WriterT w m) a
action = ExceptT e (WriterT w m) a
action ExceptT e (WriterT w m) a
-> (ExceptT e (WriterT w m) a -> m (Either e a, w))
-> m (Either e a, w)
forall a b. a -> (a -> b) -> b
& WriterT w m (Either e a) -> m (Either e a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT w m (Either e a) -> m (Either e a, w))
-> (ExceptT e (WriterT w m) a -> WriterT w m (Either e a))
-> ExceptT e (WriterT w m) a
-> m (Either e a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT e (WriterT w m) a -> WriterT w m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT m (Either e a, w)
-> ((Either e a, w) -> (Maybe e, w)) -> m (Maybe e, w)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Either e a -> Maybe e) -> (Either e a, w) -> (Maybe e, w)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Either e a -> Maybe e
forall l r. Either l r -> Maybe l
leftToMaybe