Pourquoi ContT ne peut-il pas être un instance de MonadError?

Question

J'ai une pile de monades transformées comprenant un ErrorT et je veux envelopper un transformateur ContT r autour de tout cela. Lorsque j'essaie de le faire, mes appels à throwError génèrent des erreurs de type - apparemment ContT r n'est pas automatiquement une instance de MonadError. Bon, je pensais - je vais simplement en faire une :

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

en utilisant une définition adaptée de liftCatch. Mais maintenant j'obtiens des erreurs lors de la compilation :

src\Language\Types.hs:68:10:
    Déclaration d'instance illégale pour `MonadError e (ContT r m)'
      (la Condition de Couverture échoue pour l'une des dépendances fonctionnelles ;
       Utilisez -XUndecidableInstances pour autoriser cela)
    Dans la déclaration d'instance pour `MonadError e (ContT r m)'

Je suis prêt à utiliser la directive UndecidableInstances (j'ai l'impression que ce n'est pas trop inquiétant, voir par exemple cette question), mais je me demandais s'il y avait une difficulté à faire du transformateur de continuation une instance de MonadError - je suppose que si c'était le cas, les auteurs du package Control.Monad.Trans l'auraient déjà fait... non ?

Answer 1

ContT et ErrorT permettent tous deux un flux de contrôle non standard. Il existe un moyen d'encapsuler le type ErrorT autour de ContT dans mtl:

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

Mais ces deux transformateurs de monades ne commutent pas. En se souvenant de:

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) () qui est correct dans le package mtl pourrait être:

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

ContT r (ErrorT e Identity) a n'est pas correct dans le package mtl. Mais vous pouvez l'écrire.

Quelles sont les sémantiques de (>>=) que vous souhaitez dans la monade combinée? Comment souhaitez-vous que votre pile de gestionnaires d'erreurs imbriqués interagisse avec nonlocal callCC?

Voici comment je pourrais l'écrire:

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

-}

Ainsi, ce qui précède fonctionne avec juste le mtl, voici la nouvelle instance et comment elle fonctionne:

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"

-}