module Control.Effects.Signal
( MonadEffectSignal(..), ResumeOrBreak(..), throwSignal, handleSignal, handleAsException
, Throws, handleException, handleToEither, module Control.Effects
, module Control.Monad.Trans.Except, MaybeT(..), discardAllExceptions, showAllExceptions ) where
import Interlude
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Control.Effects
data Signal a b
type instance EffectMsg (Signal a b) = a
type instance EffectRes (Signal a b) = b
data SomeSignal = SomeSignal { getSomeSignal :: Text } deriving (Eq, Ord, Read, Show)
instance Monad m => MonadEffect (Signal e Void) (ExceptT e m) where
effect _ = throwE
instance (Show e, Monad m) => MonadEffect (Signal e Void) (ExceptT SomeSignal m) where
effect _ = throwE . SomeSignal . pshow
instance Monad m => MonadEffect (Signal a Void) (MaybeT m) where
effect _ _ = mzero
class MonadEffect (Signal a b) m => MonadEffectSignal a b m | m a -> b where
signal :: a -> m b
signal = effect (Proxy :: Proxy (Signal a b))
type Throws e m = MonadEffectSignal e Void m
instance Monad m => MonadEffectSignal a b (EffectHandler (Signal a b) m)
instance Monad m => MonadEffectSignal a Void (MaybeT m)
instance Monad m => MonadEffectSignal e Void (ExceptT e m)
instance (Monad m, Show e) => MonadEffectSignal e Void (ExceptT SomeSignal m)
instance (MonadEffectSignal a b m, MonadTrans t, Monad (t m))
=> MonadEffectSignal a b (t m)
data ResumeOrBreak b c = Resume b
| Break c
throwSignal :: Throws a m => a -> m b
throwSignal = fmap absurd . signal
resumeOrBreak :: (b -> a) -> (c -> a) -> ResumeOrBreak b c -> a
resumeOrBreak ba _ (Resume b) = ba b
resumeOrBreak _ ca (Break c) = ca c
collapseEither :: Either a a -> a
collapseEither (Left a) = a
collapseEither (Right a) = a
handleSignal :: Monad m
=> (a -> m (ResumeOrBreak b c))
-> EffectHandler (Signal a b) (ExceptT c m) c
-> m c
handleSignal f = fmap collapseEither
. runExceptT
. handleEffect (resumeOrBreak return throwE <=< lift . f)
handleAsException :: Monad m
=> (a -> m c)
-> EffectHandler (Signal a b) (ExceptT c m) c
-> m c
handleAsException f = handleSignal (fmap Break . f)
handleException :: Monad m => (a -> m c) -> ExceptT a m c -> m c
handleException f = either f return <=< runExceptT
handleToEither :: ExceptT e m a -> m (Either e a)
handleToEither = runExceptT
discardAllExceptions :: MaybeT m a -> m (Maybe a)
discardAllExceptions = runMaybeT
mapLeft :: (a -> c) -> Either a b -> Either c b
mapLeft f (Left a) = Left (f a)
mapLeft _ (Right b) = Right b
showAllExceptions :: Functor m => ExceptT SomeSignal m a -> m (Either Text a)
showAllExceptions = fmap (mapLeft getSomeSignal) . runExceptT