Rank2Types example not typechecking w/ GHC8. Bug or feature?

Gabor Greif ggreif at gmail.com
Sun May 29 18:02:39 UTC 2016


The same bug has bitten git-annex too. IIRC.

Cheers,

    Gabor

Em domingo, 29 de maio de 2016, Michael Karg <mgoremeier at gmail.com>
escreveu:

> Hi devs,
>
> 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.
>
> 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?
>
> Thanks for having a look and hopefully pointing me to a page/ticket/...
> providing insight,
> Michael
>
> --------
>
> {-# LANGUAGE Rank2Types #-}
>
> module TestTypes where
>
> data State a        = State a
>
> data Dummy          = Dummy
>
> type Handler result = forall state . State state -> IO result
>
> type Resolver       = String -> Handler String
>
>
> eventRouter :: Resolver -> String -> IO ()
> eventRouter resolver event =
>     resolver event state >> return ()
>   where
>     state :: State ()
>     state = undefined
>
> {-
> -- does type check
> createResolver :: Resolver
> createResolver = \event state -> return "result"
>
> processor :: IO ()
> processor =
>     getLine >>= eventRouter resolver >> processor
>   where
>     resolver = createResolver
> -}
>
>
> -- does not type check when the rank 2 type isn't the "outermost" one?
> createResolver :: (Resolver, Dummy)
> createResolver = (\event state -> return "result", Dummy)
>
> processor :: IO ()
> processor =
>     getLine >>= eventConsumer resolver >> processor
>   where
>     (resolver, _) = createResolver
>
> {-
>     • Couldn't match type ‘t’ with ‘Resolver’
>       ‘t’ is a rigid type variable bound by
>         the inferred type of resolver :: t at TestTypes.hs:41:5
>       Expected type: (t, Dummy)
>         Actual type: (Resolver, Dummy)
> -}
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-devs/attachments/20160529/d5db4ce7/attachment.html>


More information about the ghc-devs mailing list