-- |
-- Module:       Control.Monad.Freer.Error
-- Description:  An Error effect and handler.
-- Copyright:    (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King
-- License:      BSD3
-- Maintainer:   Alexis King <lexi.lambda@gmail.com>
-- Stability:    experimental
-- Portability:  GHC specific language extensions.
--
-- Composable handler for Error effects. Communicates success\/failure via an
-- 'Either' type.
--
-- Using <http://okmij.org/ftp/Haskell/extensible/Eff1.hs> as a starting point.
module Control.Monad.Freer.Error
  ( Error(..)
  , throwError
  , runError
  , catchError
  , handleError
  ) where

import Control.Monad.Freer (Eff, Member, interposeWith, interpretWith, send)
import Control.Monad.Freer.Internal (handleRelay)

-- | Exceptions of the type @e :: *@ with no resumption.
newtype Error e r where
  Error :: e -> Error e r

-- | Throws an error carrying information of type @e :: *@.
throwError :: forall e effs a. Member (Error e) effs => e -> Eff effs a
throwError :: e -> Eff effs a
throwError e
e = Error e a -> Eff effs a
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send (e -> Error e a
forall e r. e -> Error e r
Error e
e)

-- | Handler for exception effects. If there are no exceptions thrown, returns
-- 'Right'. If exceptions are thrown and not handled, returns 'Left', while
-- interrupting the execution of any other effect handlers.
runError :: forall e effs a. 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 v.
    Error e v -> Arr effs v (Either e a) -> Eff effs (Either e a))
-> Eff (Error e : effs) a
-> Eff effs (Either e a)
forall a (effs :: [* -> *]) b (eff :: * -> *).
(a -> Eff effs b)
-> (forall v. eff v -> Arr effs v b -> Eff effs b)
-> Eff (eff : effs) a
-> Eff effs b
handleRelay (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) (\(Error e) Arr effs v (Either e a)
_ -> Either e a -> Eff effs (Either e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (e -> Either e a
forall a b. a -> Either a b
Left e
e))

-- | A catcher for Exceptions. Handlers are allowed to rethrow exceptions.
catchError
  :: forall e effs a
   . Member (Error e) effs
  => Eff effs a
  -> (e -> Eff effs a)
  -> Eff effs a
catchError :: Eff effs a -> (e -> Eff effs a) -> Eff effs a
catchError Eff effs a
m e -> Eff effs a
handle = (forall v. Error e v -> (v -> Eff effs a) -> Eff effs a)
-> Eff effs a -> Eff effs a
forall (eff :: * -> *) (effs :: [* -> *]) b.
Member eff effs =>
(forall v. eff v -> (v -> Eff effs b) -> Eff effs b)
-> Eff effs b -> Eff effs b
interposeWith (\(Error e) v -> Eff effs a
_ -> e -> Eff effs a
handle e
e) Eff effs a
m

-- | A catcher for Exceptions. Handlers are /not/ allowed to rethrow exceptions.
handleError
  :: forall e effs a
   . Eff (Error e ': effs) a
  -> (e -> Eff effs a)
  -> Eff effs a
handleError :: Eff (Error e : effs) a -> (e -> Eff effs a) -> Eff effs a
handleError Eff (Error e : effs) a
m e -> Eff effs a
handle = (forall v. Error e v -> (v -> Eff effs a) -> Eff effs a)
-> Eff (Error e : effs) a -> Eff effs a
forall (eff :: * -> *) (effs :: [* -> *]) b.
(forall v. eff v -> (v -> Eff effs b) -> Eff effs b)
-> Eff (eff : effs) b -> Eff effs b
interpretWith (\(Error e) v -> Eff effs a
_ -> e -> Eff effs a
handle e
e) Eff (Error e : effs) a
m