Let's say I have some very complex set of computations of the form computation :: IO a
that I cannot modify, due to it being from some library code or other reasons. Let's also say I want to provide some type-level guarantees that we aren't able to launch nuclear missiles in the midst of using these computations, so we use polysemy
and wrap all these up into its own DSL Library
. We can naively interpret this with
runLibraryIO :: Member (Embed IO) r => Sem (Library ': r) a -> Sem r a
runLibraryIO = interpret $ \case
Computation -> embed computation
-- ...
This is all well and good, but computation
can throw exceptions! We quickly throw up some code and are able to lift a single type of exception into polysemy
. We write the helper
withIOError :: forall e r a . (Exception e, Members '[Embed IO, Error e] r) => IO a -> Sem r a
withIOError action = do
res <- embed $ try action
case res of
Left e -> throw @e e
Right x -> pure x
and then our interpreter becomes
runLibraryIO :: Members '[Embed IO, Error MyException] r => Sem (Library ': r) a -> Sem r a
runLibraryIO = interpret $ withIOError @MyException . \case
Computation -> computation
-- ...
but we quickly notice this is not extensible. In particular, we are only able to lift a single type of exception, and it's limited to computations in IO
. We cannot dive arbitrarily deep into a monad that contains exceptions and transfer it out in a nice and pure manner. If for whatever reason we discover a corner case where computation
may throw MyException'
, we have no way of inserting support for this and catching it elsewhere in our code!
Is there something I am missing in the library that allows me to do this? Am I stuck with dealing with exceptions in IO
? Some guidance on where to go forward from here and make this sufficiently polymorphic would be greatly appreciated.
We can solve this with a lower
interpreter. Thanks @KingoftheHomeless.
withException :: forall e r a . (E.Exception e, Member IOError r, Member (Error e) r) => Sem r a -> Sem r a
withException action = catchIO @r @e action throw
lowerIOError :: Member (Embed IO) r => (forall x. Sem r x -> IO x) -> Sem (IOError ': r) a -> Sem r a
lowerIOError lower = interpretH $ \case
ThrowIO e -> embed $ E.throwIO e
CatchIO m h -> do
m' <- lowerIOError lower <$> runT m
h' <- (lowerIOError lower .) <$> bindT h
s <- getInitialStateT
embed $ lower m' `E.catch` \e -> lower (h' (e <$ s))
See this gist for it in action.