module HaskellWorks.Polysemy.Error
  ( module HaskellWorks.Error
  , trap
  , trap_
  ) where

import           HaskellWorks.Error
import           HaskellWorks.Polysemy.Prelude
import           Polysemy
import           Polysemy.Error

-- | Run a computation that may fail, and handle the error case.
-- Unlike 'catch' from 'Polysemy.Error' this function removes the 'Error'
-- effect from the stack.
trap :: forall e r a. ()
  => (e -> Sem r a)
  -> Sem (Error e ': r) a
  -> Sem r a
trap :: forall e (r :: EffectRow) a.
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap e -> Sem r a
h Sem (Error e : r) a
f =
  Sem (Error e : r) a -> Sem r (Either e a)
forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError Sem (Error e : r) a
f Sem r (Either e a) -> (Either e a -> Sem r a) -> Sem r a
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> Sem r a) -> (a -> Sem r a) -> Either e a -> Sem r a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Sem r a
h a -> Sem r a
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Like 'trap', but the error is not passed to the handler.
trap_ :: forall e r a. ()
  => Sem r a
  -> Sem (Error e ': r) a
  -> Sem r a
trap_ :: forall e (r :: EffectRow) a.
Sem r a -> Sem (Error e : r) a -> Sem r a
trap_ Sem r a
h =
  (e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
forall e (r :: EffectRow) a.
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap (Sem r a -> e -> Sem r a
forall a b. a -> b -> a
const Sem r a
h)