{-| Module : Control.Monad.Freer.Catching Description : Handle exceptions that are thrown during interpreation of free monad effects, at call time. Copyright : (c) Ben Weitzman 2018 License : MIT Maintainer : ben@costarastrolgoy.com Stability : experimental Portability : POSIX The 'Catching' effect allows a way to keep track of effects that we might expect to throw exceptions during their handling, but whose signatures don't indicate this. As an example, consider an effect @Div@ that divides numbers: @ data Div a where Div :: Int -> Int -> Div Int @ The keen programmer is aware that this can throw an error. However, suppose that there is reason to believe that this effect will be rarely used in a way that fails. Adding an indicator to the interface (such as by saying @Div :: Int -> Int -> Div (Maybe Int)@) makes using this effect more annoying most of the time. Nevertheless, it should be possible to handle this case when we want to. This is where 'Catching' can help. -} module Control.Monad.Freer.Catching (Catching ,catching ,runCatching ,runCatching2 ) where import Control.Exception import Control.Monad import Control.Monad.Freer import Control.Monad.Freer.Internal import Data.OpenUnion.Internal -- | The 'Catching' effect is parameterized by the effect it is handling and the type of exceptions it will -- attempt to handle (e.g. @Catching Div ArithException@) data Catching f e a where Catching :: forall f e a . (Exception e) => (forall r . Member f r => Eff r a) -> Catching f e (Either e a) -- | @catching@ will turn an effectful computation producing an @a@ and using effect @f@ into one that produces -- an @Either e a@. This allows any exception that is thrown during normal handling of @f@ be handled explicitly. catching :: forall e f a r . (Exception e, Member (Catching f e) r) => Eff '[f] a -> Eff r (Either e a) catching f = send @(Catching f e) $ Catching (generalize f) generalize :: Member f r => Eff '[f] a -> Eff r a generalize (Val x) = return x generalize (E u' q) = send (extract u') >>= qComp q generalize -- | Handle an effect @f@ and a @Catching f e@ simultaneously. In cases where 'catching' was called, on an -- effect, exceptions of type @e@ will be caught and handled. In cases where 'catching' was not called but -- @f@ was used directly, exceptions will not be caught and will bubble up. runCatching :: forall e r v f . (Member IO r, LastMember IO (f ': r)) => (forall a q . Member IO q => Eff (f ': q) a -> Eff q a) -> Eff (Catching f e : f : r) v -> Eff r v runCatching runner = runner . interpretM handler where handler :: Catching f e a -> IO a handler (Catching f) = do x <- try . runM $ evaluate <$> runner f case x of Left e -> return $ Left e Right y -> try y -- | 'runCatching2' can catch exceptions in effects that don't interpret directly to 'IO' but instead -- go through an intermediary effect. In this case, three effects will be handled in one go: -- -- * The effect @f@ that is being called and is expected to be the source of an exception -- * The effect @g@ which is not being called directly but is called instead by the handler @f@ -- * The effect @Catching f e@ runCatching2 :: forall e r v f g . (Member IO r, Member IO (f : r), LastMember IO (f : g : r)) => (forall a q. Member g q => Eff (f : q) a -> Eff q a) -> (forall a q. Member IO q => Eff (g : q) a -> Eff q a) -> Eff (Catching f e : f : g : r) v -> Eff r v runCatching2 runner1 runner2 = runner2 . runner1 . interpretM handler where handler :: Catching f e a -> IO a handler (Catching f) = do x <- try . runM $ evaluate <$> (runner2 . runner1 $ f) case x of Left e -> return $ Left e Right y -> try y