2012-05-24 7 views
5

Ich habe einen Monad Transformator Stack einschließlich einer ErrorT und ich möchte einen ContT r Transformator um die ganze Sache wickeln. Wenn ich das versuche, generieren meine Aufrufe an throwError Typfehler - anscheinend ContT r ist nicht automatisch eine Instanz von MonadError. Gut, dachte ich - ich werde es einfach machen in einem:Warum kann ContT nicht zu einer Instanz von MonadError gemacht werden?

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

eine geeignete Definition von liftCatch verwenden. Aber ich jetzt Fehlermeldungen erhalte beim Kompilieren:

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

Ich bin glücklich, die UndecidableInstances Pragma zu verwenden (ich habe den Eindruck, es ist nicht zu Besorgnis erregend, siehe zB this question), aber ich fragte mich, ob es eine Schwierigkeit war, bei der Herstellung von die Fortsetzung Transformator in eine Instanz von MonadError - Ich denke, wenn es in Ordnung wäre, hätten die Autoren der Control.Monad.Trans Paket schon getan ... oder?

+1

Es ist in Ordnung, aber tut Nehmen Sie UndecidableInstances, was für die Autoren der Transformatorenbibliothek zu gefährlich und nicht portabel ist. –

Antwort

8

ContT und ErrorT ermöglichen beide einen nicht standardmäßigen Steuerungsablauf. Es gibt einen Weg, um die ErrorT Typ um ContT in mtl zu wickeln:

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

Aber diese beiden Monade Transformatoren pendeln nicht. 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)(), die im Paket mtl in Ordnung ist, könnte sein:

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

ContT r (ErrorT e Identity) a ist nicht in Ordnung, im Paket mtl. Aber du kannst es schreiben.

Was ist die Semantik von (>> =) in der kombinierten Monade? Wie erwarten Sie, dass Ihr Stapel verschachtelter Fehlerhandler mit nicht lokalem callCC interagieren?

Hier ist, wie ich es schreiben könnte:

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

-} 

So die oben genannten Arbeiten nur mit dem mtl, hier ist die neue Instanz und wie es funktioniert:

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" 

-}