An IsString (NonEmpty Char) instance

tl;dr We have |instance IsString [Char]| and |instance IsList (NonEmpty a)|. Let’s also have |IsString (NonEmpty Char)|. Background |IsString| is a class that is used with the |-XOverloadedStrings| extension to support string literals of types other than |String| - for instance, with the |IsString Text| instance in scope, you can write |"foobar" :: Text| and it will compile. For reference, the standard libraries supply the following instances of |IsString|: |instance (a ~ Char) => IsString [a] instance IsString a => IsString (Const a b) instance IsString a => IsString (Identity a) | Proposal I propose adding a new instance of |IsString| for |NonEmpty| lists of characters. |NonEmpty| has been in |base| starting from version 4.9, and for that reason people are starting to use it more often - e.g. the popular |megaparsec| library defines its custom error type like this: |data ErrorItem t = Tokens (NonEmpty t) -- ^ Non-empty stream of tokens | Label (NonEmpty Char) -- ^ Label (cannot be empty) | EndOfInput -- ^ End of input | Here |NonEmpty Char| stands for “non-empty string”. Without the |IsString| instance users are forced to write non-empty strings in an inconvenient and awkward-looking way (e.g. |Label ('f' :| "oobar")|); the instance makes |Label "foobar"| an acceptable notation, thus making the |NonEmpty Char| type more viable for use in libraries and user-facing APIs. Implementation Here’s a sample implementation: |instance (a ~ Char) => IsString (NonEmpty a) where fromString (a:as) = a :| as fromString "" = errorWithoutStackTrace "NonEmpty.fromString: empty string" | This mirrors the |IsList| instance for |NonEmpty|. (The reason I haven’t used |fromList| is that I want the error message to say “fromString” instead of “fromList”.) If this is accepted, I can make a patch.

On Sat, 2 Sep 2017, Artyom wrote:
Background
IsString is a class that is used with the -XOverloadedStrings extension to support string literals of types other than String - for instance, with the IsString Text instance in scope, you can write "foobar" :: Text and it will compile.
String literals are still allowed to be empty. That is, "" :: NonEmpty Char would now be accepted but would be undefined. It's pretty easy for a user to make a non-empty literal empty if he does not know the code and he would not notice that "" is actually undefined in this context. Thus I think the original programmer should make explicit the problem either by the ugly ('f' :| "oobar") notation or using a partial function like (nonEmptyString "foobar").

Yes, but the same is true for `-XOverloadedLists` and the `IsList` instance of `NonEmpty`, and we have the `IsList NonEmpty` instance anyway. By the way, it'd be nice to have GHC warn about such cases, the same way it already warns about integer literals that are guaranteed to overflow: ```
257 :: Word8 <interactive>:3:1: warning: [-Woverflowed-literals] Literal 257 is out of the Word8 range 0..255
I can try implementing this along with the libraries patch, but I don't
have any experience with contributing to GHC and it might take some time.
On 09/02/2017 03:53 PM, Henning Thielemann wrote:
>
> On Sat, 2 Sep 2017, Artyom wrote:
>
>> Background
>>
>> IsString is a class that is used with the -XOverloadedStrings
>> extension to support string literals of types other than String - for
>> instance, with the IsString Text instance in scope, you can write
>> "foobar" :: Text and it will compile.
>
> String literals are still allowed to be empty. That is,
>
> "" :: NonEmpty Char
>
> would now be accepted but would be undefined. It's pretty easy for a
> user to make a non-empty literal empty if he does not know the code
> and he would not notice that "" is actually undefined in this context.
> Thus I think the original programmer should make explicit the problem
> either by the ugly ('f' :| "oobar") notation or using a partial
> function like
> (nonEmptyString "foobar").

On Sat, 2 Sep 2017, Artyom wrote:
Yes, but the same is true for `-XOverloadedLists` and the `IsList` instance of `NonEmpty`, and we have the `IsList NonEmpty` instance anyway.
I thought that NonEmpty was intended to increase type safety compared to the partial list functions in Data.List (head, maximum etc.) If we accept partial constructors for NonEmpty then we can return to lists, can't we?
By the way, it'd be nice to have GHC warn about such cases, the same way it already warns about integer literals that are guaranteed to overflow:
That would be better, but you can still bypass this warning by calling fromString directly, without overloaded string literals: fromString $ map toUpper ""

If we accept partial constructors for NonEmpty then we can return to lists, can't we?
I can't be 100% sure about this, but I believe that the world with convenient `NonEmpty Char` would be safer than the world where people had to use `fromString` with any `NonEmpty Char`, even in the presence of a partial constructor for `NonEmpty`. Moreover, I also think that `fromInteger` and `fromIntegral` are *much* bigger threats to safety than `fromString` - so, either you figure out a way to disallow `fromInteger` in your code (and then you can also easily disallow `fromString` and `fromList`), or you let `fromInteger` remain and then `fromString` becomes the least of your problems. (In the former case you only need to spend a tiny additional amount of effort to stay safe, while in the latter case you gain convenience *and* make other parts of your code safer.)

Why not: class isString1 a where fromString1 :: NonEmpty Char -> a On 02/09/17 22:08, Artyom wrote:
tl;dr
We have |instance IsString [Char]| and |instance IsList (NonEmpty a)|. Let’s also have |IsString (NonEmpty Char)|.
Background
|IsString| is a class that is used with the |-XOverloadedStrings| extension to support string literals of types other than |String| - for instance, with the |IsString Text| instance in scope, you can write |"foobar" :: Text| and it will compile.
For reference, the standard libraries supply the following instances of |IsString|:
|instance (a ~ Char) => IsString [a] instance IsString a => IsString (Const a b) instance IsString a => IsString (Identity a) |
Proposal
I propose adding a new instance of |IsString| for |NonEmpty| lists of characters. |NonEmpty| has been in |base| starting from version 4.9, and for that reason people are starting to use it more often - e.g. the popular |megaparsec| library defines its custom error type like this:
|data ErrorItem t = Tokens (NonEmpty t) -- ^ Non-empty stream of tokens | Label (NonEmpty Char) -- ^ Label (cannot be empty) | EndOfInput -- ^ End of input |
Here |NonEmpty Char| stands for “non-empty string”. Without the |IsString| instance users are forced to write non-empty strings in an inconvenient and awkward-looking way (e.g. |Label ('f' :| "oobar")|); the instance makes |Label "foobar"| an acceptable notation, thus making the |NonEmpty Char| type more viable for use in libraries and user-facing APIs.
Implementation
Here’s a sample implementation:
|instance (a ~ Char) => IsString (NonEmpty a) where fromString (a:as) = a :| as fromString "" = errorWithoutStackTrace "NonEmpty.fromString: empty string" |
This mirrors the |IsList| instance for |NonEmpty|. (The reason I haven’t used |fromList| is that I want the error message to say “fromString” instead of “fromList”.)
If this is accepted, I can make a patch.
_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

The IsString1 solution seems okay, though it requires writing an IsString1
instance for all types which have an IsString instance now, and I'm not
sure that the breakage is worth it.
On 3 Sep 2017 4:33 p.m., "Henning Thielemann"
On Sun, 3 Sep 2017, Tony Morris wrote:
Why not:
class isString1 a where fromString1 :: NonEmpty Char -> a
This would be a clean solution. GHC could reject empty string literals. (Though I do not know how difficult or sensible it is to extend GHC this way.) _______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

I'm +1 on any proposal that disallows or warns on an empty string, and -1 otherwise. Tom
El 3 sept 2017, a las 09:24, Artyom Kazak
escribió: The IsString1 solution seems okay, though it requires writing an IsString1 instance for all types which have an IsString instance now, and I'm not sure that the breakage is worth it.
On 3 Sep 2017 4:33 p.m., "Henning Thielemann"
wrote: On Sun, 3 Sep 2017, Tony Morris wrote:
Why not:
class isString1 a where fromString1 :: NonEmpty Char -> a
This would be a clean solution. GHC could reject empty string literals. (Though I do not know how difficult or sensible it is to extend GHC this way.) _______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

On 3 September 2017 at 19:33, Tony Morris
Why not:
class isString1 a where fromString1 :: NonEmpty Char -> a
It's backwards-incompatible, but my preference - especially when you consider the libraries that parse the String - is to have fromString return Maybe.
On 02/09/17 22:08, Artyom wrote:
tl;dr
We have instance IsString [Char] and instance IsList (NonEmpty a). Let’s also have IsString (NonEmpty Char).
Background
IsString is a class that is used with the -XOverloadedStrings extension to support string literals of types other than String - for instance, with the IsString Text instance in scope, you can write "foobar" :: Text and it will compile.
For reference, the standard libraries supply the following instances of IsString:
instance (a ~ Char) => IsString [a] instance IsString a => IsString (Const a b) instance IsString a => IsString (Identity a)
Proposal
I propose adding a new instance of IsString for NonEmpty lists of characters. NonEmpty has been in base starting from version 4.9, and for that reason people are starting to use it more often - e.g. the popular megaparsec library defines its custom error type like this:
data ErrorItem t = Tokens (NonEmpty t) -- ^ Non-empty stream of tokens | Label (NonEmpty Char) -- ^ Label (cannot be empty) | EndOfInput -- ^ End of input
Here NonEmpty Char stands for “non-empty string”. Without the IsString instance users are forced to write non-empty strings in an inconvenient and awkward-looking way (e.g. Label ('f' :| "oobar")); the instance makes Label "foobar" an acceptable notation, thus making the NonEmpty Char type more viable for use in libraries and user-facing APIs.
Implementation
Here’s a sample implementation:
instance (a ~ Char) => IsString (NonEmpty a) where fromString (a:as) = a :| as fromString "" = errorWithoutStackTrace "NonEmpty.fromString: empty string"
This mirrors the IsList instance for NonEmpty. (The reason I haven’t used fromList is that I want the error message to say “fromString” instead of “fromList”.)
If this is accepted, I can make a patch.
_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
-- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com http://IvanMiljenovic.wordpress.com

On Mon, 4 Sep 2017, Ivan Lazar Miljenovic wrote:
It's backwards-incompatible, but my preference - especially when you consider the libraries that parse the String - is to have fromString return Maybe.
An expression that is undefined because of "" would become an expression that is undefined because of Nothing, right? I do not see a benefit.

On 4 September 2017 at 08:17, Henning Thielemann
On Mon, 4 Sep 2017, Ivan Lazar Miljenovic wrote:
It's backwards-incompatible, but my preference - especially when you consider the libraries that parse the String - is to have fromString return Maybe.
An expression that is undefined because of "" would become an expression that is undefined because of Nothing, right? I do not see a benefit.
Sorry, yes, I was thinking that GHC could determine that the result was Nothing and throw a type-checking failure, but that doesn't work. -- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com http://IvanMiljenovic.wordpress.com

On 4 Sep 2017, at 0:25, Ivan Lazar Miljenovic
wrote: Sorry, yes, I was thinking that GHC could determine that the result was Nothing and throw a type-checking failure, but that doesn't work.
So, I proposed something like this a year or more ago and got shot down because people wanted a proof-of-concept to prove it usefulness first. I implemented a very rough one that I've been thinking about polishing to the point of actually being useful (Especially now that we can *finally* derive Lift instance for other datatypes). Comments/feedback welcome, but I'm not sure how soon I can get back to this. https://hackage.haskell.org/package/validated-literals Cheers, Merijn
participants (7)
-
amindfv@gmail.com
-
Artyom
-
Artyom Kazak
-
Henning Thielemann
-
Ivan Lazar Miljenovic
-
Merijn Verstraaten
-
Tony Morris