Perché non può essere eseguita un'istanza di MonadError in ContT?

Question

Ho una pila di trasformatori monad incluso uno ErrorT e voglio avvolgere un trasformatore ContT r attorno al tutto. Quando provo a farlo, le mie chiamate a throwError generano errori di tipo - apparentemente ContT r non è automaticamente un'istanza di MonadError. Bene, ho pensato - mi rifarò in uno:

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

con qualche definizione adeguata di liftCatch. Ma ora ho errori durante la compilazione:

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

Sono felice di usare la direttiva UndecidableInstances (io sono sotto l'impressione che non sia troppo preoccupante, ad esempio, vedi this question), ma mi chiedevo se ci fosse una difficoltà nel fare il trasformatore di continuazione in un'istanza di MonadError - Immagino che se fosse andato bene, gli autori del pacchetto Control.Monad.Trans lo avrebbero già fatto ... giusto?

Answer 1

ContT e ErrorT entrambi consentono il flusso di controllo non standard. C'è un modo per avvolgere il tipo ErrorT intorno ContT in mtl:

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

Ma questi due trasformatori monade non commutano. Ricordando:

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)(), che va bene nel pacchetto mtl potrebbe essere:

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

ContT r (ErrorT e Identity) a non va bene nel pacchetto mtl. Ma puoi scriverlo.

Quali sono le semantiche di (>> =) che si desidera nella monade combinata? Come ti aspetti che il tuo stack di gestori di errori annidati interagisca con callCC non locale?

Ecco come potrei scriverlo:

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

-} 

Così le opere di cui sopra con il solo mtl, ecco la nuova istanza e come funziona:

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" 

-}