[Haskell-cafe] Defining instance needs allow-undecidable-instance?
oleg at pobox.com
oleg at pobox.com
Tue Mar 28 03:40:21 EST 2006
Daniel McAllansmith wrote:
> When I try to add MonadError into the types I eventually hit the
> requirement for allow-undecidable-instances. Is there some way I can
> I avoid having to use this extension?
>
> class (Num i, Bounded i, Monad m, MonadError String m)
> => MonadSource i m | m -> i where
The constraint |MonadError String m| that shows up in the class (and
hence, eventually) instance context contains a type constant
String. Such constraints indeed require
'allow-undecidable-instances'. It is possible to get around such
requirement in some cases, by `shifting the blame (that is, the
constraint)':
> {-# OPTIONS -fglasgow-exts #-}
>
> import Control.Monad
> import Control.Monad.Identity
> import Control.Monad.Trans
> import Control.Monad.Error
> import Control.Monad.State
>
> class (Num i, Bounded i, Monad m)
> => MonadSource i m | m -> i where
> foo :: MonadError String m => m i
>
> newtype SourceT i m a = SourceT (StateT i m a)
> deriving (Functor, Monad, MonadIO, MonadTrans, MonadError String)
>
> runSourceT (SourceT m) = runStateT m 10
>
> instance (Num i, Bounded i, Monad m)
> => MonadSource i (SourceT i m) where
> foo = if True then return 1 else throwError "error"
>
> test :: Either String (Int,Int) = runIdentity . runErrorT . runSourceT $ foo
More information about the Haskell-Cafe
mailing list