Proposal: Add &&& and *** to Data.Tuple

Hi all, It is becoming increasingly popular to import Control.Arrow just to get access to the functions &&& and *** specialized to the function arrow. I propose to add the specialized version of these two functions to Data.Tuple which is more logical thing to import if you wish to have functions operating on tuples. I have chosen the same fixities for these operators as in Control.Arrow. I have deliberately chosen not to include any tests. These functions are so simple that eye-balling them beats any other method of verification, at least in my opinion. Some suggestions for better documentation of &&& would be very welcome. Proposal period: 2 weeks. Deadline October 1st. I haven't been able to create a ticket for this proposal. I'm unsure what the problem is, maybe trac and Firefox doesn't work so well together. No matter what I've tried (logging as both myself and as guest) trac tells me that I don't have the permission to create a ticket whenever I submit it. If someone would be willing to create a ticket for this proposal I would be grateful. Cheers, /Josef

Hi
It is becoming increasingly popular to import Control.Arrow just to get access to the functions &&& and *** specialized to the function arrow. I propose to add the specialized version of these two functions to Data.Tuple which is more logical thing to import if you wish to have functions operating on tuples.
That sounds very sensible. I have only ever used &&& and *** on tuples. This will increase the quality of the error messages, and make the intent clearer.
Proposal period: 2 weeks. Deadline October 1st.
I propose a deadline of 4 weeks, until 15th October. IFL/HW/ICFP/Hackathon are all going on and are going to reduce the amount of time people will have for this. Thanks Neil

On 9/17/07, Neil Mitchell
Hi
It is becoming increasingly popular to import Control.Arrow just to get access to the functions &&& and *** specialized to the function arrow. I propose to add the specialized version of these two functions to Data.Tuple which is more logical thing to import if you wish to have functions operating on tuples.
That sounds very sensible. I have only ever used &&& and *** on tuples. This will increase the quality of the error messages, and make the intent clearer.
Thanks for the support.
Proposal period: 2 weeks. Deadline October 1st.
I propose a deadline of 4 weeks, until 15th October. IFL/HW/ICFP/Hackathon are all going on and are going to reduce the amount of time people will have for this.
Ah, I totally missed that as I'm not going this year. Deadline in four weeks it is then. Thanks, Josef

josef.svenningsson:
Hi all,
It is becoming increasingly popular to import Control.Arrow just to get access to the functions &&& and *** specialized to the function arrow. I propose to add the specialized version of these two functions to Data.Tuple which is more logical thing to import if you wish to have functions operating on tuples.
I strongly support this. Arrow-like glue for splitting and combining streams of data through tuples should be part of every functional language :) -- Don

Josef Svenningsson wrote:
Hi all,
It is becoming increasingly popular to import Control.Arrow just to get access to the functions &&& and *** specialized to the function arrow. I propose to add the specialized version of these two functions to Data.Tuple which is more logical thing to import if you wish to have functions operating on tuples.
Other functions for which Arrow is often unnecessarily used are first and second
first :: (a -> b) -> (a,c) -> (b,c) first f (x, y) = (f x, y) second :: (a -> b) -> (c,a) -> (c,b) second f (x, y) = (x, f y)
I think these should be added as well. I don't really like these names, but they are the names from Control.Arrow. The problem is that 'fst' and 'first' are essentially the same, but they do different things. Maybe 'mapFst' or 'updateFst' is a better name. Twan

Twan van Laarhoven wrote:
Josef Svenningsson wrote:
Hi all,
It is becoming increasingly popular to import Control.Arrow just to get access to the functions &&& and *** specialized to the function arrow. I propose to add the specialized version of these two functions to Data.Tuple which is more logical thing to import if you wish to have functions operating on tuples.
Other functions for which Arrow is often unnecessarily used are first and second
first :: (a -> b) -> (a,c) -> (b,c) first f (x, y) = (f x, y) second :: (a -> b) -> (c,a) -> (c,b) second f (x, y) = (x, f y)
I think these should be added as well. I don't really like these names, but they are the names from Control.Arrow. The problem is that 'fst' and 'first' are essentially the same, but they do different things. Maybe 'mapFst' or 'updateFst' is a better name.
'onFst' and 'onSnd' look nice to me: onFst (+1) (1,'a') ==> (2,'a') Cheers Ben

On 9/18/07, Benjamin Franksen
Twan van Laarhoven wrote:
Other functions for which Arrow is often unnecessarily used are first and second
first :: (a -> b) -> (a,c) -> (b,c) first f (x, y) = (f x, y) second :: (a -> b) -> (c,a) -> (c,b) second f (x, y) = (x, f y)
I think these should be added as well. I don't really like these names, but they are the names from Control.Arrow. The problem is that 'fst' and 'first' are essentially the same, but they do different things. Maybe 'mapFst' or 'updateFst' is a better name.
'onFst' and 'onSnd' look nice to me:
onFst (+1) (1,'a') ==> (2,'a')
I omitted first and second from my proposal exactly because I didn't like the names. But onFst and onSnd sounds really nice. I'd be willing to include them in the patch if there is a general agreement about it. Cheers, Josef

Josef Svenningsson wrote:
On 9/18/07, Benjamin Franksen
wrote: Twan van Laarhoven wrote:
Other functions for which Arrow is often unnecessarily used are first and second
first :: (a -> b) -> (a,c) -> (b,c) first f (x, y) = (f x, y) second :: (a -> b) -> (c,a) -> (c,b) second f (x, y) = (x, f y)
I think these should be added as well. I don't really like these names, but they are the names from Control.Arrow. The problem is that 'fst' and 'first' are essentially the same, but they do different things. Maybe 'mapFst' or 'updateFst' is a better name. 'onFst' and 'onSnd' look nice to me:
onFst (+1) (1,'a') ==> (2,'a')
I omitted first and second from my proposal exactly because I didn't like the names. But onFst and onSnd sounds really nice. I'd be willing to include them in the patch if there is a general agreement about it.
I think I support these as library functions... I've written them myself, but standard names may make them much more comprehensible (I gave up on using them because they were too confusing)... mapFst, setFst::a'->(a,b)->(a',b), and a bunch of Functor and Monad -related ones... never mind, I'll just attach the .lhs file for your amusement. Tuple? Pair? Tuple seems better - then we can have leftAssociativelyPaired :: (a,b,c) -> ((a,b),c) etc if we want
module Tuple where
addFst :: a -> b -> (a,b) addFst a = \b -> (a,b) addSnd :: b -> a -> (a,b) addSnd b = \a -> (a,b)
--"commutePair"?
swapPair :: (a,b) -> (b,a) swapPair = \(a,b) -> (b,a)
associateLeft :: (a,(b,c)) -> ((a,b),c) associateLeft = \(a,(b,c)) -> ((a,b),c) associateRight :: ((a,b),c) -> (a,(b,c)) associateRight = \((a,b),c) -> (a,(b,c))
-- fstIntoSnd :: (a,(b,c)) -> (b,(a,c)) -- fstIntoSnd = mapSnd addFst (fst p) $ snd p -- fstFstToSndFst :: ((annotation,b),c) -> (b,(annotation,c))
type Context = (,) contextFstToSnd :: (Context ctx a, b) -> (a, Context ctx b) contextFstToOut :: (Context ctx a, b) -> Context ctx (a,b) ... or, class Context? (here??) which is no more than tupling? class (Functor c) => Context c where get :: c a -> a -- not even any "return"... transfer :: c a -> b -> c b {- class Pair (p :: * -> * -> *) where pFst :: p a b -> a pSnd :: p a b -> b pMake :: a -> b -> p a b newtype FlippedPair b a = (a,b) -}
mapFst :: (a -> a') -> (a,b) -> (a',b) mapFst f = \(a,b) -> (f a,b) setFst :: a' -> (a,b) -> (a',b) setFst = \a' (a,b) -> (a',b)
changeFst :: ((a,b) -> a') -> (a,b) -> (a',b) changeFst f p@(a,b) = (f p,b)
mapSnd :: (b -> b') -> (a,b) -> (a,b') mapSnd f = \(a,b) -> (a,f b)
runFst :: (Functor m) => ((m a),b) -> m (a,b) runFst = \(ma,b) -> fmap (addSnd b) ma runMapFst :: (Functor m) => (a -> m a') -> (a,b) -> m (a',b) runMapFst f = runFst . mapFst f runChangeFst :: (Functor m) => ((a,b) -> m a') -> (a,b) -> m (a',b) runChangeFst f = runFst . changeFst f
joinByFst :: (Monad m, Functor m) => m ((m a),b) -> m (a,b) joinByFst = (>>= runFst) joinMapFst :: (Monad m, Functor m) => (a -> m a') -> m (a,b) -> m (a',b) joinMapFst f = (>>= runMapFst f) {-= joinByFst . mapFst f-} -- joinChangeFst :: ((a,b) -> m a') -> m (a,b) -> m (a',b) -- joinChangeFst f = (>>= changeFst f) {-runSnd . -- bindByFst :: (Monad m, Functor m) => m (a,b) -> (a -> m a') -> m (a',b) -- bindByFst = flip joinMapFst

On 9/19/07, Josef Svenningsson
On 9/18/07, Benjamin Franksen
wrote: Twan van Laarhoven wrote:
Other functions for which Arrow is often unnecessarily used are first and second
first :: (a -> b) -> (a,c) -> (b,c) first f (x, y) = (f x, y) second :: (a -> b) -> (c,a) -> (c,b) second f (x, y) = (x, f y)
I think these should be added as well. I don't really like these names, but they are the names from Control.Arrow. The problem is that 'fst' and 'first' are essentially the same, but they do different things. Maybe 'mapFst' or 'updateFst' is a better name.
'onFst' and 'onSnd' look nice to me:
onFst (+1) (1,'a') ==> (2,'a')
I omitted first and second from my proposal exactly because I didn't like the names. But onFst and onSnd sounds really nice. I'd be willing to include them in the patch if there is a general agreement about it.
I have updated the patch to also include onFst and onSnd. It's attached. Cheers, /Josef

Hi Josef, On Mon, Sep 17, 2007 at 03:23:46PM +0200, Josef Svenningsson wrote:
It is becoming increasingly popular to import Control.Arrow just to get access to the functions &&& and *** specialized to the function arrow. I propose to add the specialized version of these two functions to Data.Tuple which is more logical thing to import if you wish to have functions operating on tuples.
I think that having the same function with different types is likely to cause user confusion, and also ambiguous function errors. (I also think that using a different name for the specialised versions would be a bad idea.)
I haven't been able to create a ticket for this proposal. I'm unsure what the problem is, maybe trac and Firefox doesn't work so well
I think that combination works for other people.
together. No matter what I've tried (logging as both myself
What's your username?
and as guest) trac tells me that I don't have the permission to create a ticket whenever I submit it. If someone would be willing to create a ticket for this proposal I would be grateful.
Just to confirm, you are using http://hackage.haskell.org/trac/ghc/newticket and it says "logged in as guest" at the top, right? Thanks Ian

On 9/17/07, Ian Lynagh
On Mon, Sep 17, 2007 at 03:23:46PM +0200, Josef Svenningsson wrote:
It is becoming increasingly popular to import Control.Arrow just to get access to the functions &&& and *** specialized to the function arrow. I propose to add the specialized version of these two functions to Data.Tuple which is more logical thing to import if you wish to have functions operating on tuples.
I think that having the same function with different types is likely to cause user confusion, and also ambiguous function errors.
(I also think that using a different name for the specialised versions would be a bad idea.)
So if I understand you correctly you're saying that you don't want any such functions add at all.
I haven't been able to create a ticket for this proposal. I'm unsure what the problem is, maybe trac and Firefox doesn't work so well
I think that combination works for other people.
Ok, my guess was wrong then.
together. No matter what I've tried (logging as both myself
What's your username?
josef
and as guest) trac tells me that I don't have the permission to create a ticket whenever I submit it. If someone would be willing to create a ticket for this proposal I would be grateful.
Just to confirm, you are using http://hackage.haskell.org/trac/ghc/newticket and it says "logged in as guest" at the top, right?
Yes, I'm using that page but when I open it it just complains that I don't have the right permissions. This happens even if I have logged in before. So I log in and create a new ticket, fill in the details and click either preview or submit. No matter what, trac tells me I don't have permission to create a new ticket. Thanks, Josef

On Mon, Sep 17, 2007 at 08:04:11PM +0200, Josef Svenningsson wrote:
So if I understand you correctly you're saying that you don't want any such functions add at all.
Yes. Just my opinion, of course.
together. No matter what I've tried (logging as both myself
What's your username?
josef
That user already has the necessary permissions.
and as guest) trac tells me that I don't have the permission to create a ticket whenever I submit it. If someone would be willing to create a ticket for this proposal I would be grateful.
Just to confirm, you are using http://hackage.haskell.org/trac/ghc/newticket and it says "logged in as guest" at the top, right?
Yes, I'm using that page but when I open it it just complains that I don't have the right permissions. This happens even if I have logged in before. So I log in and create a new ticket, fill in the details and click either preview or submit. No matter what, trac tells me I don't have permission to create a new ticket.
guest definitely works for me in iceape. Are you blocking cookies or anything? Thanks Ian

igloo:
On Mon, Sep 17, 2007 at 08:04:11PM +0200, Josef Svenningsson wrote:
So if I understand you correctly you're saying that you don't want any such functions add at all.
Yes. Just my opinion, of course.
together. No matter what I've tried (logging as both myself
What's your username?
josef
That user already has the necessary permissions.
and as guest) trac tells me that I don't have the permission to create a ticket whenever I submit it. If someone would be willing to create a ticket for this proposal I would be grateful.
Just to confirm, you are using http://hackage.haskell.org/trac/ghc/newticket and it says "logged in as guest" at the top, right?
Yes, I'm using that page but when I open it it just complains that I don't have the right permissions. This happens even if I have logged in before. So I log in and create a new ticket, fill in the details and click either preview or submit. No matter what, trac tells me I don't have permission to create a new ticket.
guest definitely works for me in iceape.
Are you blocking cookies or anything?
Maybe this should all just go in an external -package tuple, especially since its just duplicating and specialising base's Control.Arrow? -- Don

On Mon, 17 Sep 2007, Don Stewart wrote:
Maybe this should all just go in an external -package tuple, especially since its just duplicating and specialising base's Control.Arrow?
Isn't it the other way round? The methods (***) and (&&&) are implemented specifically for pairs and are then plugged into the Arrow (->) instance.

Hi Ian,
On 9/17/07, Ian Lynagh
On Mon, Sep 17, 2007 at 08:04:11PM +0200, Josef Svenningsson wrote:
josef
That user already has the necessary permissions.
Yes, I've used it successfully in the past.
Yes, I'm using that page but when I open it it just complains that I don't have the right permissions. This happens even if I have logged in before. So I log in and create a new ticket, fill in the details and click either preview or submit. No matter what, trac tells me I don't have permission to create a new ticket.
guest definitely works for me in iceape.
Are you blocking cookies or anything?
No, I'm not blocking anything. Thanks, Josef

Hi Josef and Ian, Josef wrote:
I propose to add the specialized version of these two functions [&&& and ***] to Data.Tuple which is more logical thing to import if you wish to have functions operating on tuples.
Ian Lynagh wrote:
I think that having the same function with different types is likely to cause user confusion, and also ambiguous function errors.
I agree, that sounds worrying. /Henrik -- Henrik Nilsson School of Computer Science and Information Technology The University of Nottingham nhn@cs.nott.ac.uk 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 9/17/07, Henrik Nilsson
Hi Josef and Ian,
Josef wrote:
I propose to add the specialized version of these two functions [&&& and ***] to Data.Tuple which is more logical thing to import if you wish to have functions operating on tuples.
Ian Lynagh wrote:
I think that having the same function with different types is likely to cause user confusion, and also ambiguous function errors.
I agree, that sounds worrying.
Henrik and Ian, You've expressed worries that having functions with the same name but different types could be problematic since it would cause confusing error messages. While I can sympathize with that argument I don't think it is an argument against having such functions. It is an indication that the tools we're using don't report errors very well. I don't think we should restrict the way we build libraries artificially because we might get bad error messages. We should instead improve the error messages! Furthermore there are already many functions in the base libraries which have the same name and they seem to cause little harm. Here's some random examples: * Data.Array.IArray contains most (all? I haven't checked) of the functions in Data.Array but generalized to work with any array in IArray. * There are many functions with the same name in Data.Map, Data.IntMap, Data.Set and Data.Sequence . * Data.ByteString has four different modules all providing the same set of function names, most of which have their names borrowed from Data.List and the Prelude. * Data.Foldable contains a whole slew of functions which are generalized versions of list processing functions. Not to mention Data.Traversable . * We have two monads defined in Control.Monad.ST and Control.Monad.ST.Lazy which provides exactly the same definitions and all functions except one mean exactly the same thing. Have you had any problems with these? Personally I've been bitten once when accidentally mixing the strict and the lazy ST monad. The error message was indeed abysmal. But as I argued above, it's not a problem with the library but rather a problem with the tools. Cheers, /Josef

On Fri, 21 Sep 2007, Josef Svenningsson wrote:
Henrik and Ian,
You've expressed worries that having functions with the same name but different types could be problematic since it would cause confusing error messages. While I can sympathize with that argument I don't think it is an argument against having such functions. It is an indication that the tools we're using don't report errors very well.
People often forget that there are more Haskell tools than the one compiler they use. There are also tools like Haddock, extended static checkers and tools that still do not exist, like an IDE for refactoring, which will be complicated by such extensions. Thus language extensions should be considered carefully before adoption. In this case, I have the feeling that people have just aversions against using the possibilities of the module system that already exist.

Sorry for my slow reply.
On 9/21/07, Henning Thielemann
On Fri, 21 Sep 2007, Josef Svenningsson wrote:
Henrik and Ian,
You've expressed worries that having functions with the same name but different types could be problematic since it would cause confusing error messages. While I can sympathize with that argument I don't think it is an argument against having such functions. It is an indication that the tools we're using don't report errors very well.
People often forget that there are more Haskell tools than the one compiler they use. There are also tools like Haddock, extended static checkers and tools that still do not exist, like an IDE for refactoring, which will be complicated by such extensions. Thus language extensions should be considered carefully before adoption. In this case, I have the feeling that people have just aversions against using the possibilities of the module system that already exist.
I'm not sure what you're talking about here. You refer to language extensions but that was not what we were talking about. We were talking about the potential problem of adding functions to a base library module which have the same name as some other functions in the base library. Ian and Henrik were worried that that might cause confusing error messages to which I responded that I think that's a problem with the tool that we shouldn't let that constrain the way we design our libraries. I hope that clear things up. And I totally agree with you that we should use the name space handling features of the module system much more that what we currently do. After all, that it what it is for! Cheers, Josef

Lads and lasses of the libraries list, The discussion deadline for the proposal of adding &&& and *** to Data.Tuple is up. Here's a summary of the discussion: * Twan van Laarhoven suggested that we should also add functions corresponding to first and second in Control.Arrow. Benjamin Franksen suggested the names onFst and onSnd. There were no objections against this and I've created a new patch which contains these functions as well. * There is a majority for this patch but it's not overwhelming. Here is the current count: In favour: Neil Mitchell, Don Steward, Twan van Laarhoven, Isaac Dupree and myself Against: Ian Lynagh, Henrik Nilsson * I responded to the objections against this patch but haven't gotten any replies so I can't say we've reached a consensus on this one. Despite the fact that we don't have a consensus I interpret the majority as a go for this patch. Cheers, Josef

On Mon, Oct 15, 2007 at 09:16:38PM +0200, Josef Svenningsson wrote:
Despite the fact that we don't have a consensus I interpret the majority as a go for this patch.
In general, I think it's important to try for consensus with the core libraries. The discussion it requires is much more likely to explore the issues. Voting should be the last resort.

Ross Paterson wrote:
On Mon, Oct 15, 2007 at 09:16:38PM +0200, Josef Svenningsson wrote:
Despite the fact that we don't have a consensus I interpret the majority as a go for this patch.
In general, I think it's important to try for consensus with the core libraries. The discussion it requires is much more likely to explore the issues. Voting should be the last resort.
I agree. I'm not sure I want to vote for this. Isaac

On Mon, Oct 15, 2007 at 09:16:38PM +0200, Josef Svenningsson wrote:
Despite the fact that we don't have a consensus I interpret the majority as a go for this patch.
In general, I think it's important to try for consensus with the core libraries. The discussion it requires is much more likely to explore the issues. Voting should be the last resort. That makes sense. What course of action do you suggest for this
On 10/16/07, Ross Paterson

"Josef Svenningsson"
On Mon, Oct 15, 2007 at 09:16:38PM +0200, Josef Svenningsson wrote:
Despite the fact that we don't have a consensus I interpret the majority as a go for this patch.
In general, I think it's important to try for consensus with the core libraries. The discussion it requires is much more likely to explore the issues. Voting should be the last resort. That makes sense. What course of action do you suggest for this
On 10/16/07, Ross Paterson
wrote: proposal then? I tried to continue the discussion with those who were against it in order to reach a consensus but I haven't gotten any replies.
Well, I wasn't sure what to say! Let me attempt to clarify my position: I dislike the practice of having more than one name for the same thing (and (***):: (Control.Arrow.Arrow a) => a b c -> a b' c' -> a (b, b') (c, c') is, in this sense the same things as a (***):: (b -> c) -> (b' -> c') -> (b, b') -> (c, c')) because it increases the mental load without increasing usefulness. So if a specialised version of *** is introduced, I'd want it to be called ***. On top of that, I don't like having specialised versions "get in the way" of general versions (by using up the name; it may not matter too much for Data.Tuple, but it does matter for map/fmap and others), hence my proposal of "subsuming"; I'd prefer not to introduce specialised versions of *** and &&& without such a mechanism. At risk of reducing the chances of subsumption getting developed into a workable idea, here's an alternative suggestion (for the general issue, as much as for this specific case): change the rules for the scope of names imported and reexported. If module A imports a name from B and re-exports it at a specialised type, and module C imports both A and B, automatically resolve uses of that name to the general version from B. I don't like this idea so much because it strikes me as ad-hoc, but it might work. For this case, what I'm suggesting is that in Data.Tuple, you'd have module Data.Tuple (***,&&&, ...) where import qualified Control.Arrow as C (***):: (b -> c) -> (b' -> c') -> (b, b') -> (c, c')) (***) = (Control.Arrow.***) ...etc... but if someone did this: module Example where import Control.Arrow import Data.Tuple f a b = a *** b the new rules would mean that f got the type of Control.Arrow.*** The only ill effect would be that the error messages might be less helpful (and a user would always have the option of import Control.Arrow hiding ((***)) and getting the other behaviour), because the rules only apply to re-export at a restricted type. -- Jón Fairbairn Jon.Fairbairn@cl.cam.ac.uk

May I suggest an alternative? Write a nice wiki article explaining that you do not need to understand arrows to use these functions. Show what the types of the functions are when used in the naive way, and give some nice examples. Explain anything else that a beginner might need to know when using them in this way - like, how to understand weird error messages you might get in GHC or Hugs. Or when it might be necessary to specify a type signature when otherwise you wouldn't have needed to. Put a link to the wiki article in the Haddock docs for Control.Arrow, and in various tutorials. And we are done. -Yitz

On 10/18/07, Yitzchak Gale
May I suggest an alternative?
Write a nice wiki article explaining that you do not need to understand arrows to use these functions.
Show what the types of the functions are when used in the naive way, and give some nice examples.
Explain anything else that a beginner might need to know when using them in this way - like, how to understand weird error messages you might get in GHC or Hugs. Or when it might be necessary to specify a type signature when otherwise you wouldn't have needed to.
Put a link to the wiki article in the Haddock docs for Control.Arrow, and in various tutorials. And we are done.
-Yitz
Sounds like a better and more light weight solution to me. Yes, the import Control.Arrow is a bit of an eyesore to me sometimes as it looks like I'm doing something complicated when I'm not. -- Johan

"Yitzchak Gale"
May I suggest an alternative?
Write a nice wiki article explaining that you do not need to understand arrows to use these functions.
Show what the types of the functions are when used in the naive way, and give some nice examples.
Explain anything else that a beginner might need to know when using them in this way - like, how to understand weird error messages you might get in GHC or Hugs. Or when it might be necessary to specify a type signature when otherwise you wouldn't have needed to.
Put a link to the wiki article in the Haddock docs for Control.Arrow, and in various tutorials. And we are done.
In a sense, yes. I'd be most happy if fmap was called map and so on and people just learned to cope. But there are educators with strong arguments against that, and this particular topic is an instance of the same thing, so some wider solution is needed. I suppose what I'm saying is that I'd prefer that the thing were not done until we have the wider solution, but if 'twere done 'twere well 'twere done by re-exporting the same names from Data.Tuple /imported from Control.Arrow/ (and requiring sophisticated people to use "hiding ((***),(&&&))" if they ever need to import Data.Tuple as when using Control.Monad). -- Jón Fairbairn Jon.Fairbairn@cl.cam.ac.uk

Hi all, Sorry for my silence. Just too much to do to keep up. So, with the risk of stating what has already been covered, my concerns are that like Jon I find the reuse of names unfortunate, especially if it is done in what appears to be a very central module. Moreover, as functions are perfectly legitimate arrow instances, I don't really see the point of it all, and I remain unconvinced by the argument that importing Control.Arrow somehow is complicated and scary. It may well be, of course, that the current class hierarchy isn't factored the right way, i.e. that operations like &&& and *** should live some place else entirely. (This wouldn't be the first instance of such problems.) That's a somewhat orthogonal discussion, though. But defining &&& and *** in more places certainly isn't going to help. Again, my apologies if my answer is uninformed and/or missing key points of the discussion. Best, /henrik -- Henrik Nilsson School of Computer Science and Information Technology The University of Nottingham nhn@cs.nott.ac.uk 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.

Sorry for my slow reply,
Well, it doesn't seem like we're anywhere near a consensus so I'll
just drop this proposal.
Let me just finish off by clarifying my views on this ticket as I
answer Henrik's post.
On 10/19/07, Henrik Nilsson
So, with the risk of stating what has already been covered, my concerns are that like Jon I find the reuse of names unfortunate, especially if it is done in what appears to be a very central module. Moreover, as functions are perfectly legitimate arrow instances, I don't really see the point of it all, and I remain unconvinced by the argument that importing Control.Arrow somehow is complicated and scary.
I don't think that importing Control.Arrow is complicated of scary. I just think it gives the wrong mental model of what it going on. In Control.Arrow it's all about the process of transforming one thing into the other. Arrows abstract over transformations and gives support for different varieties including transformations which are stateful, can throw exceptions and so on and so forth. However, when we look at the particular case of the function arrow instance there is a different mental model at play. At least for me. When I see the (&&&) operator instantiated for the function arrow I don't think about the process anymore, I think about the objects being manipulated. And the objects in this case are pairs. The reason is that the function arrow is so common in Haskell that at least I don't think about it as anything special. My focus shift towards the things that form the input and output. And those things are pairs in this case. So this really comes down to thinking about morphisms or thinking about objects if you phrase it in category theory lingo. In my brain these two ways of thinking are different and therefore I like to have separate functions for these two models. Even if it means that two functions are computationally equal. But maybe the problem is simply that I'm stupid and should learn to think about these two mental models as one :-). The other side of the coin is what to name the functions. For this proposal I chose the same names as their generalized counterparts. I can see why that worries people although I don't share that feeling. We have a module system whose purpose is (among other things) to handle names. It does so rather well, consider for instance Data.Map and Data.Set which I use extensively in my everyday programming. They have a lot of function names in common and which also clashes with Prelude names and other libraries. It's not a problem to have several functions having the same name. It's actually a feature which lessens the burden of remembering a ton of names and which shows that their intended semantics is, if not equal, then strongly related. Having these tuple function from my proposal but under different names would be OK for me though. It would be better that not having them at all.
It may well be, of course, that the current class hierarchy isn't factored the right way, i.e. that operations like &&& and *** should live some place else entirely. (This wouldn't be the first instance of such problems.)
That might be true. I don't have any opinion on that.
That's a somewhat orthogonal discussion, though. But defining &&& and *** in more places certainly isn't going to help.
Well, I disagree with that but I've already said why so no need to rehash it here. I guess we can agree to disagree. Cheers, /Josef

Hi Josef, Thanks for the thorough and thoughtful reply. You do make a number of good points, and if people in general think this is a good proposal, I don't want to be the one killing it. However, I have thought a bit more about what really bothers me about the proposal, and I think it is this. You say:
The other side of the coin is what to name the functions. For this proposal I chose the same names as their generalized counterparts. I can see why that worries people although I don't share that feeling. We have a module system whose purpose is (among other things) to handle names. It does so rather well, consider for instance Data.Map and Data.Set which I use extensively in my everyday programming. They have a lot of function names in common and which also clashes with Prelude names and other libraries. It's not a problem to have several functions having the same name. It's actually a feature which lessens the burden of remembering a ton of names and which shows that their intended semantics is, if not equal, then strongly related.
Yes. If it truly were the case that we were talking about different *functions* having the same name, I wouldn't be concerned. Data.Map and Data.Set are good examples. But here we are talking about reusing the name of a method, i.e. an already overloaded entity, as a function. That does bother me, for some reason. I guess one level of overloading too many for my taste. (Maybe my brain just cannot cope! ;-) I'd be equally concerned if someone suggested using well-established methods from, say, the Monad class for something else. Part of it is also that the fact that an entity belongs to a class notionally representing some mathematical structure implies a "moral obligation" that instances of that entity should conform to the structure, even if Haskell does not enforce this. Using such a name for something else breaks or at least weakens that conceptual link, which I think would be a pity. Sorry that I don't have time to give a more in-depth reply at this point. Best, /Henrik -- Henrik Nilsson School of Computer Science and Information Technology The University of Nottingham nhn@cs.nott.ac.uk 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.

Ian Lynagh
On Mon, Sep 17, 2007 at 03:23:46PM +0200, Josef Svenningsson wrote:
It is becoming increasingly popular to import Control.Arrow just to get access to the functions &&& and *** specialized to the function arrow. I propose to add the specialized version of these two functions
I think that having the same function with different types is likely to cause user confusion, and also ambiguous function errors.
(I also think that using a different name for the specialised versions would be a bad idea.)
This seems to be a recurrent problem, and I keep wondering whether there might not be a general solution along the lines of declaring that an instance of a class at a particular type subsumes the functions declared with those names at the specialised type. Taking the current example, in Data.Tuple there'd be (***):: (b->c)->(b'->c')->(b,b')->(c,c') (&&&):: (b->c)->(b->c')->b->(c,c') f *** g = ... f &&& g = ... and in Control.Arrow there'd be class Arrow a where ... (***):: a b c -> a b' c' -> a (b, b') (c, c') (&&&):: a b c -> a b c' -> a b (c, c') and instance Arrow (->) where ... (***) subsumes (Data.Tuple.***) (&&&) subsumes (Data.Tuple.&&&) the effect (and type checks) within the Arrow module would be the same as import qualified Data.Tuple ((***),(&&&)) instance Arrow (->) where ... (***) = (Data.Tuple.***) (&&&) = (Data.Tuple.&&&) and modules that imported only Arrow (not Tuple) would see no difference from the present state of affairs. Where things would be different would be if a module imported both Tuple and Arrow, when, instead of a name clash, *** and &&& would get their Arrow meanings (albeit with a specialised instance for ->). So if someone wrote a module that used only Tuple but later needed to import Arrow, nothing untoward would happen -- no renaming or complicated import hidings would be needed. I suppose one could describe this as shadowing of names with the restriction that the shadowed name has to fit the shadow exactly. [I have no attachment to the syntax suggested above] -- Jón Fairbairn Jon.Fairbairn@cl.cam.ac.uk

On Mon, 17 Sep 2007, Jon Fairbairn wrote:
instance Arrow (->) where ... (***) = (Data.Tuple.***) (&&&) = (Data.Tuple.&&&)
and modules that imported only Arrow (not Tuple) would see no difference from the present state of affairs. Where things would be different would be if a module imported both Tuple and Arrow, when, instead of a name clash, *** and &&& would get their Arrow meanings (albeit with a specialised instance for ->).
If you import Tuple and Arrow, why not just import Arrow?

Henning Thielemann
On Mon, 17 Sep 2007, Jon Fairbairn wrote:
instance Arrow (->) where ... (***) = (Data.Tuple.***) (&&&) = (Data.Tuple.&&&)
and modules that imported only Arrow (not Tuple) would see no difference from the present state of affairs. Where things would be different would be if a module imported both Tuple and Arrow, when, instead of a name clash, *** and &&& would get their Arrow meanings (albeit with a specialised instance for ->).
If you import Tuple and Arrow, why not just import Arrow?
Presumably because there are functions in Tuple that aren't in Arrow (if that isn't the case, this just means that Tuple/Arrow isn't a very good example). Another example would be mplus. I happen to think that ++ is a good name for mplus, but unfortunately it's used up for append on lists -- which, curiously enough is mplus for lists. Examples of functions that are used at a specialised case and as class members abound, and I'd like to see a way round using lots of different names for the same concept. While one /can/ use different names, or manage the problem by using related names, to my mind use of a convention to tame the Babel of names indicates a deficiency in the language. -- Jón Fairbairn Jon.Fairbairn@cl.cam.ac.uk

On Thu, 20 Sep 2007, Jon Fairbairn wrote:
Henning Thielemann
writes: On Mon, 17 Sep 2007, Jon Fairbairn wrote:
instance Arrow (->) where ... (***) = (Data.Tuple.***) (&&&) = (Data.Tuple.&&&)
and modules that imported only Arrow (not Tuple) would see no difference from the present state of affairs. Where things would be different would be if a module imported both Tuple and Arrow, when, instead of a name clash, *** and &&& would get their Arrow meanings (albeit with a specialised instance for ->).
If you import Tuple and Arrow, why not just import Arrow?
Presumably because there are functions in Tuple that aren't in Arrow (if that isn't the case, this just means that Tuple/Arrow isn't a very good example).
I would certainly import Arrow unqualified, and Tuple qualified. Or I would import the infix operators of Tuple, that do not interfer with Arrow, explicitly but unqualified. I think many problems arise from a dislike against both qualified and explicit imports. In the Modula languages only the latter two options exists and it works. Actually, one of my points is that specialised functions even shall have special names in order to signal to the reader which concrete data type is processed. I think most people agree, that infix operators shall be used unqualified. Since unqualified usage means automatic resolution of the particular implementation, they are predestinated for class methods. That is, (+) is polymorphic and this is fine, and (++) should also be polymorphic, maybe replacing 'mplus'. The specialised functions should have alphanumeric identifiers, say List.append, Int.add. Whenever I read in a program List.map (Int.add 1) (List.append a b) I'm confident, that a and b are lists, not just any possible monads, and that the lists contain Ints.

On Thu, Sep 20, 2007 at 03:23:05PM +0100, Jon Fairbairn wrote:
Henning Thielemann
writes: On Mon, 17 Sep 2007, Jon Fairbairn wrote:
instance Arrow (->) where ... (***) = (Data.Tuple.***) (&&&) = (Data.Tuple.&&&)
and modules that imported only Arrow (not Tuple) would see no difference from the present state of affairs. Where things would be different would be if a module imported both Tuple and Arrow, when, instead of a name clash, *** and &&& would get their Arrow meanings (albeit with a specialised instance for ->).
If you import Tuple and Arrow, why not just import Arrow?
Presumably because there are functions in Tuple that aren't in Arrow (if that isn't the case, this just means that Tuple/Arrow isn't a very good example).
Another example would be mplus. I happen to think that ++ is a good name for mplus, but unfortunately it's used up for append on lists -- which, curiously enough is mplus for lists. Examples of functions that are used at a specialised case and as class members abound, and I'd like to see a way round using lots of different names for the same concept. While one /can/ use different names, or manage the problem by using related names, to my mind use of a convention to tame the Babel of names indicates a deficiency in the language.
The reason ++ and mplus is so similar is that they used to be the same; (++) *was* the MonadPlus class member. Cale Gibbard explains this as {{{Quite a few people on the Haskell 98 committee had an irrational fear of polymorphism.}}} Stefan

G'day all.
Quoting Stefan O'Rear
The reason ++ and mplus is so similar is that they used to be the same; (++) *was* the MonadPlus class member. Cale Gibbard explains this as {{{Quite a few people on the Haskell 98 committee had an irrational fear of polymorphism.}}}
That's a slight exaggeration. They actually had nightmares involving trying to explain to their undergraduate students what the inevitable type error messages meant. At a time when Haskell was mostly a teaching/research language, this made a certain amount of sense. Now that Haskell is officially Cool(tm), the argument is much weaker. Cheers, Andrew Bromage

Maybe I've missed the essence of this discussion, but I seem to see to
opposite sentiments running through. One is to create additional,
*specialized* (for "->") names for existing general arrow operators, rather
than using the generalized versions, citing simpler error messages. The
other thread is regret over th Haskell 98 committee having done just this
kind of specialization (dumbing down) for monads vs lists.
My personal vote is for generality of the language & libraries, and address
the newbie issue with training-wheels prelude & libs or something like Jon's
"subsumes" proposal.
People may say that generality of functions like "first" & "second" is
unnecessary for their purposes. Personally, I sometimes find that such
"unnecessary" generality leads me to discover that an idea I'm working on is
much more general (and therefore useful to others) than I'd originally
imagined.
I agree that the names "onFst" and "onSnd" are easier to interpret than
"first" and "second". So let's use those names for the general (Arrow)
versions, rather than the specializations.
Comments?
Cheers, - Conal
On 9/20/07, ajb@spamcop.net
G'day all.
Quoting Stefan O'Rear
: The reason ++ and mplus is so similar is that they used to be the same; (++) *was* the MonadPlus class member. Cale Gibbard explains this as {{{Quite a few people on the Haskell 98 committee had an irrational fear of polymorphism.}}}
That's a slight exaggeration. They actually had nightmares involving trying to explain to their undergraduate students what the inevitable type error messages meant.
At a time when Haskell was mostly a teaching/research language, this made a certain amount of sense. Now that Haskell is officially Cool(tm), the argument is much weaker.
Cheers, Andrew Bromage _______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

G'day all.
Quoting Conal Elliott
Maybe I've missed the essence of this discussion, but I seem to see to opposite sentiments running through. One is to create additional, *specialized* (for "->") names for existing general arrow operators, rather than using the generalized versions, citing simpler error messages. The other thread is regret over th Haskell 98 committee having done just this kind of specialization (dumbing down) for monads vs lists.
Just for the record, my problem is not that there are specialised versions of things for lists/functions rather than monads/arrows, but rather that some of the "good" names are taken by the specialised versions (e.g. map vs fmap). I should point out the following operations, which are in Data.Graph.Inductive.Query.Monad (so no wonder nobody knows about them): mapFst :: (a -> b) -> (a, c) -> (b, c) mapSnd :: (a -> b) -> (c, a) -> (c, b) (><) :: (a -> b) -> (c -> d) -> (a, c) -> (b, d) How about moving those into Data.Tuple, along with a work-alike for (***)? How about (>*<)? Cheers, Andrew Bromage

Conal Elliott wrote:
Maybe I've missed the essence of this discussion, but I seem to see to opposite sentiments running through. One is to create additional, *specialized* (for "->") names for existing general arrow operators, rather than using the generalized versions, citing simpler error messages. The other thread is regret over th Haskell 98 committee having done just this kind of specialization (dumbing down) for monads vs lists.
I agree that the names "onFst" and "onSnd" are easier to interpret than "first" and "second". So let's use those names for the general (Arrow) versions, rather than the specializations.
Changing the names of 'first' and 'second' in Control.Arrow is a bad idea, I think. It'll break a lot of packages. Adding functions that conflict with Control.Arrow in Data.Tuple looks far less problematic, because Data.Tuple is quite rarely used. The Prelude reexport of Data.Tuple for nhc should be pruned, however. Data points: Number of occurences of "Data.Tuple" in various packages: (note: not all of these are package imports.) 9 ghc/libraries/base/ 7 ghc/ 5 ghc/testsuite/ 4 lambdabot/ 1 ghc/libraries/template-haskell/ Same for "Control.Arrow": (note: includes non-imports and imports like Control.Arrow.ListArrow, so it's overcounting quite a bit) 174 hxt/ 128 ghc/libraries/arrows/ 21 ghc/testsuite/ 16 lambdabot/ 6 ghc/ 5 ghc/libraries/base/ 2 ghc/libraries/containers/ 1 xmonad/ The sample consists of ghc + testsuite + libraries + extra libraries, HAppS, X11-extras, binary, derive, gtk2hs, haddock, hssdl, http, hxt, jhc, lambdabot, tagsoup, uniplate, xmonad and zlib. Bertram

It wouldn't have to be a change. We could add these new synonyms. I'm
personally happy with first & second for use with functions & other Arrow
types. My main suggestion is that if we want new names for memorability,
then let's add them for the general meanings rather than the specialized
ones.
On 10/15/07, Bertram Felgenhauer
Changing the names of 'first' and 'second' in Control.Arrow is a bad idea, I think. It'll break a lot of packages.
[...]

Stefan O'Rear
On Thu, Sep 20, 2007 at 03:23:05PM +0100, Jon Fairbairn wrote:
Another example would be mplus. I happen to think that ++ is a good name for mplus, [...]
The reason ++ and mplus is so similar is that they used to be the same; (++) *was* the MonadPlus class member.
I haven't forgotten this (having been there for the old version)! I'm somewhat surprised that I can find no record of my objecting to the change for H98, but I wasn't on that committee and was pretty ill at the time...
Cale Gibbard explains this as {{{Quite a few people on the Haskell 98 committee had an irrational fear of polymorphism.}}}
It wasn't irrational (and not all of the committe agreed, see http://www.cs.chalmers.se/~rjmh/Haskell/Messages/Decision.cgi?id=273); the motivation was didactic. But the point of my proposal here is that we can have it both ways: beginners importing just List and using ++ get error messages about Lists, but advanced programmers importing List and MonadPlus can use ++ without accidentally constraining their code to the wrong Monad. -- Jón Fairbairn Jon.Fairbairn@cl.cam.ac.uk

On Mon, Sep 17, 2007 at 07:47:33PM +0100, Jon Fairbairn wrote:
Ian Lynagh
writes: On Mon, Sep 17, 2007 at 03:23:46PM +0200, Josef Svenningsson wrote:
It is becoming increasingly popular to import Control.Arrow just to get access to the functions &&& and *** specialized to the function arrow. I propose to add the specialized version of these two functions
I think that having the same function with different types is likely to cause user confusion, and also ambiguous function errors.
(I also think that using a different name for the specialised versions would be a bad idea.)
This seems to be a recurrent problem, and I keep wondering whether there might not be a general solution along the lines of declaring that an instance of a class at a particular type subsumes the functions declared with those names at the specialised type.
An interesting idea; I'm not sure, but I think it might help us have code in the logical place in the base library without import loops. The only ugliness I see is that if I have module I where x :: Int x = 5 module B where x :: Bool x = True module C where import I import B class C a where x :: a instance C Int where x subsumes I.x instance C Bool where x subsumes B.x then importing I and B but not C could lead to confusion and ambiguity. Thanks Ian

Ian Lynagh
On Mon, Sep 17, 2007 at 07:47:33PM +0100, Jon Fairbairn wrote:
This seems to be a recurrent problem, and I keep wondering whether there might not be a general solution along the lines of declaring that an instance of a class at a particular type subsumes the functions declared with those names at the specialised type.
An interesting idea; I'm not sure, but I think it might help us have code in the logical place in the base library without import loops.
The only ugliness I see is that if I have
module I where x :: Int x = 5
module B where x :: Bool x = True
module C where import I import B
class C a where x :: a
instance C Int where x subsumes I.x
instance C Bool where x subsumes B.x
then importing I and B but not C could lead to confusion and ambiguity.
I don't see how, or at least, I don't see how my suggestion would make the situation worse -- if you import I and B, you'd get the same problem as you currently do in the absence of this subsumption mechanism. Indeed, importing C with its subsuming instances is a solution to this particular problem. A slightly knottier case is if module D where x :: Int x = 4 and someone attempts to import A, D and C -- but I think it would be straightforeardly rejected, requiring x to be hidden (or imported qualified) from D. -- Jón Fairbairn Jon.Fairbairn@cl.cam.ac.uk

On Mon, 17 Sep 2007, Josef Svenningsson wrote:
It is becoming increasingly popular to import Control.Arrow just to get access to the functions &&& and *** specialized to the function arrow. I propose to add the specialized version of these two functions to Data.Tuple which is more logical thing to import if you wish to have functions operating on tuples.
Maybe that's the reason, why I haven't imported them so far. I like the proposal because it supports the style http://www.haskell.org/haskellwiki/Simple_to_complex
participants (18)
-
ajb@spamcop.net
-
Benjamin Franksen
-
Bertram Felgenhauer
-
Conal Elliott
-
Don Stewart
-
Henning Thielemann
-
Henrik Nilsson
-
Ian Lynagh
-
Isaac Dupree
-
Jean-Philippe Bernardy
-
Johan Tibell
-
Jon Fairbairn
-
Josef Svenningsson
-
Neil Mitchell
-
Ross Paterson
-
Stefan O'Rear
-
Twan van Laarhoven
-
Yitzchak Gale