Proposal: unify constant functors

Hello all, I recently (re)noticed the following duplication: base:Control.Applicative newtype Const a b = Const { getConst :: a } instance Functor (Const m) where... instance Monoid m => Applicative (Const m) where... transformers:Data.Functor.Constant newtype Constant a b = Constant { getConstant :: a } instance Functor (Constant a) where... instance Foldable (Constant a) where... instance Traversable (Constant a) where... instance (Monoid a) => Applicative (Constant a) where... I don't see any reason for this redundancy. I propose we: (1) add the Foldable and Traversable instances to base, and (2) deprecate transformers:Data.Functor.Constant This will cause breakage to any orphan instances of Foldable/Traversable for Const, but that seems fine by me. Eventually we'll want to remove transformers:Data.Functor.Constant (or have it re-export the Const stuff from base:Control.Applicative); but that can be handled later. Deadline: 14 May 2012. -- Live well, ~wren

+1, seems reasonable. Edward Excerpts from wren ng thornton's message of Mon Apr 30 01:33:39 -0400 2012:
Hello all,
I recently (re)noticed the following duplication:
base:Control.Applicative newtype Const a b = Const { getConst :: a } instance Functor (Const m) where... instance Monoid m => Applicative (Const m) where...
transformers:Data.Functor.Constant newtype Constant a b = Constant { getConstant :: a } instance Functor (Constant a) where... instance Foldable (Constant a) where... instance Traversable (Constant a) where... instance (Monoid a) => Applicative (Constant a) where...
I don't see any reason for this redundancy. I propose we:
(1) add the Foldable and Traversable instances to base, and (2) deprecate transformers:Data.Functor.Constant
This will cause breakage to any orphan instances of Foldable/Traversable for Const, but that seems fine by me. Eventually we'll want to remove transformers:Data.Functor.Constant (or have it re-export the Const stuff from base:Control.Applicative); but that can be handled later.
Deadline: 14 May 2012.

On 30 April 2012 07:33, wren ng thornton
(1) add the Foldable and Traversable instances to base, and
+1
(2) deprecate transformers:Data.Functor.Constant
+1. I assume you want to re-export Control.Applicative.Constant from Data.Functor.Constant and deprecate the whole module as in: module Data.Functor.Constant {-# DEPRECATED "Import Constant from Control.Applicative instead" #-} ( Constant(..) ) where import Control.Applicative Bas

On Mon, Apr 30, 2012 at 10:55:51AM +0100, Bas van Dijk wrote:
On 30 April 2012 07:33, wren ng thornton
wrote: (1) add the Foldable and Traversable instances to base, and
+1
(2) deprecate transformers:Data.Functor.Constant
+1.
I assume you want to re-export Control.Applicative.Constant from Data.Functor.Constant and deprecate the whole module as in:
module Data.Functor.Constant {-# DEPRECATED "Import Constant from Control.Applicative instead" #-} ( Constant(..) ) where
import Control.Applicative
Not quite, as the one in Control.Applicative is called Const and the one in Data.Functor.Constant is called Constant. I slightly prefer the full name. Maybe just move Data.Functor.Constant into base (removing the copy in Control.Applicative)?

On 30.04.12 1:56 PM, Ross Paterson wrote:
On Mon, Apr 30, 2012 at 10:55:51AM +0100, Bas van Dijk wrote:
On 30 April 2012 07:33, wren ng thornton
wrote: (1) add the Foldable and Traversable instances to base, and
+1
(2) deprecate transformers:Data.Functor.Constant
I assume you want to re-export Control.Applicative.Constant from Data.Functor.Constant and deprecate the whole module as in:
module Data.Functor.Constant {-# DEPRECATED "Import Constant from Control.Applicative instead" #-} ( Constant(..) ) where
import Control.Applicative
Not quite, as the one in Control.Applicative is called Const and the one in Data.Functor.Constant is called Constant. I slightly prefer the full name. Maybe just move Data.Functor.Constant into base (removing the copy in Control.Applicative)?
I'd second that. All I get from Const in Control.Applicative is import conflicts. The full name, 'Constant' is better. -- Andreas Abel <>< Du bist der geliebte Mensch. Theoretical Computer Science, University of Munich Oettingenstr. 67, D-80538 Munich, GERMANY andreas.abel@ifi.lmu.de http://www2.tcs.ifi.lmu.de/~abel/

On 4/30/12 8:05 AM, Andreas Abel wrote:
On 30.04.12 1:56 PM, Ross Paterson wrote:
On Mon, Apr 30, 2012 at 10:55:51AM +0100, Bas van Dijk wrote:
On 30 April 2012 07:33, wren ng thornton
wrote: (1) add the Foldable and Traversable instances to base, and
+1
(2) deprecate transformers:Data.Functor.Constant
I assume you want to re-export Control.Applicative.Constant from Data.Functor.Constant and deprecate the whole module as in:
module Data.Functor.Constant {-# DEPRECATED "Import Constant from Control.Applicative instead" #-} ( Constant(..) ) where
import Control.Applicative
Not quite, as the one in Control.Applicative is called Const and the one in Data.Functor.Constant is called Constant. I slightly prefer the full name. Maybe just move Data.Functor.Constant into base (removing the copy in Control.Applicative)?
I'd second that. All I get from Const in Control.Applicative is import conflicts. The full name, 'Constant' is better.
I rather prefer the short name m'self. Where do you get the import conflicts from? For the record, I'd be fine with moving Data.Functor.Constant to base (I rather prefer that as the module name, as opposed to exporting it from Control.Applicative), I was just proposing the smallest change that would resolve the duplication. -- Live well, ~wren

On Mon, Apr 30, 2012 at 01:33:39AM -0400, wren ng thornton wrote:
Hello all,
I recently (re)noticed the following duplication:
base:Control.Applicative newtype Const a b = Const { getConst :: a } instance Functor (Const m) where... instance Monoid m => Applicative (Const m) where...
transformers:Data.Functor.Constant newtype Constant a b = Constant { getConstant :: a } instance Functor (Constant a) where... instance Foldable (Constant a) where... instance Traversable (Constant a) where... instance (Monoid a) => Applicative (Constant a) where...
I don't see any reason for this redundancy. I propose we:
(1) add the Foldable and Traversable instances to base, and (2) deprecate transformers:Data.Functor.Constant
Why do it this way? For backwards compatibility? It seems to me it would be much more consistent to remove the one in Control.Applicative and have all the fundamental functor combinators in one place. -Brent

+1 for going Brent and Ross's way, (removing Const from Control.Applicative
and moving Data.Functor.Constant into base) but overall happy with the idea
no matter how we do it.
I prefer the separate module approach because there are many other similar
functors that we may want to migrate into base over time, and it wouldn't
make sense to have one of them hiding in Control.Applicative.
-Edward
On Mon, Apr 30, 2012 at 8:38 AM, Brent Yorgey
On Mon, Apr 30, 2012 at 01:33:39AM -0400, wren ng thornton wrote:
Hello all,
I recently (re)noticed the following duplication:
base:Control.Applicative newtype Const a b = Const { getConst :: a } instance Functor (Const m) where... instance Monoid m => Applicative (Const m) where...
transformers:Data.Functor.Constant newtype Constant a b = Constant { getConstant :: a } instance Functor (Constant a) where... instance Foldable (Constant a) where... instance Traversable (Constant a) where... instance (Monoid a) => Applicative (Constant a) where...
I don't see any reason for this redundancy. I propose we:
(1) add the Foldable and Traversable instances to base, and (2) deprecate transformers:Data.Functor.Constant
Why do it this way? For backwards compatibility? It seems to me it would be much more consistent to remove the one in Control.Applicative and have all the fundamental functor combinators in one place.
-Brent
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

+1 for the Brent / Ross approach. --Ben On 1 May 2012, at 19:43, Edward Kmett wrote:
+1 for going Brent and Ross's way, (removing Const from Control.Applicative and moving Data.Functor.Constant into base) but overall happy with the idea no matter how we do it.
I prefer the separate module approach because there are many other similar functors that we may want to migrate into base over time, and it wouldn't make sense to have one of them hiding in Control.Applicative.
-Edward
On Mon, Apr 30, 2012 at 8:38 AM, Brent Yorgey
wrote: On Mon, Apr 30, 2012 at 01:33:39AM -0400, wren ng thornton wrote: Hello all,
I recently (re)noticed the following duplication:
base:Control.Applicative newtype Const a b = Const { getConst :: a } instance Functor (Const m) where... instance Monoid m => Applicative (Const m) where...
transformers:Data.Functor.Constant newtype Constant a b = Constant { getConstant :: a } instance Functor (Constant a) where... instance Foldable (Constant a) where... instance Traversable (Constant a) where... instance (Monoid a) => Applicative (Constant a) where...
I don't see any reason for this redundancy. I propose we:
(1) add the Foldable and Traversable instances to base, and (2) deprecate transformers:Data.Functor.Constant
Why do it this way? For backwards compatibility? It seems to me it would be much more consistent to remove the one in Control.Applicative and have all the fundamental functor combinators in one place.
-Brent
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On 1 May 2012, at 19:43, Edward Kmett wrote:
+1 for going Brent and Ross's way, (removing Const from Control.Applicative and moving Data.Functor.Constant into base) but overall happy with the idea no matter how we do it.
I think this is sensible, but I'm mildly inclined to plead for a much shorter name: K. I realise it would be completely inappropriate to use convenient names based on combinatory logic in a programming language called Haskell, but frankly, every time I have to type "onstant" I feel like giving someone a "dentity". If, as I am, you are given to constructing types from polynomials type BinarySearchTree = Mu (K () :+: (I :*: K Int :*: I)) readability is helped by short names. The many wonderful closure properties of polynomial functors give lots of standard equipment (traversability, zippers,...) for free. Of course, this is something of a minority sport. But it might be worth thinking about how Constant fits into a bigger picture in order to design its place in the ecosystem. All the best Conor
I prefer the separate module approach because there are many other similar functors that we may want to migrate into base over time, and it wouldn't make sense to have one of them hiding in Control.Applicative.
-Edward
On Mon, Apr 30, 2012 at 8:38 AM, Brent Yorgey
wrote: On Mon, Apr 30, 2012 at 01:33:39AM -0400, wren ng thornton wrote: Hello all,
I recently (re)noticed the following duplication:
base:Control.Applicative newtype Const a b = Const { getConst :: a } instance Functor (Const m) where... instance Monoid m => Applicative (Const m) where...
transformers:Data.Functor.Constant newtype Constant a b = Constant { getConstant :: a } instance Functor (Constant a) where... instance Foldable (Constant a) where... instance Traversable (Constant a) where... instance (Monoid a) => Applicative (Constant a) where...
I don't see any reason for this redundancy. I propose we:
(1) add the Foldable and Traversable instances to base, and (2) deprecate transformers:Data.Functor.Constant
Why do it this way? For backwards compatibility? It seems to me it would be much more consistent to remove the one in Control.Applicative and have all the fundamental functor combinators in one place.
-Brent
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On 5/2/12 6:36 AM, Conor McBride wrote:
On 1 May 2012, at 19:43, Edward Kmett wrote:
+1 for going Brent and Ross's way, (removing Const from Control.Applicative and moving Data.Functor.Constant into base) but overall happy with the idea no matter how we do it.
I think this is sensible, but I'm mildly inclined to plead for a much shorter name: K. I realise it would be completely inappropriate to use convenient names based on combinatory logic in a programming language called Haskell, but frankly, every time I have to type "onstant" I feel like giving someone a "dentity".
Indeed. I'm fine with Const (we don't call the value-level function k, afterall), but Constant is just too much. Ditto for the excessively lengthy naming of the identity functor. For things this basic and this widely used, all that verbosity gives me flashbacks to coding in Java. I don't think I'll argue for the combinatory names, but I certainly wouldn't argue against them either. -- Live well, ~wren

On Thu, 3 May 2012, wren ng thornton wrote:
Indeed. I'm fine with Const (we don't call the value-level function k, afterall), but Constant is just too much. Ditto for the excessively lengthy naming of the identity functor. For things this basic and this widely used, all that verbosity gives me flashbacks to coding in Java.
It's not all bad in imperative languages ... Do you really use "Identity" everywhere? I use it only implicitly as part of transformers:State monads and friends. Identity's meaning is immediately clear. 'Ident' or 'Id' could also be 'identifier'. 'Const' could also mean 'constructor'. I also prefer 'Integer' to \mathbb{Z} and 'Rational' to \mathbb{Q}.

On 5/3/12 7:23 PM, Henning Thielemann wrote:
On Thu, 3 May 2012, wren ng thornton wrote:
Indeed. I'm fine with Const (we don't call the value-level function k, afterall), but Constant is just too much. Ditto for the excessively lengthy naming of the identity functor. For things this basic and this widely used, all that verbosity gives me flashbacks to coding in Java.
It's not all bad in imperative languages ...
There's a difference between imperative programming in general, and Java programming in particular ;)
Do you really use "Identity" everywhere? I use it only implicitly as part of transformers:State monads and friends.
Everywhere would be an exaggeration, but I do use it rather frequently. It helps reduce boilerplate when you want both pure and monadic/functorial (i.e., *->*) versions of things and don't care too much about performance. It's the monad of choice when instantiating rank-2 quantifiers. It's a primitive of generic programming with polynomial types, as Conor mentioned. etc.
Identity's meaning is immediately clear. 'Ident' or 'Id' could also be 'identifier'.
'Const' could also mean 'constructor'.
I also prefer 'Integer' to \mathbb{Z} and 'Rational' to \mathbb{Q}.
Should we rename 'id' to 'identity' and 'const' to 'constant' then? The purported confusion is exactly the same since there must be values to inhabit your identity and constructor types. If anything, you're only making an argument for K and I in lieu of Const and Id. I'm fine with Integer, in virtue of the fact that it's unbounded and we have Int for the bounded version, so the lengthiness of the name actually conveys valuable information. Rational is in a similar position in virtue of the Ratio type it's an alias for. In mathematics I refer to those types often enough that having the names \mathbb{N}, \mathbb{Z}, \mathbb{Q}, \mathbb{R}, \mathbb{C},... is extremely helpful for brevity and clarity. In programming, I use them infrequently enough (compared to other types) that little would be gained by such brevity. -- Live well, ~wren

On 4/30/12 8:38 AM, Brent Yorgey wrote:
On Mon, Apr 30, 2012 at 01:33:39AM -0400, wren ng thornton wrote:
Hello all,
I recently (re)noticed the following duplication:
base:Control.Applicative newtype Const a b = Const { getConst :: a } instance Functor (Const m) where... instance Monoid m => Applicative (Const m) where...
transformers:Data.Functor.Constant newtype Constant a b = Constant { getConstant :: a } instance Functor (Constant a) where... instance Foldable (Constant a) where... instance Traversable (Constant a) where... instance (Monoid a) => Applicative (Constant a) where...
I don't see any reason for this redundancy. I propose we:
(1) add the Foldable and Traversable instances to base, and (2) deprecate transformers:Data.Functor.Constant
Why do it this way? For backwards compatibility? It seems to me it would be much more consistent to remove the one in Control.Applicative and have all the fundamental functor combinators in one place.
I think that Const/Constant should be in base because it's such a primitive thing and used all over the place. Other than that, I was mainly aiming for minimal breakage in resolving the duplication. -- Live well, ~wren

On Thu, 3 May 2012, wren ng thornton wrote:
I think that Const/Constant should be in base because it's such a primitive thing and used all over the place. Other than that, I was mainly aiming for minimal breakage in resolving the duplication.
I just wanted to ask, where you need it. I have never used it. How can I improve my code with it? Independent from this question I am concerned with putting so much into 'base'. 'transformers' can be updated independent from the compiler, and 'base' cannot. Thus for me, 'Constant' in 'transformers' has the right name (understandable to the casual user) in the right place.

On 5/3/12 7:18 PM, Henning Thielemann wrote:
On Thu, 3 May 2012, wren ng thornton wrote:
I think that Const/Constant should be in base because it's such a primitive thing and used all over the place. Other than that, I was mainly aiming for minimal breakage in resolving the duplication.
I just wanted to ask, where you need it. I have never used it. How can I improve my code with it?
Again, it's primitive for generic programming with polynomial types. I often use it to lift types of kind * into types of kind *->* which is frequently necessary for generic programming. The code I was working on when I noticed the duplication uses it to instantiate a rank-2 quantifier in order to get rid of an existential type.
Independent from this question I am concerned with putting so much into 'base'. 'transformers' can be updated independent from the compiler, and 'base' cannot. Thus for me, 'Constant' in 'transformers' has the right name (understandable to the casual user) in the right place.
Since transformers is in the Haskell Platform, it doesn't especially matter to me. But this is the sort of thing that belongs in an extended prelude, much like Data.List and other modules from before the era of hierarchical module names. The code for the constant functor isn't liable to change by much, the only reason for it to change would be to add new instances for new classes in base (since other classes could provide the instance when defining the class itself), so the fact that it's in a boot library isn't much of a burden. Whether GHC actually uses it internally may settle the matter, however. Even the casual user will recognize Const as a capitalized version of the const function from the Prelude. -- Live well, ~wren

As I see, we have run in a discussion about identifiers and whether to abbreviate. While in math every defined symbol should have at most 3 letters, in information technology one tends to spell out names because there is such an abundant amount of concepts. [And, of course, because typing on a keyboard is much faster than handwriting on a chalkboard.] I think libraries, and in particular standard libraries should prefer to spell out identifiers, unless the abbreviation has secured its status due to a long tradition already. I do not see that for 'Const'. P.S.: I'd prefer to use Const for my own, internal/throw-away data types, this is why I talked about "import conflicts" in my previous message. P.P.S.: All of discussion would be superfluous if import statements had a renaming option like in Agda. open import Data.Functor.Constant renaming (Constant to K) Maybe that could be a feature of future Haskell as well? On 04.05.12 2:12 AM, wren ng thornton wrote:
On 5/3/12 7:18 PM, Henning Thielemann wrote:
On Thu, 3 May 2012, wren ng thornton wrote:
I think that Const/Constant should be in base because it's such a primitive thing and used all over the place. Other than that, I was mainly aiming for minimal breakage in resolving the duplication.
I just wanted to ask, where you need it. I have never used it. How can I improve my code with it?
Again, it's primitive for generic programming with polynomial types. I often use it to lift types of kind * into types of kind *->* which is frequently necessary for generic programming. The code I was working on when I noticed the duplication uses it to instantiate a rank-2 quantifier in order to get rid of an existential type.
Independent from this question I am concerned with putting so much into 'base'. 'transformers' can be updated independent from the compiler, and 'base' cannot. Thus for me, 'Constant' in 'transformers' has the right name (understandable to the casual user) in the right place.
Since transformers is in the Haskell Platform, it doesn't especially matter to me. But this is the sort of thing that belongs in an extended prelude, much like Data.List and other modules from before the era of hierarchical module names. The code for the constant functor isn't liable to change by much, the only reason for it to change would be to add new instances for new classes in base (since other classes could provide the instance when defining the class itself), so the fact that it's in a boot library isn't much of a burden. Whether GHC actually uses it internally may settle the matter, however.
Even the casual user will recognize Const as a capitalized version of the const function from the Prelude.
-- Andreas Abel <>< Du bist der geliebte Mensch. Theoretical Computer Science, University of Munich Oettingenstr. 67, D-80538 Munich, GERMANY andreas.abel@ifi.lmu.de http://www2.tcs.ifi.lmu.de/~abel/

On 5/4/12 10:44 AM, Andreas Abel wrote:
open import Data.Functor.Constant renaming (Constant to K)
Maybe that could be a feature of future Haskell as well?
I would love such a feature. Not just for bikeshedding disputes, but as an alternative to qualified imports for when you're intentionally using different things with conflicting names. Seems like it should be easy enough to implement too (sayeth he who hasn't hacked on GHC). The real difficulty methinks would be in specifying the module import syntax, since there's a conflict between (1) creating a coherent integrated system for qualified, unqualified, renamed, explicit, and hidden imports (plus any other features we want to add at the same time); and (2) backwards compatibility. -- Live well, ~wren

On Sat, May 5, 2012 at 8:36 PM, wren ng thornton
On 5/4/12 10:44 AM, Andreas Abel wrote:
open import Data.Functor.Constant renaming (Constant to K) Maybe that could be a feature of future Haskell as well?
Seems like it should be easy enough to implement too (sayeth he who hasn't hacked on GHC). The real difficulty methinks would be in specifying the module import syntax, since there's a conflict between (1) creating a coherent integrated system for qualified, unqualified, renamed, explicit, and hidden imports (plus any other features we want to add at the same time); and (2) backwards compatibility.
Actually I'm pretty sure there is no such issue. As it is, "as" and "hiding" aren't even keywords; the syntax is flexible enough that they don't need to be keywords to avoid ambiguity. I don't think the proposed syntax is a problem either (although I think I would reuse "as" instead of using "to", just because we already have it) since (a) it's already inside a new chunk of syntax and (b) even without that, no similar syntax supports two tokens next to each other already, except "module" in export lists (so not even part of this particular element, even if syntax block is similar) which is already distinguished as a keyword. -- brandon s allbery allbery.b@gmail.com wandering unix systems administrator (available) (412) 475-9364 vm/sms

On 5/5/12 9:20 PM, Brandon Allbery wrote:
On Sat, May 5, 2012 at 8:36 PM, wren ng thornton
wrote: On 5/4/12 10:44 AM, Andreas Abel wrote:
open import Data.Functor.Constant renaming (Constant to K) Maybe that could be a feature of future Haskell as well?
Seems like it should be easy enough to implement too (sayeth he who hasn't hacked on GHC). The real difficulty methinks would be in specifying the module import syntax, since there's a conflict between (1) creating a coherent integrated system for qualified, unqualified, renamed, explicit, and hidden imports (plus any other features we want to add at the same time); and (2) backwards compatibility.
Actually I'm pretty sure there is no such issue. As it is, "as" and "hiding" aren't even keywords; the syntax is flexible enough that they don't need to be keywords to avoid ambiguity.
I was meaning issues with bikeshedding rather than with syntax per se. For instance, what is the significance in distinguishing (via the "renaming") the "as" for qualified module renaming from the "as"/"to" for term renaming? Why not just: import Foo as F (foo as f) -- Live well, ~wren

On Fri, 4 May 2012, Andreas Abel wrote:
P.P.S.: All of discussion would be superfluous if import statements had a renaming option like in Agda.
open import Data.Functor.Constant renaming (Constant to K)
Maybe that could be a feature of future Haskell as well?
If library writers would define names that work well with qualification, then we could simply use qualification renaming for that.
participants (13)
-
Andreas Abel
-
Bas van Dijk
-
Ben Moseley
-
Brandon Allbery
-
Brent Yorgey
-
Conor McBride
-
Edward Kmett
-
Edward Z. Yang
-
Henning Thielemann
-
Jon Fairbairn
-
Ross Paterson
-
Simon Hengel
-
wren ng thornton