<html><head><meta http-equiv="Content-Type" content="text/html charset=utf-8"></head><body style="word-wrap: break-word; -webkit-nbsp-mode: space; -webkit-line-break: after-white-space;" class="">The non-outer variant works, because then there aren’t higher rank types at all, i.e. `state` of `Handler` is free to flow outwards.<div class=""><br class=""></div><div class="">There is two ways to fix issue: Either use `newtype` or use `ImpredicativeTypes`<br class=""><div class=""><br class=""></div><div class="">—</div><div class=""><br class=""></div><div class=""><div class="">{-# LANGUAGE RankNTypes #-}</div><div class=""><br class=""></div><div class="">module TestTypes where</div><div class=""><br class=""></div><div class="">data State a        = State a</div><div class=""><br class=""></div><div class="">data Dummy          = Dummy</div><div class=""><br class=""></div><div class="">newtype Handler result = Handler { runHandler :: forall state . State state -> IO result }</div><div class=""><br class=""></div><div class="">type Resolver       = String -> Handler String</div><div class=""><br class=""></div><div class="">eventRouter :: Resolver -> String -> IO ()</div><div class="">eventRouter resolver event =</div><div class="">    runHandler (resolver event) state >> return ()</div><div class="">  where</div><div class="">    state :: State ()</div><div class="">    state = undefined</div><div class=""><br class=""></div><div class="">{-</div><div class="">-- does type check</div><div class="">createResolver :: Resolver</div><div class="">createResolver = \event state -> return "result"</div><div class=""><br class=""></div><div class="">processor :: IO ()</div><div class="">processor =</div><div class="">    getLine >>= eventRouter resolver >> processor</div><div class="">  where</div><div class="">    resolver = createResolver</div><div class="">-}</div><div class=""><br class=""></div><div class="">eventConsumer :: Resolver -> String -> IO ()</div><div class="">eventConsumer = undefined</div><div class="">{-</div><div class="">rank2.hs:34:17: error:</div><div class="">    • Cannot instantiate unification variable ‘a0’</div><div class="">      with a type involving foralls: Resolver -> String -> IO ()</div><div class="">        GHC doesn't yet support impredicative polymorphism</div><div class="">    • In the expression: undefined</div><div class="">      In an equation for ‘eventConsumer’: eventConsumer = undefined</div><div class="">-}</div><div class=""><br class=""></div><div class="">-- does not type check when the rank 2 type isn't the "outermost" one?</div><div class="">createResolver :: (Resolver, Dummy)</div><div class="">createResolver = (\event -> Handler $ \state -> return "result", Dummy)</div><div class=""><br class=""></div><div class="">processor :: IO ()</div><div class="">processor =</div><div class="">    getLine >>= eventConsumer resolver >> processor</div><div class="">  where</div><div class="">    resolver :: Resolver</div><div class="">    resolver = fst (createResolver :: (Resolver, Dummy))</div><div class=""><br class=""></div><div class="">{-</div><div class="">    • Couldn't match type ‘t’ with ‘Resolver’</div><div class="">      ‘t’ is a rigid type variable bound by</div><div class="">        the inferred type of resolver :: t at TestTypes.hs:41:5</div><div class="">      Expected type: (t, Dummy)</div><div class="">        Actual type: (Resolver, Dummy)</div><div class="">-}</div></div><div class=""><br class=""></div><div class="">---</div><div class=""><br class=""><div><blockquote type="cite" class=""><div class="">On 29 May 2016, at 21:02, Gabor Greif <<a href="mailto:ggreif@gmail.com" class="">ggreif@gmail.com</a>> wrote:</div><br class="Apple-interchange-newline"><div class="">The same bug has bitten git-annex too. IIRC.<div class=""><br class=""></div><div class="">Cheers,</div><div class=""><br class=""></div><div class="">    Gabor<br class=""><br class="">Em domingo, 29 de maio de 2016, Michael Karg <<a href="mailto:mgoremeier@gmail.com" class="">mgoremeier@gmail.com</a>> escreveu:<br class=""><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div dir="ltr" class=""><div class=""><div class=""><div class=""><div class=""><div class="">Hi devs,<br class=""></div><br class=""></div>could you please have a look at the following code snippet (modeled after a real-world app of mine)? There's a rank2type involved, and it doesn't type-check anymore when the type is e.g. part of a tuple, whereas everything's fine when it's the "outermost" type.<br class=""><br class=""></div>With GHC7.10 both variants type-check. Could anyone shed some light on what's behind this? Is the way the types are used in the snippet considered dispreferred or wrong under GHC8?<br class=""><br class=""></div>Thanks for having a look and hopefully pointing me to a page/ticket/... providing insight,<br class=""></div>Michael<br class=""><br class="">--------<br class=""><span style="font-family:monospace,monospace" class=""><br class="">{-# LANGUAGE Rank2Types #-}<br class=""><br class="">module TestTypes where<br class=""><br class="">data State a        = State a<br class=""><br class="">data Dummy          = Dummy<br class=""><br class="">type Handler result = forall state . State state -> IO result<br class=""><br class="">type Resolver       = String -> Handler String<br class=""><br class=""><br class="">eventRouter :: Resolver -> String -> IO ()<br class="">eventRouter resolver event =<br class="">    resolver event state >> return ()<br class="">  where<br class="">    state :: State ()<br class="">    state = undefined<br class=""><br class="">{-<br class="">-- does type check<br class="">createResolver :: Resolver<br class="">createResolver = \event state -> return "result"<br class=""><br class="">processor :: IO ()<br class="">processor =<br class="">    getLine >>= eventRouter resolver >> processor<br class="">  where<br class="">    resolver = createResolver<br class="">-}<br class=""><br class=""><br class="">-- does not type check when the rank 2 type isn't the "outermost" one?<br class="">createResolver :: (Resolver, Dummy)<br class="">createResolver = (\event state -> return "result", Dummy)<br class=""><br class="">processor :: IO ()<br class="">processor =<br class="">    getLine >>= eventConsumer resolver >> processor<br class="">  where<br class="">    (resolver, _) = createResolver<br class=""><br class="">{-<br class="">    • Couldn't match type ‘t’ with ‘Resolver’<br class="">      ‘t’ is a rigid type variable bound by<br class="">        the inferred type of resolver :: t at TestTypes.hs:41:5<br class="">      Expected type: (t, Dummy)<br class="">        Actual type: (Resolver, Dummy)<br class="">-}<br class=""></span><span style="font-family:monospace,monospace" class=""></span><br class=""><span style="font-family:monospace,monospace" class=""></span><span style="font-family:monospace,monospace" class=""></span><div class=""><div class=""><br class=""></div></div></div>
</blockquote></div>
_______________________________________________<br class="">ghc-devs mailing list<br class=""><a href="mailto:ghc-devs@haskell.org" class="">ghc-devs@haskell.org</a><br class="">http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs<br class=""></div></blockquote></div><br class=""></div></div></body></html>