module Control.Effect.Error
  ( Error(..)
  , throw
  , catch
  , runError
  ) where

import Control.Effect.Base

-- | The @'Error' e@ effect allows throwing and catching errors of type @e@.
--
-- Handlers should obey the law @'catch' ('throw' /x/) /f/@ ≡ @'pure' (/f/ /x/)@.
data Error e :: Effect where
  Throw :: e -> Error e m a
  Catch :: Eff (Error e ': effs) a -> (e -> Eff effs a) -> Error e (Eff effs) a

-- | Raises an error of type @e@.
throw :: Error e :< effs => e -> Eff effs a
throw :: e -> Eff effs a
throw = Error e (Eff effs) a -> Eff effs a
forall (eff :: Effect) a (effs :: [Effect]).
(eff :< effs) =>
eff (Eff effs) a -> Eff effs a
send (Error e (Eff effs) a -> Eff effs a)
-> (e -> Error e (Eff effs) a) -> e -> Eff effs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Error e (Eff effs) a
forall e (m :: * -> *) a. e -> Error e m a
Throw

-- | @'catch' /m/ /f/@ executes @/m/@. If it raises an error @/e/@, the
-- computation aborts to the point of the call to 'catch', and it resumes by
-- executing @/f/ /e/@.
catch :: Error e :< effs => Eff (Error e ': effs) a -> (e -> Eff effs a) -> Eff effs a
catch :: Eff (Error e : effs) a -> (e -> Eff effs a) -> Eff effs a
catch Eff (Error e : effs) a
a e -> Eff effs a
b = Error e (Eff effs) a -> Eff effs a
forall (eff :: Effect) a (effs :: [Effect]).
(eff :< effs) =>
eff (Eff effs) a -> Eff effs a
send (Error e (Eff effs) a -> Eff effs a)
-> Error e (Eff effs) a -> Eff effs a
forall a b. (a -> b) -> a -> b
$ Eff (Error e : effs) a -> (e -> Eff effs a) -> Error e (Eff effs) a
forall e (effs :: [Effect]) a.
Eff (Error e : effs) a -> (e -> Eff effs a) -> Error e (Eff effs) a
Catch Eff (Error e : effs) a
a e -> Eff effs a
b

-- | Handles an 'Error' effect. Returns 'Left' if the computation raised an
-- uncaught error, otherwise returns 'Right'.
runError :: forall e a effs. Eff (Error e ': effs) a -> Eff effs (Either e a)
runError :: Eff (Error e : effs) a -> Eff effs (Either e a)
runError = (a -> Eff effs (Either e a))
-> (forall (effs' :: [Effect]) b.
    (Error e :< effs') =>
    Error e (Eff effs') b
    -> Handle (Error e) effs a (Either e a) effs' b)
-> Eff (Error e : effs) a
-> Eff effs (Either e a)
forall (eff :: Effect) a r (effs :: [Effect]).
(a -> Eff effs r)
-> (forall (effs' :: [Effect]) b.
    (eff :< effs') =>
    eff (Eff effs') b -> Handle eff effs a r effs' b)
-> Eff (eff : effs) a
-> Eff effs r
handle (Either e a -> Eff effs (Either e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> Eff effs (Either e a))
-> (a -> Either e a) -> a -> Eff effs (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either e a
forall a b. b -> Either a b
Right) \case
  Throw e -> Either e a -> Handle (Error e) effs a (Either e a) effs' b
forall r (eff :: Effect) (effs :: [Effect]) i (effs' :: [Effect])
       a.
r -> Handle eff effs i r effs' a
abort (Either e a -> Handle (Error e) effs a (Either e a) effs' b)
-> Either e a -> Handle (Error e) effs a (Either e a) effs' b
forall a b. (a -> b) -> a -> b
$ e -> Either e a
forall a b. a -> Either a b
Left e
e
  Catch m f -> Eff effs b -> Handle (Error e) effs a (Either e a) effs b
forall (effs' :: [Effect]) a (eff :: Effect) (effs :: [Effect]) i
       r.
Eff effs' a -> Handle eff effs i r effs' a
locally ((e -> Eff effs b) -> (b -> Eff effs b) -> Either e b -> Eff effs b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Eff effs b
f b -> Eff effs b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e b -> Eff effs b) -> Eff effs (Either e b) -> Eff effs b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eff (Error e : effs) b -> Eff effs (Either e b)
forall e a (effs :: [Effect]).
Eff (Error e : effs) a -> Eff effs (Either e a)
runError Eff (Error e : effs) b
m)