
Olaf Klinke
Dear cafe,
I am writing a library for parsing higher-kinded data, based on the czipwith package [1]. I ran into the following problem.
I have a type class class Config p f | f -> p where f :: (* -> *) -> * is the higher-kinded data and p :: * -> * is the associated parser type.
I want to add a class member that does not mention f in its type, e.g.
heading :: p String
Naturally, this would lead to ambiguity checks to fail, as the usage of heading does not tell which Config instance to use. My usual workaround would be to wrap `heading` in a phantom type, e.g. data Heading f p = Heading (p String) and give `heading` the type Heading f p. However, ghc-8.0.2 complains about f not being a type:
• Expecting one more argument to ‘f’ Expected a type, but ‘f’ has kind ‘(* -> *) -> *’ • In the first argument of ‘Heading’, namely ‘f’ In the type signature: heading :: Heading f p In the class declaration for ‘Config’
Is there a restriction of the kinds that can be used in parametric types?
Cheers, Olaf
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 -- - Frank