[Haskell-cafe] higher kind in parametric type

Li-yao Xia lysxia at gmail.com
Wed Jul 11 19:53:11 UTC 2018



On 07/11/2018 03:15 PM, Olaf Klinke wrote:
> 
>> Am 11.07.2018 um 16:31 schrieb Frank Staals <frank at fstaals.net>:
>>
>> I think you can just a kind signature to 'f' in your Heading
>> datatype. I.e. the following seems to compile/typecheck here:
>>
>>
>> {-# LANGUAGE MultiParamTypeClasses #-}
>> {-# LANGUAGE FunctionalDependencies #-}
>> {-# LANGUAGE KindSignatures #-}
>> {-# LANGUAGE PolyKinds #-}
>>
>> newtype Heading (f :: k) (p :: * -> *) = Heading (p String)
>>
>>
>> class Config (p :: * -> *) (f :: (* -> *) -> *) | f -> p where
>>   foo :: Heading f p -> String
>>
>>
> You solved it, Frank, thanks a lot!
> 
> Actually, it seems that this line makes all the difference:
> {-# LANGUAGE PolyKinds #-}
> 
> In ghc-7.4.2 my code compiles with the pragma, and yields the above error message without. Usually the compiler is kind enough to suggest adding the language extension when encountering an error. This time it didn't. Maybe this is a case for the ghc developers?
> 

Hello,

There is also a solution without the PolyKinds extension:

newtype Heading (f :: (* -> *) -> *) (p :: * -> *) = ...

I think the error message could be improved here but should probably not 
recommend the PolyKinds extension because it has a few surprising 
behaviors (IIRC it can break existing code, though I don't have an 
example off-hand). A safer alternative is to encourage kind annotations 
on higher-kinded types, that also mirrors the existing practice of 
giving signatures to toplevel functions.

Li-yao


More information about the Haskell-Cafe mailing list