Typechecker / OverloadedStrings question 7.8 vs. 7.10
Michael Karg
mgoremeier at gmail.com
Thu Jul 30 21:04:51 UTC 2015
Hi devs,
in the followin snippet:
{-# LANGUAGE OverloadedStrings #-}
import Data.Char (isAlphaNum)
import Data.ByteString.Char8 as BS (all)
main =
print $ check str
where
check = BS.all (\x -> x `elem` valid || isAlphaNum x) -- Line 7
valid = "$_-" -- :: String
-- Line 8
str = "foo_bar123"
GHC 7.10 fails with the following errors (whereas 7.8 compiles without
complaining):
ghc --make "Testcase.hs"
[1 of 1] Compiling Main ( Testcase.hs, Testcase.o )
Testcase.hs:7:31:
No instance for (Foldable t0) arising from a use of ‘elem’
The type variable ‘t0’ is ambiguous
(...)
Testcase.hs:8:15:
No instance for (Data.String.IsString (t0 Char))
arising from the literal ‘"$_-"’
The type variable ‘t0’ is ambiguous
(...)
Uncommenting the -- :: String type annotation (line 8) makes the snippet
acceptable to the typechecker however.
So Foldable [] and [Char] should be possible to infer, given the evidence
of 'isAlphaNum x', as obviously happens with GHC 7.8. My question is, how
or why does the 7.10 typechecker behave differently? Is this intentional,
or does this qualify for a trac ticket?
Thanks for looking into this,
Michael
PS: The ByteString part is just there since the snippet is taken out of one
of my projects. The following (modified) code only typechecks on 7.10 with
both type annotations uncommented:
{-# LANGUAGE OverloadedStrings #-}
import Data.Char (isAlphaNum)
main =
print $ check str
where
check = all (\x -> x `elem` valid || isAlphaNum x)
valid = "$_-" -- :: String
str = "foo_bar123" -- :: String
The errors here are (1) no instances for Foldable and (2) no instances for
IsString.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-devs/attachments/20150730/7728b7f7/attachment.html>
More information about the ghc-devs
mailing list