<div dir="ltr">I'm trying to extract an "unlift" function from monad-control, which would allow stripping off a layer of a transformer stack in some cases. It's easy to see that this works well for ReaderT, e.g.:<br><br><div>{-# LANGUAGE RankNTypes #-}</div><div>{-# LANGUAGE TypeFamilies #-}</div><div>import Control.Monad.Trans.Control</div><div>import Control.Monad.Trans.Reader</div><div><br></div><div>newtype Unlift t = Unlift { unlift :: forall n b. Monad n => t n b -> n b }</div><div><br></div><div>askRun :: Monad m => ReaderT r m (Unlift (ReaderT r))</div><div>askRun = liftWith (return . Unlift)</div><div><br></div><div>The reason this works is that the `StT` associated type for `ReaderT` just returns the original type, i.e. `type instance StT (ReaderT r) m a = a`. In theory, we should be able to generalize `askRun` to any transformer for which that applies. However, I can't figure out any way to express that generalized type signature in a way that GHC accepts it. It seems like the following should do the trick:</div><div><br></div><div><div>askRunG :: ( MonadTransControl t</div><div>           , Monad m</div><div>           , b ~ StT t b</div><div>           )</div><div>        => t m (Unlift t)</div><div>askRunG = liftWith (return . Unlift)</div></div><div><br></div><div>However, I get the following error message when trying this:</div><div><br></div><div><div>foo.hs:11:12:</div><div>    Occurs check: cannot construct the infinite type: b0 ~ StT t b0</div><div>    The type variable ‘b0’ is ambiguous</div><div>    In the ambiguity check for the type signature for ‘askRunG’:</div><div>      askRunG :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) b.</div><div>                 (MonadTransControl t, Monad m, b ~ StT t b) =></div><div>                 t m (Unlift t)</div><div>    To defer the ambiguity check to use sites, enable AllowAmbiguousTypes</div><div>    In the type signature for ‘askRunG’:</div><div>      askRunG :: (MonadTransControl t, Monad m, b ~ StT t b) =></div><div>                 t m (Unlift t)</div></div><div><br></div><div>Adding AllowAmbiguousTypes to the mix provides:</div><div><br></div><div><div>foo.hs:17:30:</div><div>    Could not deduce (b1 ~ StT t b1)</div><div>    from the context (MonadTransControl t, Monad m, b ~ StT t b)</div><div>      bound by the type signature for</div><div>                 askRunG :: (MonadTransControl t, Monad m, b ~ StT t b) =></div><div>                            t m (Unlift t)</div><div>      at foo.hs:(12,12)-(16,25)</div><div>      ‘b1’ is a rigid type variable bound by</div><div>           the type forall (n1 :: * -> *) b2.</div><div>                    Monad n1 =></div><div>                    t n1 b2 -> n1 (StT t b2)</div><div>           at foo.hs:1:1</div><div>    Expected type: Run t -> Unlift t</div><div>      Actual type: (forall (n :: * -> *) b. Monad n => t n b -> n b)</div><div>                   -> Unlift t</div><div>    Relevant bindings include</div><div>      askRunG :: t m (Unlift t) (bound at foo.hs:17:1)</div><div>    In the second argument of ‘(.)’, namely ‘Unlift’</div><div>    In the first argument of ‘liftWith’, namely ‘(return . Unlift)’</div></div><div><br></div><div>I've tested with both GHC 7.8.4 and 7.10.1. Any suggestions?</div></div>