[Haskell-cafe] Partially-applied type synonyms?

Lyle Kopnicky lists at qseep.net
Mon Aug 30 20:09:39 EDT 2004


Hi all,

I'm trying to write a monad transformer class called MonadPCont, for 
partial continuations, which fits in with the Control.Monad libraries.  
I'm having a typing problem.  What I have so far looks like this:

--------------------
module MonadPCont where

import Control.Monad
import Control.Monad.Cont
import Control.Monad.Trans
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.RWS

class (Monad (mc a), Monad (mc r)) => MonadPCont mc a r where
    shift :: ((forall b. Monad (mc b) => a -> mc b r) -> mc r r) -> mc r a
    reset :: mc a a -> mc r a

instance MonadPCont Cont a r where
    shift f = Cont (\c -> runCont (f (\x -> Cont (\c' -> c' (c x)))) id)
    reset m = Cont (\c -> c (runCont m id))

type ContT' m r a = ContT r m a

instance Monad m => MonadPCont (ContT' m) a r where
    shift f = ContT (\c ->
                     runContT (f (\x -> ContT (\c' -> c x >>= c'))) return)
    reset m = ContT (\c -> runContT m return >>= c)
--------------------

The error I get is:

MonadPCont.hs:21:
    Type synonym `ContT'' should have 3 arguments, but has been given 1
    In the instance declaration for `MonadPCont (ContT' m) i o'
Failed, modules loaded: none.

I guess it's not possible to partially apply a synonym for a type 
constructor.  Essentially, I'm trying to do a 'flip', but at the type level.

The underlying problem is that ContT is written to take the final result 
type (call it 'r') as the first parameter, and the underlying monad 
(call it 'm') as the second parameter, e.g. 'ContT r m a'.  This is done 
so that 'ContT r' can be made an instance of the MonadTrans class.

Unfortunately, I need 'PI r -> ContT r m', along with a and r, to be a 
member of the MonadPCont class (PI is the type binding operator).  So I 
thought I'd define ContT' to take the arguments the other way around.  
Unfortunately, it can't be partially applied.

Any ideas, or is it just not feasible to work this class into the library?

Thanks,
Lyle Kopnicky


More information about the Haskell-Cafe mailing list