Proposal: Improving the IsString String instance

Edward Kmett ekmett at gmail.com
Sun Aug 25 17:13:13 CEST 2013


Looks like that takes us back to the original proposal.

-Edward


On Sun, Aug 25, 2013 at 10:22 AM, Reid Barton <rwbarton at gmail.com> wrote:

> [Apologies to Henning and Edward for duplicate email]
>
> On Sun, Aug 25, 2013 at 5:48 AM, Henning Thielemann <
> schlepptop at henning-thielemann.de> wrote:
>
>> Am 24.08.2013 19:52, schrieb Edward Kmett:
>>
>>
>>  I would like to replace this instance with
>>>
>>> instance a ~ Char => IsString [a] where
>>>    fromString = id
>>>
>>
>>
>> Your complaint proves my concerns about those FlexibleInstances. The best
>> instance is a Haskell 98 instance:
>>
>>
>> class IsCharList a where
>>    fromCharList :: [a] -> String
>>
>> instance IsCharList Char where
>>    fromCharList = id
>>
>> instance IsCharList a => IsString [a] where
>>    fromString = fromCharList
>>
>>
>> This is both the most flexible solution and it is portable.
>>
>> http://www.haskell.org/**haskellwiki/List_instance<http://www.haskell.org/haskellwiki/List_instance>
>
>
> This doesn't compile (in the IsString instance, we need fromString ::
> String -> [a], but we have fromCharList :: [a] -> String), and if you fix
> the declaration of fromCharList to fromCharList :: String -> [a], it fails
> to achieve the goal that was the original purpose of Edward's proposal.
>  See below, where I've used RebindableSyntax to write a custom IsString
> class to avoid overlapping with the built-in instance IsString String.
>
> {-# LANGUAGE RebindableSyntax, OverloadedStrings #-}
>
> import Prelude(Char, String, id, length, print)
>
> class IsString a where
>    fromString :: String -> a
>
> class IsCharList a where
>    fromCharList :: String -> [a]
>
> instance IsCharList Char where
>    fromCharList = id
>
> instance IsCharList a => IsString [a] where
>    fromString = fromCharList
>
> main = print (length "abc")
>
> {-
> /tmp/is.hs:17:22:
>     Ambiguous type variable `a0' in the constraint:
>       (IsCharList a0) arising from the literal `"abc"'
>     Probable fix: add a type signature that fixes these type variable(s)
>     In the first argument of `length', namely `"abc"'
>     In the first argument of `print', namely `(length "abc")'
>     In the expression: print (length "abc")
> -}
>
> Regards,
> Reid Barton
>
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://www.haskell.org/mailman/listinfo/libraries
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/libraries/attachments/20130825/c7d26208/attachment.htm>


More information about the Libraries mailing list