Constraints on definition of `length` should be strengthened

TL;DR. One (implicit?) assumption in recent debates on `length` seems to be unfounded, because current docs for Foldable are meant to be much stronger than their actual language, unless I'm missing something. Clarifications welcome. If my understanding is right, I'd suggest somebody fixes the docs. One point is not clear to me, so at present I could not volunteer to fix them myself. In recent debates, it was assumed or implied that `length` must be equivalent to length = length . toList
we also have a kind system, so we can ignore the name. length :: f a -> Int We immediately know that values of the kind (* -> *) slot in to the value (f), with a kind checker to ensure we get it correct. Therefore, we can easily reason about the length of values of kind ((,) a)
I don't quite get how that argument is supposed to proceed. However that's meant, that seems incorrect because length is a typeclass method, so even the following strawman instance typechecks: instance Foldable ((,,) a b) where length _ = 42 I assume this should violate some law, but the relevant law seems to be forgotten. The most constraining language I can find is the following:
sum, product, maximum, and minimum should all be essentially equivalent to foldMap forms, such as sum = getSum . foldMap Sum but may be less defined.
but (a) `length` is not even mentioned, even if it's intended (b) I think those should be laws (c) using "should" and "essentially" in "should all be essentially equivalent", seems too weak. I can infer the intention, but this seems insufficient to declare Docs for `length` don't help either:
Returns the size/length of a finite structure as an Int. The default implementation is optimized for structures that are similar to cons-lists, because there is no general way to do better.
I mean, these docs use the English word "length", so that actually forbids 42, but that text is too vague to forbid 3 frankly. As I missing something? I also take issue with "may be less defined", and here I'm not sure of the intention, since that declares instance Foldable ((,,) a b) where length _ = undefined as legal. I imagine the point is about taking the length of partially undefined structures, but it's not clear to me why a custom `sum` implementation would be less defined than `sum = getSum . foldMap Sum`. Even ignoring the above instances (which I would never write down), I can't reason much about my code based on those specifications. This situation seems unfortunate. Cheers, -- Paolo G. Giarrusso - Ph.D. Student, Tübingen University http://ps.informatik.uni-tuebingen.de/team/giarrusso/

length should be quite well-behaved relative to foldMap: length = getSum . foldMap (Sum . const 1) Another law pretty much everyone agrees on is that *if* f is an instance of Traversable, then foldMap = foldMapDefault That leaves a few trouble spots: 1. There are types that some people think shouldn't have Functor/Foldable/Traversable instances at all, or that some people would like to have Functor and maybe even Traversable instances for without wanting Foldable instances. The latter is impossible because of a superclass constraint. One essential issue here seems to be one of perspective: is Foo x y a container of ys, decorated with xs, or is it a container of xs and ys? Different people tend to think about this differently, and thus form different intuitions. 2. There are some functions that the Prelude re-exports from Data.Foldable when it used to export list-specific versions. Some people would like the Prelude to go back to what it did before. 3. It's extremely difficult to formulate useful laws about instances of Foldable that are not also instances of Traversable. This seems to suggest that Foldable itself is an ad hoc convenience rather than a meaningful abstraction of its own. On Apr 3, 2017 11:33 AM, "Paolo Giarrusso"
we also have a kind system, so we can ignore the name. length :: f a -> Int We immediately know that values of the kind (* -> *) slot in to the value (f), with a kind checker to ensure we get it correct. Therefore, we can easily reason about the length of values of kind ((,) a)
I don't quite get how that argument is supposed to proceed. However that's meant, that seems incorrect because length is a typeclass method, so even the following strawman instance typechecks: instance Foldable ((,,) a b) where length _ = 42 I assume this should violate some law, but the relevant law seems to be forgotten. The most constraining language I can find is the following:
sum, product, maximum, and minimum should all be essentially equivalent to foldMap forms, such as sum = getSum . foldMap Sum but may be less defined.
but (a) `length` is not even mentioned, even if it's intended (b) I think those should be laws (c) using "should" and "essentially" in "should all be essentially equivalent", seems too weak. I can infer the intention, but this seems insufficient to declare Docs for `length` don't help either:
Returns the size/length of a finite structure as an Int. The default implementation is optimized for structures that are similar to cons-lists, because there is no general way to do better.
I mean, these docs use the English word "length", so that actually forbids 42, but that text is too vague to forbid 3 frankly. As I missing something? I also take issue with "may be less defined", and here I'm not sure of the intention, since that declares instance Foldable ((,,) a b) where length _ = undefined as legal. I imagine the point is about taking the length of partially undefined structures, but it's not clear to me why a custom `sum` implementation would be less defined than `sum = getSum . foldMap Sum`. Even ignoring the above instances (which I would never write down), I can't reason much about my code based on those specifications. This situation seems unfortunate. Cheers, -- Paolo G. Giarrusso - Ph.D. Student, Tübingen University http://ps.informatik.uni-tuebingen.de/team/giarrusso/ _______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

On Mon, 3 Apr 2017, David Feuer wrote:
That leaves a few trouble spots:
1. There are types that some people think shouldn't have Functor/Foldable/Traversable instances at all, or that some people would like to have Functor and maybe even Traversable instances for without wanting Foldable instances. The latter is impossible because of a superclass constraint. One essential issue here seems to be one of perspective: is Foo x y a container of ys, decorated with xs, or is it a container of xs and ys? Different people tend to think about this differently, and thus form different intuitions.
I don't know if anyone has a problem with interpreting a custom data type Foo x y as a container of ys decorated with xs - if it is defined for that purpose. Discussion arose solely about the cases Foo = (,), Foo = (,,) x and so on. E.g. I actually proposed to define a custom data type like Decorated x y instead of (x,y) in case you want to have a Foldable instance.

2017-04-03 18:38 GMT+02:00 Henning Thielemann : On Mon, 3 Apr 2017, David Feuer wrote: That leaves a few trouble spots: 1. There are types that some people think shouldn't have
Functor/Foldable/Traversable instances at all, or that some people would
like to have Functor and maybe even Traversable instances for without
wanting Foldable instances. The latter is impossible because of a
superclass constraint. One essential issue here seems to be one of
perspective: is Foo x y a container of ys, decorated with xs, or is it a
container of xs and ys? Different people tend to think about this
differently, and thus form different intuitions. I don't know if anyone has a problem with interpreting a custom data type
Foo x y as a container of ys decorated with xs - if it is defined for that
purpose. Discussion arose solely about the cases Foo = (,), Foo = (,,) x
and so on. Of course such an interpretation is possible, but let's remember Abelson's
famous quote:
"Programs must be written for people to read, and only incidentally for
machines to execute."
When you show somebody a pair and ask "What is this?", how many people do
you *seriously* expect to say "Oh, yeah, I've seen that: It's a value on
the right decorated by another one on the left!" compared to people telling
you something about e.g. cartesian products (which are totally symmetric
with no bias to the right or left)? The point is: Using a pair for a
decorated one-element container is completely miscommunicating your intent,
even if you find a sensible mathematical interpretation for it. All the
programs from http://www.ioccc.org/ have a sensible mathematical
interpretation, too, but that doesn't mean I want to see them outside of
that contest. ;-) E.g. I actually proposed to define a custom data type like Decorated x y
instead of (x,y) in case you want to have a Foldable instance. *This* is communicating you intent IHMO, and I doubt you need more types
for different arities: If you e.g. want to have 3 values for decoration,
just use a triple (or something isomorphic) with Decorated. This is much
clearer than having a family of Decorated, Decorated2, Decorated3, ...

On Mon, 3 Apr 2017, Sven Panne wrote:
Of course such an interpretation is possible, but let's remember Abelson's famous quote:
"Programs must be written for people to read, and only incidentally for machines to execute."
When you show somebody a pair and ask "What is this?", how many people do you *seriously* expect to say "Oh, yeah, I've seen that: It's a value on the right decorated by another one on the left!" compared to people telling you something about e.g. cartesian products (which are totally symmetric with no bias to the right or left)? The point is: Using a pair for a decorated one-element container is completely miscommunicating your intent, even if you find a sensible mathematical interpretation for it.
That's what I am saying all the time.

I expect most people probably agree that it'd be nice to have tuples be an unbiased cartesian product, but the actual fact of the matter is that tuples as they exist in Haskell are biased. We can't just ignore that and pretend they're unbiased. It definitely sucks that the answer people would naively give to "what is a tuple in Haskell" is not the correct answer, but we're stuck in that situation. The question is how to make the best of it. On Mon, Apr 3, 2017 at 12:56 PM, Henning Thielemann < lemming@henning-thielemann.de> wrote:
On Mon, 3 Apr 2017, Sven Panne wrote:
Of course such an interpretation is possible, but let's remember Abelson's
famous quote:
"Programs must be written for people to read, and only incidentally for machines to execute."
When you show somebody a pair and ask "What is this?", how many people do you *seriously* expect to say "Oh, yeah, I've seen that: It's a value on the right decorated by another one on the left!" compared to people telling you something about e.g. cartesian products (which are totally symmetric with no bias to the right or left)? The point is: Using a pair for a decorated one-element container is completely miscommunicating your intent, even if you find a sensible mathematical interpretation for it.
That's what I am saying all the time. _______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

2017-04-03 22:29 GMT+02:00 Nathan Bouscal
I expect most people probably agree that it'd be nice to have tuples be an unbiased cartesian product, but the actual fact of the matter is that tuples as they exist in Haskell are biased.
Tuples *are* unbiased, the bias is just an artifact of seeing them as a curried function, where the positions are "eaten" from left to right. Again, this mathematically correct, but more often than not the main intent of using a tuple-
We can't just ignore that and pretend they're unbiased.
We *can* ignore that, just use Henning's Decorated for an isomorphic variant.
It definitely sucks that the answer people would naively give to "what is a tuple in Haskell" is not the correct answer, but we're stuck in that situation.
See above, we are not stuck: We *can* get back normal people's intuition and Haskell's semantics back in line by removing the tuple instances and adding something like Decorated. It is just a matter of priorities: This will temporarily damage the Haskell ecosystem a bit, but in the long run it will be the nicer, more explicit, more intuitive way.
The question is how to make the best of it.
If the tuple instances are removed and Decorated is added, things are easy to fix: The compiler will tell you exactly the places where you were too lazy to define and use a custom data type, and the fix is mechanical. The current situation is quite the opposite: People silently get totally unexpected behavior.

[ Hit the wrong button... :-P ]
2017-04-03 22:48 GMT+02:00 Sven Panne
[...] Again, this mathematically correct, but more often than not the main intent of using a tuple- [...]
Again, this is mathematically correct, but more often than not, the main intent of using a tuple is not a curried function but a heterogeneous container with no special bias at all.

On Mon, 3 Apr 2017, Sven Panne wrote:
[ Hit the wrong button... :-P ]
2017-04-03 22:48 GMT+02:00 Sven Panne
: [...] Again, this mathematically correct, but more often than not the main intent of using a tuple- [...] Again, this is mathematically correct, but more often than not, the main intent of using a tuple is not a curried function but a heterogeneous container with no special bias at all.
I think the special syntax (a,b,c) emphasises the unbiased nature and I think that tuples are often chosen because of that syntax (and not because of the prefix form (,,)). However, I guess we are in the wrong thread. I just wanted to comment on David Feuer whose explanation could be (mis)understood as if there is a controversy about whether custom data types like Foo a b should be considered biased or not.

On Mon, Apr 3, 2017 at 1:48 PM, Sven Panne
2017-04-03 22:29 GMT+02:00 Nathan Bouscal
: I expect most people probably agree that it'd be nice to have tuples be an unbiased cartesian product, but the actual fact of the matter is that tuples as they exist in Haskell are biased.
Tuples *are* unbiased, the bias is just an artifact of seeing them as a curried function, where the positions are "eaten" from left to right. Again, this mathematically correct, but more often than not the main intent of using a tuple-
… no, they're not. What other type of correct is there than mathematically correct? "Zero *isn't* an integer, that's just an artifact of *seeing* it as an integer."
We can't just ignore that and pretend they're unbiased.
We *can* ignore that, just use Henning's Decorated for an isomorphic variant.
It definitely sucks that the answer people would naively give to "what is a tuple in Haskell" is not the correct answer, but we're stuck in that situation.
See above, we are not stuck: We *can* get back normal people's intuition and Haskell's semantics back in line by removing the tuple instances and adding something like Decorated. It is just a matter of priorities: This will temporarily damage the Haskell ecosystem a bit, but in the long run it will be the nicer, more explicit, more intuitive way.
You can't get tuples to behave like they're unbiased. You can try to hide the fact that they're biased by getting rid of the only possible instances they can support, but that doesn't magically make them unbiased. It sounds like you just want to rename tuples to Decorated. Maybe that's a good idea, but call it what it is.
The question is how to make the best of it.
If the tuple instances are removed and Decorated is added, things are easy to fix: The compiler will tell you exactly the places where you were too lazy to define and use a custom data type, and the fix is mechanical. The current situation is quite the opposite: People silently get totally unexpected behavior.
_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

There's a way to get unbiased products in Haskell. The trick is to
make their kind [Type] -> Type:
data family Product (xs :: [Type])
data instance Product '[] = Unit
data instance Product '[a] = Id a
data instance Product '[a,b] = Pair a b
data instance Product '[a,b,c] = Triple a b c
...
We could make (a,b) syntactic sugar for Product '[a,b] at type level
and for Pair at term level - this would invalidate all asymmetric
instances. Unfortunately, this is would break an immense amount of
code and violate the Haskell standard.
(Another variation is to define Product inductively as a GADT with
constructors Cons and Nil, but the result would be a HList that has a
different memory representation than tuples).
On Tue, Apr 4, 2017 at 12:14 AM, Nathan Bouscal
On Mon, Apr 3, 2017 at 1:48 PM, Sven Panne
wrote: 2017-04-03 22:29 GMT+02:00 Nathan Bouscal
: I expect most people probably agree that it'd be nice to have tuples be an unbiased cartesian product, but the actual fact of the matter is that tuples as they exist in Haskell are biased.
Tuples *are* unbiased, the bias is just an artifact of seeing them as a curried function, where the positions are "eaten" from left to right. Again, this mathematically correct, but more often than not the main intent of using a tuple-
… no, they're not. What other type of correct is there than mathematically correct? "Zero isn't an integer, that's just an artifact of *seeing* it as an integer."
We can't just ignore that and pretend they're unbiased.
We *can* ignore that, just use Henning's Decorated for an isomorphic variant.
It definitely sucks that the answer people would naively give to "what is a tuple in Haskell" is not the correct answer, but we're stuck in that situation.
See above, we are not stuck: We *can* get back normal people's intuition and Haskell's semantics back in line by removing the tuple instances and adding something like Decorated. It is just a matter of priorities: This will temporarily damage the Haskell ecosystem a bit, but in the long run it will be the nicer, more explicit, more intuitive way.
You can't get tuples to behave like they're unbiased. You can try to hide the fact that they're biased by getting rid of the only possible instances they can support, but that doesn't magically make them unbiased. It sounds like you just want to rename tuples to Decorated. Maybe that's a good idea, but call it what it is.
The question is how to make the best of it.
If the tuple instances are removed and Decorated is added, things are easy to fix: The compiler will tell you exactly the places where you were too lazy to define and use a custom data type, and the fix is mechanical. The current situation is quite the opposite: People silently get totally unexpected behavior.
_______________________________________________ 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

2017-04-03 23:14 GMT+02:00 Nathan Bouscal
On Mon, Apr 3, 2017 at 1:48 PM, Sven Panne
wrote: Tuples *are* unbiased, the bias is just an artifact of seeing them as a curried function, where the positions are "eaten" from left to right. Again, this mathematically correct, but more often than not the main intent of using a tuple-
… no, they're not. What other type of correct is there than mathematically correct? "Zero *isn't* an integer, that's just an artifact of *seeing* it as an integer."
Tuples are unbiased cartesian products, full stop. All the left bias is coming from currying. If you have a signature of e.g.: fobar :: Int -> (a, b) -> Float -> Bar I can't see any bias here. OTOH: fobar' :: Int -> a -> b -> Float -> Bar Now you have a left bias, because you can partially apply foobar' with e.g. 2 arguments, "eating away" the 'a', but keeping the 'b'.
You can't get tuples to behave like they're unbiased. You can try to hide the fact that they're biased by getting rid of the only possible instances they can support, but that doesn't magically make them unbiased.
Again, tuples are unbiased, you just put an interpretation onto them which is induced by currying, but which is not the intuitive one. I want to get rid of that interpretation as the default one, because that's a miscommunication of intents (see previous post).
It sounds like you just want to rename tuples to Decorated. Maybe that's a good idea, but call it what it is.
Nope, my proposal is: Keep tuples what they are (unbiased heterogenous collections) and make any bias explicit (Decorated).

Tuples are unbiased cartesian products, full stop.
This statement is not correct. Look at their kind:
:k (,) (,) :: * -> * -> *
The same currying business is going on here. One of the types is
privileged. To get unbiased products in Haskell, you need their kind
to be [*] -> * or similar.
On Tue, Apr 4, 2017 at 9:11 AM, Sven Panne
2017-04-03 23:14 GMT+02:00 Nathan Bouscal
: On Mon, Apr 3, 2017 at 1:48 PM, Sven Panne
wrote: Tuples *are* unbiased, the bias is just an artifact of seeing them as a curried function, where the positions are "eaten" from left to right. Again, this mathematically correct, but more often than not the main intent of using a tuple-
… no, they're not. What other type of correct is there than mathematically correct? "Zero isn't an integer, that's just an artifact of *seeing* it as an integer."
Tuples are unbiased cartesian products, full stop. All the left bias is coming from currying. If you have a signature of e.g.:
fobar :: Int -> (a, b) -> Float -> Bar
I can't see any bias here. OTOH:
fobar' :: Int -> a -> b -> Float -> Bar
Now you have a left bias, because you can partially apply foobar' with e.g. 2 arguments, "eating away" the 'a', but keeping the 'b'.
You can't get tuples to behave like they're unbiased. You can try to hide the fact that they're biased by getting rid of the only possible instances they can support, but that doesn't magically make them unbiased.
Again, tuples are unbiased, you just put an interpretation onto them which is induced by currying, but which is not the intuitive one. I want to get rid of that interpretation as the default one, because that's a miscommunication of intents (see previous post).
It sounds like you just want to rename tuples to Decorated. Maybe that's a good idea, but call it what it is.
Nope, my proposal is: Keep tuples what they are (unbiased heterogenous collections) and make any bias explicit (Decorated).
_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

2017-04-04 8:15 GMT+02:00 Vladislav Zavialov
Tuples are unbiased cartesian products, full stop.
This statement is not correct.
According to probably all the math books in the world, the statement is correct, at least if we want to see tuples as cartesian products. But if we don't want to do that, the usage of the name "tuple" in Haskell and the (...,...) notation would be confusing misnomers.
Look at their kind:
:k (,) (,) :: * -> * -> *
The same currying business is going on here. [...]
That's an artifact of our kind system, not a consequence of the usual definition of cartesian products.

You want tuples in mathematics and tuples in Haskell to be the same,
but they aren't. Call it an artifact of the kind system or a misnomer,
but that's the state of affairs. It's counter-intuitive and I don't
like it myself. My point is that if you want to fix this, it takes
more than to delete a few instances from 'base'. See my other message
in this thread about defining unbiased products in Haskell.
On Tue, Apr 4, 2017 at 9:50 AM, Sven Panne
2017-04-04 8:15 GMT+02:00 Vladislav Zavialov
: Tuples are unbiased cartesian products, full stop.
This statement is not correct.
According to probably all the math books in the world, the statement is correct, at least if we want to see tuples as cartesian products. But if we don't want to do that, the usage of the name "tuple" in Haskell and the (...,...) notation would be confusing misnomers.
Look at their kind:
:k (,) (,) :: * -> * -> *
The same currying business is going on here. [...]
That's an artifact of our kind system, not a consequence of the usual definition of cartesian products.
_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

Hi, On 04/03/2017 10:14 PM, Nathan Bouscal wrote:
You can't get tuples to behave like they're unbiased. You can try to hide the fact that they're biased by getting rid of the only possible instances they can support, but that doesn't magically make them unbiased. It sounds like you just want to rename tuples to Decorated. Maybe that's a good idea, but call it what it is.
While I (so far) disagree, I am trying to fully appreciate this argument. The reason is that it seems to me that the above has more to do with specific syntactic details regarding instance declarations for partially applied type constructors, than with what (in this case) tuples fundamentally are in Haskell: essentially Cartesian products. For the sake of argument, suppose some mechanism were adopted to mitigate the bias implied by the (inevitable) ordering of arguments to to type constructors. For tuples, we might imagine some kind of notation inspired by operator sections as a first step, making the following instance declaration possible: instance Functor (,b) where ... Would tuples then still be biased in the above sense, and if so why? Best, /Henrik This message and any attachment are intended solely for the addressee and may contain confidential information. If you have received this message in error, please send it back to me, and immediately delete it. Please do not use, copy or disclose the information contained in this message or in any attachment. Any views or opinions expressed by the author of this email do not necessarily reflect the views of the University of Nottingham. This message has been checked for viruses but the contents of an attachment may still contain software viruses which could damage your computer system, you are advised to perform your own checks. Email communications with the University of Nottingham may be monitored as permitted by UK legislation.

On Tue, Apr 4, 2017 at 11:33 AM, Henrik Nilsson
For the sake of argument, suppose some mechanism were adopted to mitigate the bias implied by the (inevitable) ordering of arguments to to type constructors. For tuples, we might imagine some kind of notation inspired by operator sections as a first step, making the following instance declaration possible:
instance Functor (,b) where ...
Would tuples then still be biased in the above sense, and if so why?
No, tuples wouldn't be biased if (a,) and (,b) could behave the same, i.e. 'f x' could be instantiated as both '(a,x)' and '(x,b)'. However, what you propose is not possible in Haskell and the extension is not straightforward. (1) Writing (,b) would require type-level lambda functions, as it's equivalent to writing '\a -> (a,b)'. Type-level lambdas are not straightforward at all: they conflict with the matchability (injectivity+generativity) assumption about type constructors - currently 'f a ~ g b' implies 'f ~ g' and 'a ~ b' - which is not true for arbitrary type-level functions. Removing this rule would wreak havoc on type inference. The solution seems to be to have two kinds of type-level arrows, as described in Richard Eisenberg's thesis on Dependent Haskell. (2) Even if type-level functions are added to the language, it's very likely that they will be disallowed as class parameters. Notice that classes perform pattern matching on types, and pattern matching on functions is impossible. So even if one could write '\a -> (a,b), writing Functor (\a -> (a,b)) would remain impossible. (3) Assume that somehow we managed to solve those problems. What instance do you define, Functor (a,) or Functor (,b)? Perhaps neither? Or maybe Functor (\a -> (a,a)) to map over both arguments? Hard design questions, many opinions will emerge! Do those instances even overlap? - determining this requires the compiler to reason about function equalities. All in all, I see only two sensible ways to proceed: accept that tuples are biased, or make them unbiased by changing their kind from Type -> Type -> Type to something uncurried.

Vladislav, I wonder if you might propose a language extension to use tuple
syntax the way you describe. Such an extension would allow people to tinker
with this idea without making the community commit to such a change.
On Apr 4, 2017 5:25 AM, "Vladislav Zavialov"
For the sake of argument, suppose some mechanism were adopted to mitigate the bias implied by the (inevitable) ordering of arguments to to type constructors. For tuples, we might imagine some kind of notation inspired by operator sections as a first step, making the following instance declaration possible:
instance Functor (,b) where ...
Would tuples then still be biased in the above sense, and if so why?
No, tuples wouldn't be biased if (a,) and (,b) could behave the same, i.e. 'f x' could be instantiated as both '(a,x)' and '(x,b)'. However, what you propose is not possible in Haskell and the extension is not straightforward. (1) Writing (,b) would require type-level lambda functions, as it's equivalent to writing '\a -> (a,b)'. Type-level lambdas are not straightforward at all: they conflict with the matchability (injectivity+generativity) assumption about type constructors - currently 'f a ~ g b' implies 'f ~ g' and 'a ~ b' - which is not true for arbitrary type-level functions. Removing this rule would wreak havoc on type inference. The solution seems to be to have two kinds of type-level arrows, as described in Richard Eisenberg's thesis on Dependent Haskell. (2) Even if type-level functions are added to the language, it's very likely that they will be disallowed as class parameters. Notice that classes perform pattern matching on types, and pattern matching on functions is impossible. So even if one could write '\a -> (a,b), writing Functor (\a -> (a,b)) would remain impossible. (3) Assume that somehow we managed to solve those problems. What instance do you define, Functor (a,) or Functor (,b)? Perhaps neither? Or maybe Functor (\a -> (a,a)) to map over both arguments? Hard design questions, many opinions will emerge! Do those instances even overlap? - determining this requires the compiler to reason about function equalities. All in all, I see only two sensible ways to proceed: accept that tuples are biased, or make them unbiased by changing their kind from Type -> Type -> Type to something uncurried. _______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

Am 03.04.2017 um 22:48 schrieb Sven Panne:
Tuples *are* unbiased, the bias is just an artifact of seeing them as a curried function, where the positions are "eaten" from left to right. Again, this mathematically correct, but more often than not the main intent of using a tuple-
Exactly. Currying is nice and convenient but it has an inherent bias. This bias is based on the necessity to choose an order when writing things down in sequence and unavoidable as long as we write programs as linear text. Just because we can curry something doesn't mean we have to give an independent (biased) interpretation to the curried entity.
We can't just ignore that and pretend they're unbiased.
We *can* ignore that, just use Henning's Decorated for an isomorphic variant.
And let's not forget Either which IMO should be regarded as an unbiased choice. I don't have a proposal for the name, though. Cheers Ben

On Wed, Apr 5, 2017 at 9:18 AM, Ben Franksen
Am 03.04.2017 um 22:48 schrieb Sven Panne:
Tuples *are* unbiased, the bias is just an artifact of seeing them as a curried function, where the positions are "eaten" from left to right. Again, this mathematically correct, but more often than not the main intent of using a tuple-
Exactly. Currying is nice and convenient but it has an inherent bias. This bias is based on the necessity to choose an order when writing things down in sequence and unavoidable as long as we write programs as linear text.
Just because we can curry something doesn't mean we have to give an
independent (biased) interpretation to the curried entity.
As Vladislav showed earlier, the bias is not just the order that things are written in. It is impossible (in Haskell as it exists) to make a Functor instance for (,b). It's not about interpretation, it's part of how the language works.
We can't just ignore that and pretend they're unbiased.
We *can* ignore that, just use Henning's Decorated for an isomorphic variant.
And let's not forget Either which IMO should be regarded as an unbiased choice. I don't have a proposal for the name, though.
Cheers Ben
_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

2017-04-05 18:18 GMT+02:00 Ben Franksen
And let's not forget Either which IMO should be regarded as an unbiased choice. I don't have a proposal for the name, though.
In the dark ages of Haskell's library design, i.e. a long, long time ago, in a distant past, the time where people could actually write significant code without using at least 20 LANGUAGE pragmas ;-), we discussed this already, see e.g. the thread starting at http://code.haskell.org/~dons/haskell-1990-2000/msg07215.html. The final outcome was: Although something like Error/OK would have been better than Left/Right, a slight majority preferred to give a bias to Either. The reasoning was that using "Right" for a "wrong" outcome (i.e. failure) would be a bit obscure, and there was already quite some code using it in the way we still do today. The bias is even explicitly documented in the Haddock docs for Data.Either for ages, so it would not be very wise to change the meaning here after roughly 2 decades. Of course the question remains: What is the totally unbiased standard sum type for 2 alternatives?

Sven Panne
2017-04-05 18:18 GMT+02:00 Ben Franksen
: And let's not forget Either which IMO should be regarded as an unbiased choice. I don't have a proposal for the name, though.
In the dark ages of Haskell's library design, i.e. a long, long time ago, in a distant past, the time where people could actually write significant code without using at least 20 LANGUAGE pragmas ;-), we discussed this already, see e.g. the thread starting at http://code.haskell.org/~dons/haskell-1990-2000/msg07215.html. The final outcome was: Although something like Error/OK would have been better than Left/Right, a slight majority preferred to give a bias to Either. The reasoning was that using "Right" for a "wrong" outcome (i.e. failure) would be a bit obscure, and there was already quite some code using it in the way we still do today. The bias is even explicitly documented in the Haddock docs for Data.Either for ages, so it would not be very wise to change the meaning here after roughly 2 decades.
I guess this means that Haskell has failed to sufficiently avoid success. If a mistake in library design is bad enough (not necessarily the case for Either, but arguably so), it should be corrected even after 20 years.
Of course the question remains: What is the totally unbiased standard sum type for 2 alternatives?
What are you asking? It sounds like an invitation to bikeshed! In general, though, types such as (,) and Either should be used very sparingly. In many cases it would be better to define a new type for the specific purpose. -- Jón Fairbairn Jon.Fairbairn@cl.cam.ac.uk

2017-04-06 9:33 GMT+02:00 Jon Fairbairn
Sven Panne
writes: [...] Although something like Error/OK would have been better than Left/Right, a slight majority preferred to give a bias to Either. The reasoning was that using "Right" for a "wrong" outcome (i.e. failure) would be a bit obscure, and there was already quite some code using it in the way we still do today. The bias is even explicitly documented in the Haddock docs for Data.Either for ages, so it would not be very wise to change the meaning here after roughly 2 decades.
I guess this means that Haskell has failed to sufficiently avoid success. If a mistake in library design is bad enough (not necessarily the case for Either, but arguably so), it should be corrected even after 20 years.
Just to clarify my POV: I didn't want to criticize anything here, I just wanted to point to some previous discussion. In my POV, Either *is* intended as a biased sum type (there are tons of more or less standard libraries which use it that way), while pairs/tuples are intended as unbiased product types. Of course one can see it in the exact opposite (still consistent) way, but this wasn't the historical intention, at least that's my personal interpretation...
Of course the question remains: What is the totally unbiased standard sum type for 2 alternatives?
What are you asking? It sounds like an invitation to bikeshed! In general, though, types such as (,) and Either should be used very sparingly. In many cases it would be better to define a new type for the specific purpose.
I think we are in the same boat here, sorry if I didn't make that clear.

Sven Panne
2017-04-06 9:33 GMT+02:00 Jon Fairbairn
: Sven Panne
writes: [...] Although something like Error/OK would have been better than Left/Right, a slight majority preferred to give a bias to Either. The reasoning was that using "Right" for a "wrong" outcome (i.e. failure) would be a bit obscure, and there was already quite some code using it in the way we still do today. The bias is even explicitly documented in the Haddock docs for Data.Either for ages, so it would not be very wise to change the meaning here after roughly 2 decades.
I guess this means that Haskell has failed to sufficiently avoid success. If a mistake in library design is bad enough (not necessarily the case for Either, but arguably so), it should be corrected even after 20 years.
Just to clarify my POV: I didn't want to criticize anything here, I just wanted to point to some previous discussion. In my POV, Either *is* intended as a biased sum type (there are tons of more or less standard libraries which use it that way), while pairs/tuples are intended as unbiased product types.
I agree with that, although somewhat reluctantly about Either. The original intention (as I remember it, but how reliable is my memory of meetings nearly thirty years ago?) was to pick a name for an unbiased sum type and its constructors. We chose Either and Left and Right (the latter two being names that had been used in prior languages). It was then noticed that Either provided what was needed for results that could either be a success or an error, and Right was the obvious choice for the success. (,) never had that: it was unbiased, apart from the inevitable syntactic and evaluation order biases. I would like to be able to say that (excluding questions of evaluation order) if one systematically replaced (a,b) with (b,a) throughout the source of a programme, it would still be the same programme. I would also like to think that instances provided in base were “the only sensible instance” (for some value of sensible). This is the case for Foldable Maybe, maybe for Either (but not for an unbiased sum) and definitely not for (,). -- Jón Fairbairn Jon.Fairbairn@cl.cam.ac.uk

I don't totally understand this viewpoint. It sounds like what you're saying is it's unfortunate that tuples (and everything else) are biased in Haskell, but because they are we're obligated to make all the legal instances we can for them. E.g. if I define a datatype "data Foo x y z", I'm powerless and sort of obligated to define "instance Functor (Foo x y)" if there's a legal one, regardless of if that's what I want Foo to mean. Tom
El 3 abr 2017, a las 15:29, Nathan Bouscal
escribió: I expect most people probably agree that it'd be nice to have tuples be an unbiased cartesian product, but the actual fact of the matter is that tuples as they exist in Haskell are biased. We can't just ignore that and pretend they're unbiased. It definitely sucks that the answer people would naively give to "what is a tuple in Haskell" is not the correct answer, but we're stuck in that situation. The question is how to make the best of it.
On Mon, Apr 3, 2017 at 12:56 PM, Henning Thielemann
wrote: On Mon, 3 Apr 2017, Sven Panne wrote:
Of course such an interpretation is possible, but let's remember Abelson's famous quote:
"Programs must be written for people to read, and only incidentally for machines to execute."
When you show somebody a pair and ask "What is this?", how many people do you *seriously* expect to say "Oh, yeah, I've seen that: It's a value on the right decorated by another one on the left!" compared to people telling you something about e.g. cartesian products (which are totally symmetric with no bias to the right or left)? The point is: Using a pair for a decorated one-element container is completely miscommunicating your intent, even if you find a sensible mathematical interpretation for it.
That's what I am saying all the time. _______________________________________________ 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 6 April 2017 at 23:56,
I don't totally understand this viewpoint. It sounds like what you're saying is it's unfortunate that tuples (and everything else) are biased in Haskell, but because they are we're obligated to make all the legal instances we can for them.
E.g. if I define a datatype "data Foo x y z", I'm powerless and sort of obligated to define "instance Functor (Foo x y)" if there's a legal one, regardless of if that's what I want Foo to mean.
Is Foo going to be widely used or only an internal data type to your own code?
Tom
El 3 abr 2017, a las 15:29, Nathan Bouscal
escribió: I expect most people probably agree that it'd be nice to have tuples be an unbiased cartesian product, but the actual fact of the matter is that tuples as they exist in Haskell are biased. We can't just ignore that and pretend they're unbiased. It definitely sucks that the answer people would naively give to "what is a tuple in Haskell" is not the correct answer, but we're stuck in that situation. The question is how to make the best of it.
On Mon, Apr 3, 2017 at 12:56 PM, Henning Thielemann
wrote: On Mon, 3 Apr 2017, Sven Panne wrote:
Of course such an interpretation is possible, but let's remember Abelson's famous quote:
"Programs must be written for people to read, and only incidentally for machines to execute."
When you show somebody a pair and ask "What is this?", how many people do you *seriously* expect to say "Oh, yeah, I've seen that: It's a value on the right decorated by another one on the left!" compared to people telling you something about e.g. cartesian products (which are totally symmetric with no bias to the right or left)? The point is: Using a pair for a decorated one-element container is completely miscommunicating your intent, even if you find a sensible mathematical interpretation for it.
That's what I am saying all the time. _______________________________________________ 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
_______________________________________________ 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

El 6 abr 2017, a las 08:52, Ivan Lazar Miljenovic
escribió: On 6 April 2017 at 23:56,
wrote: I don't totally understand this viewpoint. It sounds like what you're saying is it's unfortunate that tuples (and everything else) are biased in Haskell, but because they are we're obligated to make all the legal instances we can for them. E.g. if I define a datatype "data Foo x y z", I'm powerless and sort of obligated to define "instance Functor (Foo x y)" if there's a legal one, regardless of if that's what I want Foo to mean.
Is Foo going to be widely used or only an internal data type to your own code?
For the sake of comparison, let's say it's going to be widely used. It's also a structure which isn't (conceptually) biased. If we're starting from a place of feeling that it's a shame Haskell is unable to have unbiased structures, then probably an "if we knew then what we know now" version of Haskell would have them. So then why knowingly create instances we think a "better Haskell" wouldn't have? Is the argument that if it's public-facing, someone's going to define the instance and so we should do it canonically? If so, this feels to me a little like "you can't fire me, I quit!" - doing what we don't want before someone else has a chance to. Tom
Tom
El 3 abr 2017, a las 15:29, Nathan Bouscal
escribió: I expect most people probably agree that it'd be nice to have tuples be an unbiased cartesian product, but the actual fact of the matter is that tuples as they exist in Haskell are biased. We can't just ignore that and pretend they're unbiased. It definitely sucks that the answer people would naively give to "what is a tuple in Haskell" is not the correct answer, but we're stuck in that situation. The question is how to make the best of it.
On Mon, Apr 3, 2017 at 12:56 PM, Henning Thielemann
wrote: On Mon, 3 Apr 2017, Sven Panne wrote:
Of course such an interpretation is possible, but let's remember Abelson's famous quote:
"Programs must be written for people to read, and only incidentally for machines to execute."
When you show somebody a pair and ask "What is this?", how many people do you *seriously* expect to say "Oh, yeah, I've seen that: It's a value on the right decorated by another one on the left!" compared to people telling you something about e.g. cartesian products (which are totally symmetric with no bias to the right or left)? The point is: Using a pair for a decorated one-element container is completely miscommunicating your intent, even if you find a sensible mathematical interpretation for it.
That's what I am saying all the time. _______________________________________________ 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
_______________________________________________ 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

It *is* actually a useful instance and it is used in practice. It's not
that better Haskell wouldn't have an biased pair type with these instances,
it's that it would *also* have an unbiased one with the instances that such
a type could support. The issue seems to be that people don't like the
biased type having special syntax that wrongly gives an unknowing reader
the impression that the type is unbiased. This is a reasonable position,
but getting rid of the tuple instances isn't a reasonable way to act on
that position: 1) they're going to be defined anyway, but also 2) it's not
helpful to just pretend the type is unbiased when it isn't. It would be
coherent to argue for the removal of the special tuple syntax (though
coherent doesn't mean reasonable; this would break everything), but it's
not coherent to argue for crippling tuples so we can pretend they're
something they aren't.
On Thu, Apr 6, 2017 at 11:17 AM
El 6 abr 2017, a las 08:52, Ivan Lazar Miljenovic < ivan.miljenovic@gmail.com> escribió:
On 6 April 2017 at 23:56,
wrote: I don't totally understand this viewpoint. It sounds like what you're saying is it's unfortunate that tuples (and everything else) are biased in Haskell, but because they are we're obligated to make all the legal instances we can for them. E.g. if I define a datatype "data Foo x y z", I'm powerless and sort of obligated to define "instance Functor (Foo x y)" if there's a legal one, regardless of if that's what I want Foo to mean.
Is Foo going to be widely used or only an internal data type to your own code?
For the sake of comparison, let's say it's going to be widely used. It's also a structure which isn't (conceptually) biased.
If we're starting from a place of feeling that it's a shame Haskell is unable to have unbiased structures, then probably an "if we knew then what we know now" version of Haskell would have them. So then why knowingly create instances we think a "better Haskell" wouldn't have?
Is the argument that if it's public-facing, someone's going to define the instance and so we should do it canonically? If so, this feels to me a little like "you can't fire me, I quit!" - doing what we don't want before someone else has a chance to.
Tom
Tom
El 3 abr 2017, a las 15:29, Nathan Bouscal
escribió:
I expect most people probably agree that it'd be nice to have tuples be
unbiased cartesian product, but the actual fact of the matter is that tuples as they exist in Haskell are biased. We can't just ignore that and
they're unbiased. It definitely sucks that the answer people would naively give to "what is a tuple in Haskell" is not the correct answer, but we're stuck in that situation. The question is how to make the best of it.
On Mon, Apr 3, 2017 at 12:56 PM, Henning Thielemann
wrote: On Mon, 3 Apr 2017, Sven Panne wrote:
Of course such an interpretation is possible, but let's remember Abelson's famous quote:
"Programs must be written for people to read, and only incidentally for machines to execute."
When you show somebody a pair and ask "What is this?", how many
an pretend people do
you *seriously* expect to say "Oh, yeah, I've seen that: It's a value on the right decorated by another one on the left!" compared to people telling you something about e.g. cartesian products (which are totally symmetric with no bias to the right or left)? The point is: Using a pair for a decorated one-element container is completely miscommunicating your intent, even if you find a sensible mathematical interpretation for it.
That's what I am saying all the time. _______________________________________________ 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
_______________________________________________ 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

Bifunctor and or new types for Swap / Flip style combinators seem to allow
roving parameters for functor. It's not pretty but it works.
On Thu, Apr 6, 2017 at 6:49 PM Nathan Bouscal
It *is* actually a useful instance and it is used in practice. It's not that better Haskell wouldn't have an biased pair type with these instances, it's that it would *also* have an unbiased one with the instances that such a type could support. The issue seems to be that people don't like the biased type having special syntax that wrongly gives an unknowing reader the impression that the type is unbiased. This is a reasonable position, but getting rid of the tuple instances isn't a reasonable way to act on that position: 1) they're going to be defined anyway, but also 2) it's not helpful to just pretend the type is unbiased when it isn't. It would be coherent to argue for the removal of the special tuple syntax (though coherent doesn't mean reasonable; this would break everything), but it's not coherent to argue for crippling tuples so we can pretend they're something they aren't.
On Thu, Apr 6, 2017 at 11:17 AM
wrote: El 6 abr 2017, a las 08:52, Ivan Lazar Miljenovic < ivan.miljenovic@gmail.com> escribió:
On 6 April 2017 at 23:56,
wrote: I don't totally understand this viewpoint. It sounds like what you're saying is it's unfortunate that tuples (and everything else) are biased in Haskell, but because they are we're obligated to make all the legal instances we can for them. E.g. if I define a datatype "data Foo x y z", I'm powerless and sort of obligated to define "instance Functor (Foo x y)" if there's a legal one, regardless of if that's what I want Foo to mean.
Is Foo going to be widely used or only an internal data type to your own code?
For the sake of comparison, let's say it's going to be widely used. It's also a structure which isn't (conceptually) biased.
If we're starting from a place of feeling that it's a shame Haskell is unable to have unbiased structures, then probably an "if we knew then what we know now" version of Haskell would have them. So then why knowingly create instances we think a "better Haskell" wouldn't have?
Is the argument that if it's public-facing, someone's going to define the instance and so we should do it canonically? If so, this feels to me a little like "you can't fire me, I quit!" - doing what we don't want before someone else has a chance to.
Tom
Tom
El 3 abr 2017, a las 15:29, Nathan Bouscal
escribió:
I expect most people probably agree that it'd be nice to have tuples be
unbiased cartesian product, but the actual fact of the matter is that tuples as they exist in Haskell are biased. We can't just ignore that and
they're unbiased. It definitely sucks that the answer people would naively give to "what is a tuple in Haskell" is not the correct answer, but we're stuck in that situation. The question is how to make the best of it.
On Mon, Apr 3, 2017 at 12:56 PM, Henning Thielemann
wrote: On Mon, 3 Apr 2017, Sven Panne wrote:
Of course such an interpretation is possible, but let's remember Abelson's famous quote:
"Programs must be written for people to read, and only incidentally for machines to execute."
When you show somebody a pair and ask "What is this?", how many
an pretend people do
you *seriously* expect to say "Oh, yeah, I've seen that: It's a value on the right decorated by another one on the left!" compared to people telling you something about e.g. cartesian products (which are totally symmetric with no bias to the right or left)? The point is: Using a pair for a decorated one-element container is completely miscommunicating your intent, even if you find a sensible mathematical interpretation for it.
That's what I am saying all the time. _______________________________________________ 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
_______________________________________________ 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
_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

Am 07.04.2017 um 00:48 schrieb Nathan Bouscal:
It *is* actually a useful instance and it is used in practice. It's not that better Haskell wouldn't have an biased pair type with these instances, it's that it would *also* have an unbiased one with the instances that such a type could support.
Nobody (I think) claimed that the biased type isn't useful. We merely discuss whether it would not be more useful to define new types for that with names that convey the intent, and leave (,) and Either unbiased as their name (and special notation) suggests.
The issue seems to be that people don't like the biased type having special syntax that wrongly gives an unknowing reader the impression that the type is unbiased.
This is not the only reason, see above.
This is a reasonable position, but getting rid of the tuple instances isn't a reasonable way to act on that position: 1) they're going to be defined anyway,
Would you say the same for non-law-abiding instances for, say, class Monad?
but also 2) it's not helpful to just pretend the type is unbiased when it isn't.
We are used to pretend a lot in Haskell. We cannot capture all properties in types, but we expect them to hold nevertheless. Are you saying that this is bad because, well someone is going to come and define a Monad instance that doesn't obey the laws anyway, so let's not pretend the Monad laws hold?
It would be coherent to argue for the removal of the special tuple syntax (though coherent doesn't mean reasonable; this would break everything), but it's not coherent to argue for crippling tuples so we can pretend they're something they aren't.
Pretending that a thing is actually something other than it really is is the whole idea of high level languages. All data and code are just bits in the end. You can enforce certain re-interpretations of these bits using a type system. But what matters is that we intend a Char to be a character and consciously avoid asking "what it really is" i.e. how it is represented. Cheers Ben

- The message I was directly responding to included the phrases 'instances
we think a "better Haskell" wouldn't have' and 'doing what we don't want
before someone else has a chance to'. That's what I was responding to when
I said that the instances are useful.
- You're trying to establish an analogy between these tuple instances and
non-law-abiding instances, but that analogy really doesn't work. These are
the only law-abiding instances that the types can possibly have. When I
claim something is a Monad, I'm saying that if the compiler knew how to
take a proof, I'd be able to provide one. When you claim tuples are
unbiased, there is no analogous statement. You can't say that you'd be able
to provide a proof that tuples are unbiased, because they *aren't* unbiased.
- A lot of these arguments are taking the form "let's have unbiased
tuples", but the actual impact of just removing the instances wouldn't be
unbiased tuples, it would be a crippled biased tuple. Getting rid of the
instances wouldn't make tuples any less biased, it would just take away
useful functionality. Suggestions like Vladislav's of implementing an
actual unbiased tuple are more reasonable (though as pointed out, they'd
break *tons* of code, so still not that reasonable).
On Sat, Apr 8, 2017 at 4:28 PM, Ben Franksen
Am 07.04.2017 um 00:48 schrieb Nathan Bouscal:
It *is* actually a useful instance and it is used in practice. It's not that better Haskell wouldn't have an biased pair type with these instances, it's that it would *also* have an unbiased one with the instances that such a type could support.
Nobody (I think) claimed that the biased type isn't useful. We merely discuss whether it would not be more useful to define new types for that with names that convey the intent, and leave (,) and Either unbiased as their name (and special notation) suggests.
The issue seems to be that people don't like the biased type having special syntax that wrongly gives an unknowing reader the impression that the type is unbiased.
This is not the only reason, see above.
This is a reasonable position, but getting rid of the tuple instances isn't a reasonable way to act on that position: 1) they're going to be defined anyway,
Would you say the same for non-law-abiding instances for, say, class Monad?
but also 2) it's not helpful to just pretend the type is unbiased when it isn't.
We are used to pretend a lot in Haskell. We cannot capture all properties in types, but we expect them to hold nevertheless. Are you saying that this is bad because, well someone is going to come and define a Monad instance that doesn't obey the laws anyway, so let's not pretend the Monad laws hold?
It would be coherent to argue for the removal of the special tuple syntax (though coherent doesn't mean reasonable; this would break everything), but it's not coherent to argue for crippling tuples so we can pretend they're something they aren't.
Pretending that a thing is actually something other than it really is is the whole idea of high level languages. All data and code are just bits in the end. You can enforce certain re-interpretations of these bits using a type system. But what matters is that we intend a Char to be a character and consciously avoid asking "what it really is" i.e. how it is represented.
Cheers Ben
_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

On 04/09/2017 12:51 AM, Nathan Bouscal wrote:
- You're trying to establish an analogy between these tuple instances and non-law-abiding instances, but that analogy really doesn't work. These are the only law-abiding instances that the types can possibly have.
Yes. But that is, actually, more of a syntactic accident than any deeply mathematical property: mathematically, there are n ways to make an n-tuple a functor, And if we, for "consistency", continue to add functor instances for tuples for n > 2, the situation, in the view of many reasonable people at least, becomes increasingly absurd, or at least it becomes increasingly clear that that the utility we get is a smaller and smaller part of what we really need. Simply because tuples actually are "morally unbiased", as Vladislav Zavialov phrased it; i.e., there are perfectly legitimate uses where the fields are of equal importance: there is no a priori "pay load" field, and no a priori "annotation" fields. And in fact, that is *exactly* what tuples originally were in Haskell, and how many very reasonably people still prefers to think about them. And of course, if, in a hypothetical future version of Haskell where we could make all possible functor instances for tuples, the question becomes: which one do we pick? The answer might well be "none" (in the prelude, at least). (A newtype wrapper approach, e.g. a la numeric Monid instances, would be both unpalatable and ultimately pointless.) So, in summary, I'd find the argument for the present tuple instances much more compelling if it *mathematically* were the case that the only law-abiding instances are those ones. But that is not the case. Best, /Henrik This message and any attachment are intended solely for the addressee and may contain confidential information. If you have received this message in error, please send it back to me, and immediately delete it. Please do not use, copy or disclose the information contained in this message or in any attachment. Any views or opinions expressed by the author of this email do not necessarily reflect the views of the University of Nottingham. This message has been checked for viruses but the contents of an attachment may still contain software viruses which could damage your computer system, you are advised to perform your own checks. Email communications with the University of Nottingham may be monitored as permitted by UK legislation.

Already done mate. https://hackage.haskell.org/package/hask-0/docs/Hask-Category.html#t:Either https://hackage.haskell.org/package/hask-0/docs/Hask-Category.html#t:Functor Note the multiple Functor instances for Either and Coproduct. e.g. - Functor * (* -> *) Either - Functor * * (Either a) etc etc On 09/04/17 10:29, Henrik Nilsson wrote:
And of course, if, in a hypothetical future version of Haskell where we could make all possible functor instances for tuples, the question becomes: which one do we pick? The answer might well be "none" (in the prelude, at least).

Am 09.04.2017 um 01:51 schrieb Nathan Bouscal:
- You're trying to establish an analogy between these tuple instances and non-law-abiding instances, but that analogy really doesn't work. These are the only law-abiding instances that the types can possibly have. When I claim something is a Monad, I'm saying that if the compiler knew how to take a proof, I'd be able to provide one. When you claim tuples are unbiased,
I do not claim tuples *are* unbiased. I have been (espressly) talking about intent. A programming language is a tool designed by humans, not an artefact of nature. Whatever tuples are, factually, is not important. The only important thing is what we *want* them to be. Of course we want our intents to be consistent, but I don't see how ignoring the (unavoidable) bias violates consistency.
there is no analogous statement. You can't say that you'd be able to provide a proof that tuples are unbiased, because they *aren't* unbiased.
You can't prove that instances of Monad adhere to the Monad laws, in general. But you can (informally) express your intent that instances *should* adhere to the laws. Yes, for a single concrete instance you can provide proof that the laws are fulfilled. And for a single concrete program (or library, or module, or function) that uses tuples I can prove that it does not depend on the (existing, but not intended) bias for tuples.
- A lot of these arguments are taking the form "let's have unbiased tuples", but the actual impact of just removing the instances wouldn't be unbiased tuples,
Again, you argue as if we were talking about a mechanical system. The "impact" in this case depends on people's behavior and expectations. We are talking about *designing* library infrastructure.
it would be a crippled biased tuple. Getting rid of the instances wouldn't make tuples any less biased, it would just take away useful functionality.
And this is where we differ: IMO it would take away functionality that is confusing and ill-termed. The desired functionality is not bad perse, but would be much better provided by dedicated data types that clearly express the intent of using the bias induces by currying and left to right order of type arguments. The tuples with reduced functionality would be more useful, not less, because one could rely on them not acting in strange and unexpected ways. See the many examples that people provided for refactoring code that uses tuples and where the type error was the intended and expected behavior and the "functionality" provided by Foldable instances was in fact dysfunctional. Cheers Ben

Am 06.04.2017 um 21:18 schrieb amindfv@gmail.com:
On 6 April 2017 at 23:56,
wrote: I don't totally understand this viewpoint. It sounds like what you're saying is it's unfortunate that tuples (and everything else) are biased in Haskell, but because they are we're obligated to make all the legal instances we can for them. E.g. if I define a datatype "data Foo x y z", I'm powerless and sort of obligated to define "instance Functor (Foo x y)" if there's a legal one, regardless of if that's what I want Foo to mean.
Is Foo going to be widely used or only an internal data type to your own code?
For the sake of comparison, let's say it's going to be widely used. It's also a structure which isn't (conceptually) biased.
If we're starting from a place of feeling that it's a shame Haskell is unable to have unbiased structures, then probably an "if we knew then what we know now" version of Haskell would have them. So then why knowingly create instances we think a "better Haskell" wouldn't have?
Is the argument that if it's public-facing, someone's going to define the instance and so we should do it canonically? If so, this feels to me a little like "you can't fire me, I quit!" - doing what we don't want before someone else has a chance to.
I think the situation is analogous to honoring class laws. There is no way in Haskell to enforce them. But there is an unwritten code of conduct (sic!) for library writers, to define only (public) instances that adhere to the stated laws. Why can't we not state that a certain data type is intended to by symmetric in its arguments? And expect that others respect that intent and refrain from defining asymmetric Functor, Foldable, etc instances for it? Cheers Ben

Discussion has been raised elsewhere about `Either e` just in the last month or so, etc as well. The goal posts slide around quite a bit, almost like there are lots of people with different opinions. Others are fine with the instances but want to monomorphize null, length, maximum/minimum/sum/product/everything, it depends on who you ask and when. -Edward On Mon, Apr 3, 2017 at 12:38 PM, Henning Thielemann < lemming@henning-thielemann.de> wrote:
On Mon, 3 Apr 2017, David Feuer wrote:
That leaves a few trouble spots:
1. There are types that some people think shouldn't have Functor/Foldable/Traversable instances at all, or that some people would like to have Functor and maybe even Traversable instances for without wanting Foldable instances. The latter is impossible because of a superclass constraint. One essential issue here seems to be one of perspective: is Foo x y a container of ys, decorated with xs, or is it a container of xs and ys? Different people tend to think about this differently, and thus form different intuitions.
I don't know if anyone has a problem with interpreting a custom data type Foo x y as a container of ys decorated with xs - if it is defined for that purpose. Discussion arose solely about the cases Foo = (,), Foo = (,,) x and so on. E.g. I actually proposed to define a custom data type like Decorated x y instead of (x,y) in case you want to have a Foldable instance.
_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

Thanks for all the mails, but I'm still missing an answer, so I must
have done something wrong. I guess I didn't explain my question well.
Or nobody thinks it's worth answering (in which case, sorry, but I'd
prefer to be told I'm misguided, over having the question ignored).
I'm not asking what length is supposed to do. And I'm especially not
trying to argue for a change—I have no new arguments to contribute
there. I'm really asking a different question: do length docs actually
give a complete specification—it still seems to me they don't.
I've given up long ago on proper specifications for library
*functions* (beyond types, since they're often not enough)—there, it's
less bad, as long as you accept that the implementation is in fact the
specification, and information hiding is nowhere in sight. There,
proper specs (especially textual one) would be too expensive.
But default implementations for typeclass methods are not specs, since
you *can* override them.
But that's very confusing: can really debate on `length (a, b) = 1`
have continued for so long, without noticing that `length = getSum .
foldMap (Sum . const 1)` is a fundamental assumption and is not
mandated by anything written down? I assume I must be missing
something, which is why I asked.
Of all incomplete docs, this matters more since `length (a, b)` is so
surprising. The unsuspecting looking at docs lacks the facts needed to
infer this wart. Spelling out implications would IMHO be even better,
for the same reason people state theorems even though they can be
proved, but maybe some disagree. A complete spec would be a starting
point.
Not that anybody has a duty to fix those docs. But if nobody
acknowledges docs aren't doing their job, why should anybody attempt a
fix?
On 3 April 2017 at 17:59, David Feuer
length should be quite well-behaved relative to foldMap:
length = getSum . foldMap (Sum . const 1)
Thanks, that looks useful to add to docs. I was thinking of `length = length . toList`.
Another law pretty much everyone agrees on is that *if* f is an instance of Traversable, then
foldMap = foldMapDefault
Cheers, -- Paolo G. Giarrusso - Ph.D. Student, Tübingen University http://ps.informatik.uni-tuebingen.de/team/giarrusso/
participants (14)
-
amindfv@gmail.com
-
Ben Franksen
-
Carter Schonwald
-
David Feuer
-
Edward Kmett
-
Henning Thielemann
-
Henrik Nilsson
-
Ivan Lazar Miljenovic
-
Jon Fairbairn
-
Nathan Bouscal
-
Paolo Giarrusso
-
Sven Panne
-
Tony Morris
-
Vladislav Zavialov