我有一个包含ErrorT
的monad变换器堆栈,我想围绕整个事件包装一个ContT r
变换器。当我尝试这样做时,我对throwError
的调用会生成类型错误 - 显然ContT r
不会自动成为MonadError
的实例。好吧,我想 - 我会把它变成一个:
instance MonadError e m => MonadError e (ContT r m) where
throwError = lift . throwError
catchError = liftCatch . catchError
使用liftCatch
的一些合适定义。但是现在我在编译时遇到错误:
src\Language\Types.hs:68:10:
Illegal instance declaration for `MonadError e (ContT r m)'
(the Coverage Condition fails for one of the functional dependencies;
Use -XUndecidableInstances to permit this)
In the instance declaration for `MonadError e (ContT r m)'
我很高兴使用UndecidableInstances pragma(我的印象并不是太令人担忧,例如参见this question)但我想知道将延续变换器变成{的实例是否有困难{1}} - 我想如果一切正常,那么MonadError
包的作者就已经做过了......对吗?
答案 0 :(得分:8)
ContT和ErrorT都允许非标准控制流程。有一种方法可以在mtl:
中围绕ContT包装ErrorT类型instance (Error e, MonadCont m) => MonadCont (ErrorT e m)
但这两个monad变形金刚不通勤。记住:
newtype Identity a = Identity {runIdentity :: a}
newtype ErrorT e m a = ErrorT {runErrorT :: m (Either e a)}
newtype ContT r m a = ContT {runContT :: (a -> m r) -> m r}
在包mtl中可以的 ErrorT String (ContT Bool Identity) ()
可能是:
ErrorT (ContT ( \ (k :: Either String () -> Identity Bool) -> k (Right ()) ) )
包mtl中的 ContT r (ErrorT e Identity) a
不合适。但你可以写出来。
组合monad中你想要的(>> =)语义是什么?您如何期望堆栈的嵌套错误处理程序与非本地callCC进行交互?
以下是我可以写的方式:
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
import Control.Monad
import Control.Monad.Cont
import Control.Monad.Error
import Data.Function
import Data.IORef
handleError :: MonadError e m => (e -> m a) -> m a -> m a
handleError = flip catchError
test2 :: ErrorT String (ContT () IO) ()
test2 = handleError (\e -> throwError (e ++ ":top")) $ do
x <- liftIO $ newIORef 1
label <- callCC (return . fix)
v <- liftIO (readIORef x)
liftIO (print v)
handleError (\e -> throwError (e ++ ":middle")) $ do
when (v==4) $ do
throwError "ouch"
when (v < 10) $ do
liftIO (writeIORef x (succ v))
handleError (\e -> throwError (e ++ ":" ++ show v)) label
liftIO $ print "done"
go2 = runContT (runErrorT test2) (either error return)
{-
*Main> go2
1
2
3
4
*** Exception: ouch:middle:top
-}
所以上面只使用mtl,这是新实例及其工作原理:
instance MonadError e m => MonadError e (ContT r m) where
throwError = lift . throwError
catchError op h = ContT $ \k -> catchError (runContT op k) (\e -> runContT (h e) k)
test3 :: ContT () (ErrorT String IO) ()
test3 = handleError (\e -> throwError (e ++ ":top")) $ do
x <- liftIO $ newIORef 1
label <- callCC (return . fix)
v <- liftIO (readIORef x)
liftIO (print v)
handleError (\e -> throwError (e ++ ":middle")) $ do
when (v==4) $ do
throwError "ouch"
when (v < 10) $ do
liftIO (writeIORef x (succ v))
handleError (\e -> throwError (e ++ ":" ++ show v)) label
liftIO $ print "done"
go3 = runErrorT (runContT test3 return)
{-
*Main> go3
1
2
3
4
Left "ouch:middle:3:middle:2:middle:1:middle:top"
-}