{-# LANGUAGE TemplateHaskell #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Effect.Error
-- Copyright   :  (c) Michael Szvetits, 2020
-- License     :  BSD3 (see the file LICENSE)
-- Maintainer  :  typedbyte@qualified.name
-- Stability   :  stable
-- Portability :  portable
--
-- The error effect, similar to the @MonadError@ type class from the
-- @mtl@ library.
-----------------------------------------------------------------------------
module Control.Effect.Error
  ( -- * Tagged Error Effect
    Error'(..)
    -- * Untagged Error Effect
    -- | If you don't require disambiguation of multiple error effects
    -- (i.e., you only have one error effect in your monadic context),
    -- it is recommended to always use the untagged error effect.
  , Error
  , throwError
  , catchError
    -- * Convenience Functions
    -- | If you don't require disambiguation of multiple error effects
    -- (i.e., you only have one error effect in your monadic context),
    -- it is recommended to always use the untagged functions.
  , liftEither'
  , liftEither
    -- * Interpretations
  , runError'
  , runError
    -- * Tagging and Untagging
    -- | Conversion functions between the tagged and untagged error effect,
    -- usually used in combination with type applications, like:
    --
    -- @
    --     'tagError'' \@\"newTag\" program
    --     'retagError'' \@\"oldTag\" \@\"newTag\" program
    --     'untagError'' \@\"erasedTag\" program
    -- @
    -- 
  , tagError'
  , retagError'
  , untagError'
  ) where

-- base
import Data.Coerce (coerce)

-- transformers
import Control.Monad.Trans.Except (ExceptT(ExceptT), catchE, throwE)

import Control.Effect.Machinery

-- | An effect that equips a computation with the ability to throw and catch
-- exceptions.
class Monad m => Error' tag e m | tag m -> e where
  -- | Throws an exception during the computation and begins exception
  -- processing.
  throwError' :: e -> m a
  -- | Catches an exception in order to handle it and return to normal execution.
  catchError' :: m a -> (e -> m a) -> m a

makeTaggedEffect ''Error'

instance Monad m => Error' tag e (ExceptT e m) where
  throwError' :: e -> ExceptT e m a
throwError' = e -> ExceptT e m a
forall (m :: SomeMonad) e a. Monad m => e -> ExceptT e m a
throwE
  {-# INLINE throwError' #-}
  catchError' :: ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
catchError' = ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
forall (m :: SomeMonad) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
catchE
  {-# INLINE catchError' #-}

-- | Lifts an @'Either' e@ into any @'Error'' e@.
liftEither' :: forall tag e m a. Error' tag e m => Either e a -> m a
liftEither' :: Either e a -> m a
liftEither' = (e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall k (tag :: k) e (m :: SomeMonad) a.
Error' tag e m =>
e -> m a
forall e (m :: SomeMonad) a. Error' tag e m => e -> m a
throwError' @tag) a -> m a
forall (f :: SomeMonad) a. Applicative f => a -> f a
pure
{-# INLINE liftEither' #-}

-- | The untagged version of 'liftEither''.
liftEither :: Error e m => Either e a -> m a
liftEither :: Either e a -> m a
liftEither = forall k (tag :: k) e (m :: SomeMonad) a.
Error' tag e m =>
Either e a -> m a
forall e (m :: SomeMonad) a. Error' G e m => Either e a -> m a
liftEither' @G
{-# INLINE liftEither #-}

-- | Runs the error effect by wrapping exceptions in the 'Either' type.
runError' :: (Error' tag e `Via` ExceptT e) m a -> m (Either e a)
runError' :: Via (Error' tag e) (ExceptT e) m a -> m (Either e a)
runError' = Via (Error' tag e) (ExceptT e) m a -> m (Either e a)
forall a b. Coercible a b => a -> b
coerce
{-# INLINE runError' #-}

-- | The untagged version of 'runError''.
runError :: (Error e `Via` ExceptT e) m a -> m (Either e a)
runError :: Via (Error e) (ExceptT e) m a -> m (Either e a)
runError = Via (Error e) (ExceptT e) m a -> m (Either e a)
forall a b. Coercible a b => a -> b
coerce
{-# INLINE runError #-}