[Haskell-cafe] Type famillies & Lifting IO

Maciej Piechotka uzytkownik2 at gmail.com
Wed May 19 06:05:49 EDT 2010


I started playing with type families. I wanted to achieve, for the
beginning, something like:

> import qualified Control.Monad.IO.Class as IOC
> import Control.Monad.Trans.Class
> import Control.Monad.Trans.Cont
> import Data.Functor.Identity

> class (Monad m, Monad (IO' m)) => MonadIO m where
>     type IO' m :: * -> *
>     liftIO :: IO a -> IO' m a
>     liftM :: m a -> IO' m a

It allows to add IO to computation even if computation originally was
'pure'.

First step was easy:

> instance MonadIO Identity where
>     type IO' Identity = IO
>     liftIO = id
>     liftM = return . runIdentity
> 
> instance MonadIO IO where
>     type IO' IO = IO
>     liftIO = id
>     liftM = id
> 
> instance MonadIO (ST r) where
>     type IO' (ST r) = IO
>     liftIO = id
>     liftM = unsafeSTToIO
> 
> --instance IOC.MonadIO m => MonadIO m where
>     --type IO' m = m
>     --liftIO = IOC.liftIO
>     --liftM = id

However I run into problems - this code doesn't want to compile:

> instance MonadIO m => MonadIO (ContT r m) where
>     type IO' (ContT r m) = ContT r (IO' m)
>     liftIO f = ContT $ \cont -> liftIO f >>= cont
>     liftM f = ContT $ \cont -> liftM f >>= cont

Or this:

> instance MonadIO m => MonadIO (ContT r m) where
>     type IO' (ContT r m) = ContT r (IO' m)
>     liftIO f = lift . liftIO
>     liftM f = lift . liftIO

In fact there is strange interfering types of ghci:

ghci> :t lift . liftIO
lift . liftIO
  :: (m ~ IO' m1, MonadTrans t, Monad m, MonadIO m1) => IO a -> t m a
ghci> :t lift . liftIO :: (m ~ IO' m1, MonadTrans t, Monad m, MonadIO
m1) => IO a -> t m a

<interactive>:1:7:
    Couldn't match expected type `IO' m' against inferred type `m1'
      `m1' is a rigid type variable bound by
           an expression type signature at <interactive>:1:18
      NB: `IO'' is a type function, and may not be injective
    In the second argument of `(.)', namely `liftIO'
    In the expression:
            lift . liftIO ::
            (m ~ (IO' m1), MonadTrans t, Monad m, MonadIO m1) => IO a ->
t m a

What's the problem? I guess I don't understand something basic about
type famillies.

Regards
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 836 bytes
Desc: This is a digitally signed message part
Url : http://www.haskell.org/pipermail/haskell-cafe/attachments/20100519/472b57d8/attachment.bin


More information about the Haskell-Cafe mailing list