{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE Trustworthy #-}
module Cleff.Error
(
Error (..)
,
throwError, catchError, fromEither, fromException, fromExceptionVia, fromExceptionEff, fromExceptionEffVia,
note, catchErrorJust, catchErrorIf, handleError, handleErrorJust, handleErrorIf, tryError, tryErrorJust
,
runError, mapError
) where
import Cleff
import Cleff.Internal.Any
import Cleff.Internal.Base
import Control.Exception (Exception)
import Data.Bool (bool)
import Data.Unique (Unique, hashUnique, newUnique)
import qualified UnliftIO.Exception as Exc
data Error e :: Effect where
ThrowError :: e -> Error e m a
CatchError :: m a -> (e -> m a) -> Error e m a
makeEffect ''Error
fromEither :: Error e :> es => Either e a -> Eff es a
fromEither :: Either e a -> Eff es a
fromEither = (e -> Eff es a) -> (a -> Eff es a) -> Either e a -> Eff es a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
e -> Eff es a
throwError a -> Eff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
fromException :: ∀ e es a. (Exc.Exception e, '[Error e, IOE] :>> es) => IO a -> Eff es a
fromException :: IO a -> Eff es a
fromException IO a
m = Eff es a -> (e -> Eff es a) -> Eff es a
forall (m :: Type -> Type) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
Exc.catch (IO a -> Eff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO a
m) (forall (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
e -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
e -> Eff es a
throwError @e)
fromExceptionVia :: (Exc.Exception ex, '[Error er, IOE] :>> es) => (ex -> er) -> IO a -> Eff es a
fromExceptionVia :: (ex -> er) -> IO a -> Eff es a
fromExceptionVia ex -> er
f IO a
m = Eff es a -> (ex -> Eff es a) -> Eff es a
forall (m :: Type -> Type) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
Exc.catch (IO a -> Eff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO a
m) (er -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
e -> Eff es a
throwError (er -> Eff es a) -> (ex -> er) -> ex -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ex -> er
f)
fromExceptionEff :: ∀ e es a. (Exc.Exception e, '[Error e, IOE] :>> es) => Eff es a -> Eff es a
fromExceptionEff :: Eff es a -> Eff es a
fromExceptionEff Eff es a
m = ((forall a. Eff es a -> IO a) -> IO a) -> Eff es a
forall (m :: Type -> Type) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. Eff es a -> IO a
unlift -> IO a -> (e -> IO a) -> IO a
forall (m :: Type -> Type) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
Exc.catch (Eff es a -> IO a
forall a. Eff es a -> IO a
unlift Eff es a
m) (Eff es a -> IO a
forall a. Eff es a -> IO a
unlift (Eff es a -> IO a) -> (e -> Eff es a) -> e -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
e -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
e -> Eff es a
throwError @e)
fromExceptionEffVia :: (Exc.Exception ex, '[Error er, IOE] :>> es) => (ex -> er) -> Eff es a -> Eff es a
fromExceptionEffVia :: (ex -> er) -> Eff es a -> Eff es a
fromExceptionEffVia ex -> er
f Eff es a
m = ((forall a. Eff es a -> IO a) -> IO a) -> Eff es a
forall (m :: Type -> Type) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. Eff es a -> IO a
unlift -> IO a -> (ex -> IO a) -> IO a
forall (m :: Type -> Type) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
Exc.catch (Eff es a -> IO a
forall a. Eff es a -> IO a
unlift Eff es a
m) (Eff es a -> IO a
forall a. Eff es a -> IO a
unlift (Eff es a -> IO a) -> (ex -> Eff es a) -> ex -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. er -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
e -> Eff es a
throwError (er -> Eff es a) -> (ex -> er) -> ex -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ex -> er
f)
note :: Error e :> es => e -> Maybe a -> Eff es a
note :: e -> Maybe a -> Eff es a
note e
e = Eff es a -> (a -> Eff es a) -> Maybe a -> Eff es a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
e -> Eff es a
throwError e
e) a -> Eff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
catchErrorJust :: Error e :> es => (e -> Maybe b) -> Eff es a -> (b -> Eff es a) -> Eff es a
catchErrorJust :: (e -> Maybe b) -> Eff es a -> (b -> Eff es a) -> Eff es a
catchErrorJust e -> Maybe b
f Eff es a
m b -> Eff es a
h = Eff es a
m Eff es a -> (e -> Eff es a) -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
Eff es a -> (e -> Eff es a) -> Eff es a
`catchError` \e
e -> Eff es a -> (b -> Eff es a) -> Maybe b -> Eff es a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
e -> Eff es a
throwError e
e) b -> Eff es a
h (Maybe b -> Eff es a) -> Maybe b -> Eff es a
forall a b. (a -> b) -> a -> b
$ e -> Maybe b
f e
e
catchErrorIf :: Error e :> es => (e -> Bool) -> Eff es a -> (e -> Eff es a) -> Eff es a
catchErrorIf :: (e -> Bool) -> Eff es a -> (e -> Eff es a) -> Eff es a
catchErrorIf e -> Bool
f Eff es a
m e -> Eff es a
h = Eff es a
m Eff es a -> (e -> Eff es a) -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
Eff es a -> (e -> Eff es a) -> Eff es a
`catchError` \e
e -> Eff es a -> Eff es a -> Bool -> Eff es a
forall a. a -> a -> Bool -> a
bool (e -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
e -> Eff es a
throwError e
e) (e -> Eff es a
h e
e) (Bool -> Eff es a) -> Bool -> Eff es a
forall a b. (a -> b) -> a -> b
$ e -> Bool
f e
e
handleError :: Error e :> es => (e -> Eff es a) -> Eff es a -> Eff es a
handleError :: (e -> Eff es a) -> Eff es a -> Eff es a
handleError = (Eff es a -> (e -> Eff es a) -> Eff es a)
-> (e -> Eff es a) -> Eff es a -> Eff es a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Eff es a -> (e -> Eff es a) -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
Eff es a -> (e -> Eff es a) -> Eff es a
catchError
handleErrorJust :: Error e :> es => (e -> Maybe b) -> (b -> Eff es a) -> Eff es a -> Eff es a
handleErrorJust :: (e -> Maybe b) -> (b -> Eff es a) -> Eff es a -> Eff es a
handleErrorJust = (Eff es a -> (b -> Eff es a) -> Eff es a)
-> (b -> Eff es a) -> Eff es a -> Eff es a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Eff es a -> (b -> Eff es a) -> Eff es a)
-> (b -> Eff es a) -> Eff es a -> Eff es a)
-> ((e -> Maybe b) -> Eff es a -> (b -> Eff es a) -> Eff es a)
-> (e -> Maybe b)
-> (b -> Eff es a)
-> Eff es a
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Maybe b) -> Eff es a -> (b -> Eff es a) -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) b a.
(Error e :> es) =>
(e -> Maybe b) -> Eff es a -> (b -> Eff es a) -> Eff es a
catchErrorJust
handleErrorIf :: Error e :> es => (e -> Bool) -> (e -> Eff es a) -> Eff es a -> Eff es a
handleErrorIf :: (e -> Bool) -> (e -> Eff es a) -> Eff es a -> Eff es a
handleErrorIf = (Eff es a -> (e -> Eff es a) -> Eff es a)
-> (e -> Eff es a) -> Eff es a -> Eff es a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Eff es a -> (e -> Eff es a) -> Eff es a)
-> (e -> Eff es a) -> Eff es a -> Eff es a)
-> ((e -> Bool) -> Eff es a -> (e -> Eff es a) -> Eff es a)
-> (e -> Bool)
-> (e -> Eff es a)
-> Eff es a
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Bool) -> Eff es a -> (e -> Eff es a) -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
(e -> Bool) -> Eff es a -> (e -> Eff es a) -> Eff es a
catchErrorIf
tryError :: Error e :> es => Eff es a -> Eff es (Either e a)
tryError :: Eff es a -> Eff es (Either e a)
tryError Eff es a
m = (a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a) -> Eff es a -> Eff es (Either e a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es a
m) Eff es (Either e a)
-> (e -> Eff es (Either e a)) -> Eff es (Either e a)
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
Eff es a -> (e -> Eff es a) -> Eff es a
`catchError` (Either e a -> Eff es (Either e a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either e a -> Eff es (Either e a))
-> (e -> Either e a) -> e -> Eff es (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left)
tryErrorJust :: Error e :> es => (e -> Maybe b) -> Eff es a -> Eff es (Either b a)
tryErrorJust :: (e -> Maybe b) -> Eff es a -> Eff es (Either b a)
tryErrorJust e -> Maybe b
f Eff es a
m = (a -> Either b a
forall a b. b -> Either a b
Right (a -> Either b a) -> Eff es a -> Eff es (Either b a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es a
m) Eff es (Either b a)
-> (e -> Eff es (Either b a)) -> Eff es (Either b a)
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
Eff es a -> (e -> Eff es a) -> Eff es a
`catchError` \e
e -> Eff es (Either b a)
-> (b -> Eff es (Either b a)) -> Maybe b -> Eff es (Either b a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> Eff es (Either b a)
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
e -> Eff es a
throwError e
e) (Either b a -> Eff es (Either b a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either b a -> Eff es (Either b a))
-> (b -> Either b a) -> b -> Eff es (Either b a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either b a
forall a b. a -> Either a b
Left) (Maybe b -> Eff es (Either b a)) -> Maybe b -> Eff es (Either b a)
forall a b. (a -> b) -> a -> b
$ e -> Maybe b
f e
e
data ErrorExc = ErrorExc !Unique Any
instance Exception ErrorExc
instance Show ErrorExc where
showsPrec :: Int -> ErrorExc -> ShowS
showsPrec Int
_ (ErrorExc Unique
uid Any
_) =
(String
"Cleff.Error.runError: Escaped error (error UID hash: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows (Unique -> Int
hashUnique Unique
uid) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"). This is possibly due \
\to trying to 'throwError' in a forked thread, or trying to 'wait' on an error-throwing \'Async' computation out \
\of the effect scope where it is created. Refer to the haddock of 'runError' for details on the caveats. If all \
\those shenanigans mentioned or other similar ones seem unlikely, please report this as a bug." String -> ShowS
forall a. Semigroup a => a -> a -> a
<>)
catch' :: ∀ e m a. MonadUnliftIO m => Unique -> m a -> (e -> m a) -> m a
catch' :: Unique -> m a -> (e -> m a) -> m a
catch' Unique
eid m a
m e -> m a
h = m a
m m a -> (ErrorExc -> m a) -> m a
forall (m :: Type -> Type) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`Exc.catch` \ex :: ErrorExc
ex@(ErrorExc Unique
eid' Any
e) -> if Unique
eid Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
eid' then e -> m a
h (Any -> e
forall a. Any -> a
fromAny Any
e) else ErrorExc -> m a
forall (m :: Type -> Type) e a.
(MonadIO m, Exception e) =>
e -> m a
Exc.throwIO ErrorExc
ex
{-# INLINE catch' #-}
try' :: ∀ e m a. MonadUnliftIO m => Unique -> m a -> m (Either e a)
try' :: Unique -> m a -> m (Either e a)
try' Unique
eid m a
m = Unique -> m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall e (m :: Type -> Type) a.
MonadUnliftIO m =>
Unique -> m a -> (e -> m a) -> m a
catch' Unique
eid (a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a) -> m a -> m (Either e a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
m) (Either e a -> m (Either e a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a))
-> (e -> Either e a) -> e -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left)
{-# INLINE try' #-}
errorHandler :: Unique -> Handler (Error e) (IOE ': es)
errorHandler :: Unique -> Handler (Error e) (IOE : es)
errorHandler Unique
eid = \case
ThrowError e
e -> ErrorExc -> Eff (IOE : es) a
forall (m :: Type -> Type) e a.
(MonadIO m, Exception e) =>
e -> m a
Exc.throwIO (ErrorExc -> Eff (IOE : es) a) -> ErrorExc -> Eff (IOE : es) a
forall a b. (a -> b) -> a -> b
$ Unique -> Any -> ErrorExc
ErrorExc Unique
eid (e -> Any
forall a. a -> Any
toAny e
e)
CatchError Eff esSend a
m' e -> Eff esSend a
h' -> ((Eff esSend ~> IO) -> IO a) -> Eff (IOE : es) a
forall (esSend :: [(Type -> Type) -> Type -> Type])
(e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a.
(Handling esSend e es, IOE :> es) =>
((Eff esSend ~> IO) -> IO a) -> Eff es a
withToIO \Eff esSend ~> IO
toIO -> IO a -> IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ Unique -> IO a -> (e -> IO a) -> IO a
forall e (m :: Type -> Type) a.
MonadUnliftIO m =>
Unique -> m a -> (e -> m a) -> m a
catch' Unique
eid (Eff esSend a -> IO a
Eff esSend ~> IO
toIO Eff esSend a
m') (Eff esSend a -> IO a
Eff esSend ~> IO
toIO (Eff esSend a -> IO a) -> (e -> Eff esSend a) -> e -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Eff esSend a
h')
{-# INLINE errorHandler #-}
runError :: ∀ e es a. Eff (Error e ': es) a -> Eff es (Either e a)
runError :: Eff (Error e : es) a -> Eff es (Either e a)
runError Eff (Error e : es) a
m = Eff (IOE : es) (Either e a) -> Eff es (Either e a)
forall (es :: [(Type -> Type) -> Type -> Type]).
Eff (IOE : es) ~> Eff es
thisIsPureTrustMe do
Unique
eid <- IO Unique -> Eff (IOE : es) Unique
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO Unique
newUnique
Unique -> Eff (IOE : es) a -> Eff (IOE : es) (Either e a)
forall e (m :: Type -> Type) a.
MonadUnliftIO m =>
Unique -> m a -> m (Either e a)
try' Unique
eid (Eff (IOE : es) a -> Eff (IOE : es) (Either e a))
-> Eff (IOE : es) a -> Eff (IOE : es) (Either e a)
forall a b. (a -> b) -> a -> b
$ Handler (Error e) (IOE : es)
-> Eff (Error e : es) a -> Eff (IOE : es) a
forall (e' :: (Type -> Type) -> Type -> Type)
(e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]).
Handler e (e' : es) -> Eff (e : es) ~> Eff (e' : es)
reinterpret (Unique -> Handler (Error e) (IOE : es)
forall e (es :: [(Type -> Type) -> Type -> Type]).
Unique -> Handler (Error e) (IOE : es)
errorHandler Unique
eid) Eff (Error e : es) a
m
{-# INLINE runError #-}
mapError :: ∀ e e' es. Error e' :> es => (e -> e') -> Eff (Error e ': es) ~> Eff es
mapError :: (e -> e') -> Eff (Error e : es) ~> Eff es
mapError e -> e'
f = Eff (IOE : es) a -> Eff es a
forall (es :: [(Type -> Type) -> Type -> Type]).
Eff (IOE : es) ~> Eff es
thisIsPureTrustMe (Eff (IOE : es) a -> Eff es a)
-> (Eff (Error e : es) a -> Eff (IOE : es) a)
-> Eff (Error e : es) a
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler (Error e) (IOE : es)
-> Eff (Error e : es) ~> Eff (IOE : es)
forall (e' :: (Type -> Type) -> Type -> Type)
(e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]).
Handler e (e' : es) -> Eff (e : es) ~> Eff (e' : es)
reinterpret \case
ThrowError e -> e' -> Eff (IOE : es) a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
e -> Eff es a
throwError (e' -> Eff (IOE : es) a) -> e' -> Eff (IOE : es) a
forall a b. (a -> b) -> a -> b
$ e -> e'
f e
e
CatchError m h -> do
Unique
eid <- IO Unique -> Eff (IOE : es) Unique
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO Unique
newUnique
Either e a
res <- Unique -> Eff (IOE : es) a -> Eff (IOE : es) (Either e a)
forall e (m :: Type -> Type) a.
MonadUnliftIO m =>
Unique -> m a -> m (Either e a)
try' @e Unique
eid (Eff (IOE : es) a -> Eff (IOE : es) (Either e a))
-> Eff (IOE : es) a -> Eff (IOE : es) (Either e a)
forall a b. (a -> b) -> a -> b
$ Handler (Error e) (IOE : es) -> Eff esSend a -> Eff (IOE : es) a
forall (esSend :: [(Type -> Type) -> Type -> Type])
(e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]).
Handling esSend e es =>
Handler e es -> Eff esSend ~> Eff es
toEffWith (Unique -> Handler (Error e) (IOE : es)
forall e (es :: [(Type -> Type) -> Type -> Type]).
Unique -> Handler (Error e) (IOE : es)
errorHandler Unique
eid) Eff esSend a
m
case Either e a
res of
Left e
e -> Eff esSend a -> Eff (IOE : es) a
forall (esSend :: [(Type -> Type) -> Type -> Type])
(e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]).
Handling esSend e es =>
Eff esSend ~> Eff es
toEff (e -> Eff esSend a
h e
e)
Right a
a -> a -> Eff (IOE : es) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a
{-# INLINE mapError #-}