[Haskell] Rank-N types with (.) composition

Tyson Whitehead twhitehead at gmail.com
Tue Feb 10 20:38:45 UTC 2015


I came across something that seems a bit strange to me.  Here is a simplified version (the original was trying to move from a lens ReifiedFold to a lens-action ReifiedMonadicFold)

 {-# LANGUAGE RankNTypes #-}

 import Control.Applicative

 newtype Wrap = Wrap { extract :: forall f. Functor f => f Int }

 trip :: Wrap -> Wrap
 trip a = Wrap (extract a)

The compiler is okay with this.  It chokes on this alternative though

 trip :: Wrap -> Wrap
 trip = Wrap . extract

giving (GHC 7.8.2)

 Couldn't match type ‘f0 Int’
               with ‘forall (f :: * -> *). Functor f => f Int’
 Expected type: f0 Int -> Wrap
   Actual type: (forall (f :: * -> *). Functor f => f Int) -> Wrap
 In the first argument of ‘(.)’, namely ‘Wrap’
 In the expression: Wrap . extract

I'm guessing this is because the compiler fancy footwork to handle the implicit parameters, something like

 trip a = Wrap (\f fDict -> extract a f fDict)

where f is the Functor type and fDict is the associated dictionary, isn't compatible with the (.) definition of

 f . g = \x -> f (g x)

Is this correct?  I would appreciate anyone insight here.  Is there a way combine these (.) style?

Thanks!  -Tyson


More information about the Haskell mailing list