RankNTypes + ConstraintKinds to use Either as a "union"

Is there a way to compile this code? If not, why? {-# LANGUAGE RankNTypes, ConstraintKinds #-} -- This compiles bar :: (Num a, Num b) => (forall c. Num c => c -> c) -> Either a b -> Either a b bar f (Left a) = Left (f a) bar f (Right b) = Right (f b) bar' = bar (+ 2) -- This doesn't compile because foo' does not typecheck foo :: (tc a, tc b) => (forall c. tc c => c -> c) -> Either a b -> Either a b foo f (Left a) = Left (f a) foo f (Right b) = Right (f b) foo' = foo (+ 2)

I want to use something like "type class variable".
Suppose I have a value of type "Either Int Double" and I want to double
it's content and get back the value wrapped back into that Either. I can
write a function that can work on all types that belongs to the Num class,
i.e. "Num a => a -> a". Both Int and Double are members of the Num class,
so I can apply this function to any of those.
Now replace the "Num" class to a variable, in my example "tc" (short for
"type class"), as long as the function I'm trying to apply rely only on
functions defined by the type class "tc" and both sides of Either belongs
to the class "tc", then I can apply that function to it.
That's what I'm trying to express.
2013/10/9 Kim-Ee Yeoh
On Thu, Oct 10, 2013 at 1:28 AM, Thiago Negri
wrote: foo :: (tc a, tc b) => (forall c. tc c => c -> c) -> Either a b -> Either a b
Aren't type classes supposed to be Capitalized?
-- Kim-Ee
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

On Thu, Oct 10, 2013 at 2:24 AM, Thiago Negri
I want to use something like "type class variable".
Right, my bad, I just noticed the ConstraintKinds. One way of getting round this is:
type F tc a b = (tc a, tc b) => (forall c. tc c => c -> c) -> Either a b -> Either a b foo' = (foo :: F Num a b) (2+)
As to why the type inference isn't powerful enough, you might want to ask on cafe. It's really tricky to get it right. Too much power and it'll loop. Too little and you end up with cases like this. And that's not even considering bugs! -- Kim-Ee
participants (2)
-
Kim-Ee Yeoh
-
Thiago Negri