问题
It's a horribly contrived example, but anyway... this typechecks:
newtype Foo c = Foo { runFoo :: c -> Bool }
newtype Bar c = Bar { runBar :: Int -> c }
foo :: Eq c => Bar c -> (c -> [c]) -> Bar (Foo c)
foo bar f = Bar res
where res n = Foo judge
where judge c = (c`elem`) . f $ runBar bar n
and works
GHCi> let foo0 = foo (Bar id) (\n -> [n, n*2])
GHCi> map (runFoo $ runBar foo0 4) [1..10]
[False,False,False,True,False,False,False,True,False,False]
but if I add the obvious type signature to the local function judge
,
foo :: Eq c => Bar c -> (c -> [c]) -> Bar (Foo c)
foo bar f = Bar res
where res n = Foo judge
where judge :: c -> Bool
judge c = (c`elem`) . f $ runBar bar n
it fails with
Could not deduce (c ~ c2)
from the context (Eq c)
bound by the type signature for
foo :: Eq c => Bar c -> (c -> [c]) -> Bar (Foo c)
and so on. Hardly surprising in Haskell 98, but I'd think ScopedTypeVariables
should allow to write such signatures, but apparently it doesn't. Is there a specific reason for this, is it intentional that it doesn't work with nested where
s, and what workarounds are there if this turns up in a comparable real-word problem?
回答1:
Apparently you forgot to bring the type variable c
into scope with an explicit forall
,
{-# LANGUAGE ScopedTypeVariables #-}
module Foobar where
newtype Foo c = Foo { runFoo :: c -> Bool }
newtype Bar c = Bar { runBar :: Int -> c }
foo :: forall c. Eq c => Bar c -> (c -> [c]) -> Bar (Foo c)
foo bar f = Bar res
where res n = Foo judge
where judge :: c -> Bool
judge c = (c`elem`) . f $ runBar bar n
compiles fine.
ScopedTypeVariables
by itself doesn't bring the type variables from the signature into scope, only those with an explicit forall
are brought into scope.
来源:https://stackoverflow.com/questions/12176037/scopedtypevariables-fail-to-work-with-nested-where-clauses