module Control.Eff.Exception( Exc (..)
, Fail
, throwExc
, die
, runExc
, runFail
, catchExc
, onFail
, rethrowExc
, liftEither
, liftEitherM
, liftMaybe
, ignoreFail
) where
import Control.Monad (void)
import Data.Typeable
import Control.Eff
import Control.Eff.Lift
#if __GLASGOW_HASKELL__ >= 708
#define Typeable1 Typeable
#endif
newtype Exc e v = Exc e
deriving (Functor, Typeable)
type Fail = Exc ()
throwExc :: (Typeable e, Member (Exc e) r) => e -> Eff r a
throwExc e = send . inj $ Exc e
die :: Member Fail r => Eff r a
die = throwExc ()
runExc :: Typeable e => Eff (Exc e :> r) a -> Eff r (Either e a)
runExc = loop
where
loop = freeMap
(return . Right)
(\u -> handleRelay u loop (\(Exc e) -> return (Left e)))
runFail :: Eff (Fail :> r) a -> Eff r (Maybe a)
runFail = fmap (either (const Nothing) Just) . runExc
catchExc :: (Typeable e, Member (Exc e) r)
=> Eff r a
-> (e -> Eff r a)
-> Eff r a
catchExc m handle = loop m
where
loop = freeMap
return
(\u -> interpose u loop (\(Exc e) -> handle e))
onFail :: Eff (Fail :> r) a
-> Eff r a
-> Eff r a
onFail e handle = runFail e >>= maybe handle return
rethrowExc :: (Typeable e, Typeable e', Member (Exc e') r)
=> (e -> e')
-> Eff (Exc e :> r) a
-> Eff r a
rethrowExc t eff = runExc eff >>= either (throwExc . t) return
liftEither :: (Typeable e, Member (Exc e) r) => Either e a -> Eff r a
liftEither (Left e) = throwExc e
liftEither (Right a) = return a
liftEitherM :: (Typeable1 m, Typeable e, Member (Exc e) r, SetMember Lift (Lift m) r)
=> m (Either e a)
-> Eff r a
liftEitherM m = lift m >>= liftEither
liftMaybe :: Member Fail r => Maybe a -> Eff r a
liftMaybe = maybe die return
ignoreFail :: Eff (Fail :> r) a
-> Eff r ()
ignoreFail e = void e `onFail` return ()