simple-effects 0.3.0.2 → 0.4.0.0

raw patch · 4 files changed

+29/−24 lines, 4 files

Files

• simple-effects.cabal +1/−1
• src/Control/Effects.hs +1/−1
• src/Control/Effects/Signal.hs +26/−21
• src/Control/Effects1.hs +1/−1

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

@@ -18,7 +18,7 @@     -- | Use the effect described by 'eff'.
     effect :: proxy eff -> EffectMsg eff -> m (EffectRes eff)
 
--- | The 'EffectHandler' is rally just a 'ReaderT' carrying around the function that knows how to
+-- | The 'EffectHandler' is really just a 'ReaderT' carrying around the function that knows how to
 --   handle the effect.
 newtype EffectHandler eff m a = EffectHandler
     { unpackEffectHandler :: ReaderT (EffectMsg eff -> m (EffectRes eff)) m a }

@@ -7,6 +7,7 @@ 
 import Interlude
 import Prelude (Show(..))
+import Control.Monad.Trans.Except
 
 import Control.Effects
 
@@ -31,37 +32,41 @@          => MonadEffectSignal a b (t m)
 
 -- | The handle function will return a value of this type.
-data ResumeOrBreak b c = Resume b -- ^ Give a value to the caller of @signal@ and keep going.
+data ResumeOrBreak b c = Resume b -- ^ Give a value to the caller of 'signal' and keep going.
                        | Break c -- ^ Continue the execution after the handler. The handler will
                                  --   return this value
 
-data NoResume a = NoResume a deriving (Eq, Ord)
-instance Show (NoResume a) where
-    show = const "NoResume"
-instance Typeable a => Exception (NoResume a)
-
--- | Throw a signal with no possible recovery. The handler is forced to only return the @Break@
---   constructor because it cannot construct a @Void@ value.
+-- | Throw a signal with no possible recovery. The handler is forced to only return the 'Break'
+--   constructor because it cannot construct a 'Void' value.
 --
---   If this function is used along with @handleAsException@, this module behaves like regular
+--   If this function is used along with 'handleAsException', this module behaves like regular
 --   checked exceptions.
 throwSignal :: MonadEffectSignal a Void 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
+
 -- | Handle signals of a computation. The handler function has the option to provide a value
---   to the caller of @signal@ and continue execution there, or do what regular exception handlers
+--   to the caller of 'signal' and continue execution there, or do what regular exception handlers
 --   do and continue execution after the handler.
-handleSignal :: (MonadCatch m, Typeable c)
-             => (a -> m (ResumeOrBreak b c)) -> EffectHandler (Signal a b) m c -> m c
-handleSignal f a =
-    handle (\(NoResume c) -> return c) $ handleEffect (\s -> do
-        rb <- f s
-        case rb of
-            Resume b -> return b
-            Break c -> throwM (NoResume c)) 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)
 
--- | This handler can only behave like a regular exception handler. If used along with @throwSignal@
+-- | This handler can only behave like a regular exception handler. If used along with 'throwSignal'
 --   this module behaves like regular checked exceptions.
-handleAsException :: (MonadCatch m, Typeable c)
-                => (a -> m c) -> EffectHandler (Signal a b) m c -> m c
+handleAsException :: Monad m
+                  => (a -> m c)
+                  -> EffectHandler (Signal a b) (ExceptT c m) c
+                  -> m c
 handleAsException f = handleSignal (fmap Break . f)

@@ -20,7 +20,7 @@ newtype EffHandling1 eff m = EffHandling1 {
     getHandling1 :: forall a. EffectCon1 eff a => EffectMsg1 eff a -> m (EffectRes1 eff a) }
 
--- | The 'EffectHandler1' is rally just a 'ReaderT' carrying around the function that knows how to
+-- | The 'EffectHandler1' is really just a 'ReaderT' carrying around the function that knows how to
 --   handle the effect.
 newtype EffectHandler1 eff m a = EffectHandler1
     { unpackEffectHandler1 :: ReaderT (EffHandling1 eff m) m a }