ImpredicativeTypes: Unable to use in Functor etc..
I want to use values of RankNTypes within Functors/Monads/... just like normal values.
The following code shows, that I cannot lift a function ReturnNull -> ReturnNull
into a functor the way I would like to (e.g. liftId2
). However, using another version that seems equivalent and that is allowed by GHC, liftId3
, does not allow me to pipe the result to override
. How can I do this?
{-# LANGUAGE ImpredicativeTypes #-}
type ReturnNull = forall m. Monad m => m ()
id2 :: ReturnNull -> ReturnNull
id2 = id
testId2 :: ReturnNull
testId2 = id2 $ return ()
liftId :: Functor f => f ReturnNull -> f ReturnNull
liftId = fmap id
-- rejected
liftId2 :: Functor f => f ReturnNull -> f ReturnNull
liftId2 = fmap id2
liftId3 :: (Monad m,Functor f) => f ReturnNull -> f (m ())
liftId3 = fmap id2
override :: Functor f => f ReturnNull -> f ()
override = fmap $ const ()
testLift :: Functor f => f ReturnNull -> f ()
testLift = override . liftId
--rejected
testLift3 :: Functor f => f ReturnNull -> f ()
testLift3 = override . liftId3
Trac metadata
Trac field | Value |
---|---|
Version | 7.10.1 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |