<div dir="ltr"><div><div>Hi all,<br><br></div>thank you for the quick response.<br></div><div>Since ImpredicativeTypes is not a road I want to go down, a newtype instead of a type synonym seems like the best bet for that particular case.<br><br></div><div>Avoiding impredicativity "by accident" makes complete sense to me. I just thought to bring up the example on the list, since there's a clear change from GHC7 regarding which programs are accepted and which are not.<br><br></div><div>Thx again + enjoy the rest of the weekend<br></div><div>M.<br></div><div><br><br></div></div><div class="gmail_extra"><br><div class="gmail_quote">2016-05-29 20:20 GMT+02:00 Oleg Grenrus <span dir="ltr"><<a href="mailto:oleg.grenrus@iki.fi" target="_blank">oleg.grenrus@iki.fi</a>></span>:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div style="word-wrap:break-word">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><br></div><div>There is two ways to fix issue: Either use `newtype` or use `ImpredicativeTypes`<br><div><br></div><div>—</div><div><br></div><div><div>{-# LANGUAGE RankNTypes #-}</div><span class=""><div><br></div><div>module TestTypes where</div><div><br></div><div>data State a = State a</div><div><br></div><div>data Dummy = Dummy</div><div><br></div></span><div>newtype Handler result = Handler { runHandler :: forall state . State state -> IO result }</div><span class=""><div><br></div><div>type Resolver = String -> Handler String</div><div><br></div><div>eventRouter :: Resolver -> String -> IO ()</div><div>eventRouter resolver event =</div></span><div> runHandler (resolver event) state >> return ()</div><span class=""><div> where</div><div> state :: State ()</div><div> state = undefined</div><div><br></div><div>{-</div><div>-- does type check</div><div>createResolver :: Resolver</div><div>createResolver = \event state -> return "result"</div><div><br></div><div>processor :: IO ()</div><div>processor =</div><div> getLine >>= eventRouter resolver >> processor</div><div> where</div><div> resolver = createResolver</div><div>-}</div><div><br></div></span><div>eventConsumer :: Resolver -> String -> IO ()</div><div>eventConsumer = undefined</div><div>{-</div><div>rank2.hs:34:17: error:</div><div> • Cannot instantiate unification variable ‘a0’</div><div> with a type involving foralls: Resolver -> String -> IO ()</div><div> GHC doesn't yet support impredicative polymorphism</div><div> • In the expression: undefined</div><div> In an equation for ‘eventConsumer’: eventConsumer = undefined</div><div>-}</div><div><br></div><span class=""><div>-- does not type check when the rank 2 type isn't the "outermost" one?</div><div>createResolver :: (Resolver, Dummy)</div></span><div>createResolver = (\event -> Handler $ \state -> return "result", Dummy)</div><span class=""><div><br></div><div>processor :: IO ()</div><div>processor =</div><div> getLine >>= eventConsumer resolver >> processor</div><div> where</div></span><div> resolver :: Resolver</div><div> resolver = fst (createResolver :: (Resolver, Dummy))</div><span class=""><div><br></div><div>{-</div><div> • Couldn't match type ‘t’ with ‘Resolver’</div><div> ‘t’ is a rigid type variable bound by</div><div> the inferred type of resolver :: t at TestTypes.hs:41:5</div><div> Expected type: (t, Dummy)</div><div> Actual type: (Resolver, Dummy)</div><div>-}</div></span></div><div><br></div><div>---</div><div><br><div><blockquote type="cite"><div><div class="h5"><div>On 29 May 2016, at 21:02, Gabor Greif <<a href="mailto:ggreif@gmail.com" target="_blank">ggreif@gmail.com</a>> wrote:</div><br></div></div><div><div><div class="h5">The same bug has bitten git-annex too. IIRC.<div><br></div><div>Cheers,</div><div><br></div><div> Gabor<br><br>Em domingo, 29 de maio de 2016, Michael Karg <<a href="mailto:mgoremeier@gmail.com" target="_blank">mgoremeier@gmail.com</a>> escreveu:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div dir="ltr"><div><div><div><div><div>Hi devs,<br></div><br></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><br></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><br></div>Thanks for having a look and hopefully pointing me to a page/ticket/... providing insight,<br></div>Michael<br><br>--------<br><span style="font-family:monospace,monospace"><br>{-# LANGUAGE Rank2Types #-}<br><br>module TestTypes where<br><br>data State a = State a<br><br>data Dummy = Dummy<br><br>type Handler result = forall state . State state -> IO result<br><br>type Resolver = String -> Handler String<br><br><br>eventRouter :: Resolver -> String -> IO ()<br>eventRouter resolver event =<br> resolver event state >> return ()<br> where<br> state :: State ()<br> state = undefined<br><br>{-<br>-- does type check<br>createResolver :: Resolver<br>createResolver = \event state -> return "result"<br><br>processor :: IO ()<br>processor =<br> getLine >>= eventRouter resolver >> processor<br> where<br> resolver = createResolver<br>-}<br><br><br>-- does not type check when the rank 2 type isn't the "outermost" one?<br>createResolver :: (Resolver, Dummy)<br>createResolver = (\event state -> return "result", Dummy)<br><br>processor :: IO ()<br>processor =<br> getLine >>= eventConsumer resolver >> processor<br> where<br> (resolver, _) = createResolver<br><br>{-<br> • Couldn't match type ‘t’ with ‘Resolver’<br> ‘t’ is a rigid type variable bound by<br> the inferred type of resolver :: t at TestTypes.hs:41:5<br> Expected type: (t, Dummy)<br> Actual type: (Resolver, Dummy)<br>-}<br></span><span style="font-family:monospace,monospace"></span><br><span style="font-family:monospace,monospace"></span><span style="font-family:monospace,monospace"></span><div><div><br></div></div></div>
</blockquote></div></div></div>
_______________________________________________<br>ghc-devs mailing list<br><a href="mailto:ghc-devs@haskell.org" target="_blank">ghc-devs@haskell.org</a><br><a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs</a><br></div></blockquote></div><br></div></div></div></blockquote></div><br></div>