simple-effects 0.5.0.2 → 0.5.0.3

raw patch · 2 files changed

+28/−4 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• simple-effects.cabal +1/−1
• src/Control/Effects/Signal.hs +27/−3

@@ -1,5 +1,5 @@ name:                simple-effects
-version:             0.5.0.2
+version:             0.5.0.3
 synopsis:            A simple effect system that integrates with MTL
 description:         Please see README.md
 homepage:            https://gitlab.com/LukaHorvat/simple-effects

@@ -3,10 +3,12 @@ {-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
 module Control.Effects.Signal
     ( MonadEffectSignal(..), ResumeOrBreak(..), throwSignal, handleSignal, handleAsException
-    , Throws, handleException, handleToEither, module Control.Effects ) where
+    , 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
 
@@ -14,8 +16,14 @@ type instance EffectMsg (Signal a b) = a
 type instance EffectRes (Signal a b) = b
 
-instance Monad m => MonadEffect (Signal e b) (ExceptT e m) where
+data SomeSignal = SomeSignal { getSomeSignal :: Text } deriving (Eq, Ord, Read, Show)
+
+instance {-# OVERLAPPABLE #-} 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
 
 -- | This class allows you to "throw" a signal. For the most part signals are the same as checked
 --   exceptions. The difference here is that the handler has the option to provide the value that
@@ -32,7 +40,9 @@ type Throws e m = MonadEffectSignal e Void m
 
 instance Monad m => MonadEffectSignal a b (EffectHandler (Signal a b) m)
-instance Monad m => MonadEffectSignal e Void (ExceptT e m)
+instance Monad m => MonadEffectSignal a Void (MaybeT m)
+instance {-# OVERLAPPABLE #-} Monad m => MonadEffectSignal e Void (ExceptT e m)
+instance (Monad m, Show e) => MonadEffectSignal e Void (ExceptT SomeSignal m)
 instance {-# OVERLAPPABLE #-} (MonadEffectSignal a b m, MonadTrans t, Monad (t m))
          => MonadEffectSignal a b (t m)
 
@@ -89,3 +99,17 @@ -- | See documentation for 'handleException'. This handler gives you an 'Either'.
 handleToEither :: ExceptT e m a -> m (Either e a)
 handleToEither = runExceptT
+
+-- | Discard all the 'Throws' constraints. If any exception was thrown the result will be
+--   'Nothing'.
+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
+
+-- | Satisfies all the 'Throws' constraints _if_ they all throw 'Show'able exceptions. The first
+--   thrown exception will be shown and returned as a 'Left' result.
+showAllExceptions :: Functor m => ExceptT SomeSignal m a -> m (Either Text a)
+showAllExceptions = fmap (mapLeft getSomeSignal) . runExceptT