Odd error message due to PolyKinds

Good day folks, Here is a test case that exposes a certain weakness in PolyKinds error messaging. In the following snippet (T W) :: * is malkinded:
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE UnicodeSyntax #-}
class Eq a ⇒ EqSyn a where data T w data W f
x = (undefined ∷ EqSyn w ⇒ T w → ()) (undefined ∷ T W)
8.0.1rc2 yields:
../ghc-playground.hs:8:42: error: • Expected kind ‘T W’, but ‘undefined :: T W’ has kind ‘T W’ • In the first argument of ‘undefined :: EqSyn w => T w -> ()’, namely ‘(undefined :: T W)’ In the expression: (undefined :: EqSyn w => T w -> ()) (undefined :: T W) In an equation for ‘main’: main = (undefined :: EqSyn w => T w -> ()) (undefined :: T W)
..which is.. not informative. With PolyKinds removed:
../ghc-playground.hs:7:56: error: • Expecting one more argument to ‘W’ Expected a type, but ‘W’ has kind ‘* -> *’ • In the first argument of ‘T’, namely ‘W’ In an expression type signature: T W In the first argument of ‘undefined :: EqSyn w => T w -> ()’, namely ‘(undefined :: T W)’
I'm not sure if this was reported, so I'm sorry for the noise if it was. -- с уважениeм / respectfully, Косырев Сергей

Though there's still room for improvement, this one has gotten a lot better since RC2:
Scratch.hs:24:39: error: • Couldn't match type ‘k0 -> *’ with ‘*’ Expected type: T W Actual type: T W Use -fprint-explicit-kinds to see the kind arguments • In the first argument of ‘undefined :: EqSyn w => T w -> ()’, namely ‘(undefined :: T W)’ In the expression: (undefined :: EqSyn w => T w -> ()) (undefined :: T W) In an equation for ‘x’: x = (undefined :: EqSyn w => T w -> ()) (undefined :: T W)
Richard On Apr 9, 2016, at 6:41 PM, Kosyrev Serge <_deepfire@feelingofgreen.ru> wrote:
Good day folks,
Here is a test case that exposes a certain weakness in PolyKinds error messaging. In the following snippet (T W) :: * is malkinded:
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE UnicodeSyntax #-}
class Eq a ⇒ EqSyn a where data T w data W f
x = (undefined ∷ EqSyn w ⇒ T w → ()) (undefined ∷ T W)
8.0.1rc2 yields:
../ghc-playground.hs:8:42: error: • Expected kind ‘T W’, but ‘undefined :: T W’ has kind ‘T W’ • In the first argument of ‘undefined :: EqSyn w => T w -> ()’, namely ‘(undefined :: T W)’ In the expression: (undefined :: EqSyn w => T w -> ()) (undefined :: T W) In an equation for ‘main’: main = (undefined :: EqSyn w => T w -> ()) (undefined :: T W)
..which is.. not informative.
With PolyKinds removed:
../ghc-playground.hs:7:56: error: • Expecting one more argument to ‘W’ Expected a type, but ‘W’ has kind ‘* -> *’ • In the first argument of ‘T’, namely ‘W’ In an expression type signature: T W In the first argument of ‘undefined :: EqSyn w => T w -> ()’, namely ‘(undefined :: T W)’
I'm not sure if this was reported, so I'm sorry for the noise if it was.
-- с уважениeм / respectfully, Косырев Сергей _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
participants (2)
-
Kosyrev Serge
-
Richard Eisenberg