Tại sao ContT không thể tạo một thể hiện của MonadError?

Question

Tôi có một ngăn biến đổi đơn nguyên bao gồm ErrorT và tôi muốn bọc một máy biến áp ContT r xung quanh toàn bộ vật. Khi tôi cố gắng thực hiện điều đó, các cuộc gọi của tôi tới số throwError tạo ra lỗi loại - dường như ContT r không tự động là một phiên bản của MonadError. Tốt thôi, tôi nghĩ - Tôi sẽ chỉ làm cho nó thành một:

instance MonadError e m => MonadError e (ContT r m) where 
    throwError = lift . throwError 
    catchError = liftCatch . catchError 

sử dụng một số định nghĩa phù hợp của liftCatch. Nhưng bây giờ tôi nhận được lỗi khi biên dịch:

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)' 

Tôi rất sẵn lòng sử dụng UndecidableInstances pragma (Tôi theo ấn tượng nó không quá đáng lo ngại, ví dụ như thấy this question) nhưng tôi tự hỏi nếu có một khó khăn trong việc đưa ra biến áp tiếp tục thành một thể hiện của MonadError - Tôi đoán rằng nếu nó là tốt, các tác giả của gói Control.Monad.Trans sẽ làm điều đó ... đúng không?

Answer 1

ContT và ErrorT đều cho phép luồng kiểm soát không chuẩn. Có một cách để bọc loại ErrorT xung quanh ContT trong mtl:

instance (Error e, MonadCont m) => MonadCont (ErrorT e m) 

Nhưng hai máy biến áp đơn nguyên này không đi làm. Remembering:

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} 

ErrorT String (ContT Bool Identity)() đó là thoải mái với gói mtl có thể là:

ErrorT (ContT (\ (k :: Either String() -> Identity Bool) -> k (Right()))) 

ContT r (ErrorT e Identity) a là không ổn trong gói mtl. Nhưng bạn có thể viết nó.

Ngữ nghĩa của (>> =) bạn muốn trong đơn nguyên kết hợp là gì? Làm thế nào để bạn mong đợi chồng của bạn xử lý lỗi lồng nhau để tương tác với callCC nonlocal?

Dưới đây là làm thế nào tôi có thể viết nó:

{-# 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 

-} 

Vì vậy, các công trình trên chỉ với mtl, đây là ví dụ mới và làm thế nào nó hoạt động:

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" 

-}