Monadic version of functions for containers (adjustM, updateWithKeyM, etc)

All, Is there a reason not to have monadic version of the functions in containers? I've a need for functions of type: adjustM :: (Monad m, Ord k) => (a -> m a) -> k -> Map k a -> m (Map k a) updateWithKeyM :: (Monad m, Ord k) => (k -> a -> m (Maybe a)) -> k -> Map k a -> m (Map k a) where adjustM can be ~ half the cost of separate insert/lookup calls and would obey the following rule: adjustM f k m == liftM (\x -> insert k x m) (f $ lookup k m ) They aren't large, but must be in the containers package due to opacity of Map/Set/etc. Perhaps someone can provide a reason for their omission? If not then I'll probably start yet-another proposal in a week or two (once the current containers proposals and my System.Random proposals have concluded). Tentatively I expect to make a patch that includes proper *M functions for Map, Set, IntMap, and IntSet. Cheers, Thomas

On Mon, Sep 27, 2010 at 7:13 PM, Thomas DuBuisson
adjustM f k m == liftM (\x -> insert k x m) (f $ lookup k m )
This suggests that you don't need the Monad constraint, only Functor. -- Felipe.

On Mon, Sep 27, 2010 at 3:16 PM, Felipe Lessa
adjustM f k m == liftM (\x -> insert k x m) (f $ lookup k m )
This suggests that you don't need the Monad constraint, only Functor.
That's just because I hid the case where `lookup k m` fails. I'm sure looking at other desirable *M functions would reveal similar issues with using Functor alone. adjustM f k m == case lookup k m of Just x -> liftM (\new -> insert k new m) (f x) Nothing -> return m translating this to Functor: adjustF f k m == case lookup k m of Just x -> fmap (\new -> insert k new m) (f x) Nothing -> ??? -- perhaps "pure m" thus adding another constraint, but how would that be better than Monad for most people? Cheers, Thomas

On Mon, Sep 27, 2010 at 7:47 PM, Thomas DuBuisson
translating this to Functor:
adjustF f k m == case lookup k m of Just x -> fmap (\new -> insert k new m) (f x) Nothing -> ??? -- perhaps "pure m" thus adding another
Hmmm, true. With the currenty hierachy, we could have adjustA using Applicative constraint, although a pointed functor is enough.
constraint, but how would that be better than Monad for most people?
Having the most general type allows the function to be used in more places. For example, in an Applicative parser. All Monads are Applicative, so adjustA is at least as good as adjustM. Cheers, =) -- Felipe.

On Mon, Sep 27, 2010 at 6:13 PM, Thomas DuBuisson
All,
Is there a reason not to have monadic version of the functions in containers? I've a need for functions of type:
Ack! Haskell needs effect polymorphism. The API already has 150 functions. How many more do we need to add if we want to cover all the monadic versions?

Johan said:
Is there a reason not to have monadic version of the functions in containers? I've a need for functions of type:
Ack! Haskell needs effect polymorphism. The API already has 150 functions. How many more do we need to add if we want to cover all the monadic versions?
If the number of functions becomes a concern we can be effective and still conservative. Take Data.Map as an example, we can make updateLookupWithKeyM and omit alterM, alterWithKeyM, insertLookupWithKeyM, etc as those can be built using updateLookupWithKeyM - no power lost. This strategy might cut the number of functions down from ~2 dozen to a bare handful ( I expect a 'map' variant will be sensible, probably one or two others). Cheers, Thomas

On Tue, Sep 28, 2010 at 12:08 AM, Thomas DuBuisson
If the number of functions becomes a concern we can be effective and still conservative. Take Data.Map as an example, we can make updateLookupWithKeyM and omit alterM, alterWithKeyM, insertLookupWithKeyM, etc as those can be built using updateLookupWithKeyM - no power lost. This strategy might cut the number of functions down from ~2 dozen to a bare handful ( I expect a 'map' variant will be sensible, probably one or two others).
That sounds sensible. It would be great if someone could write a benchmark to check if the more general function has the same performance as the more specialized ones. It's really unfortunate that we have with and without key versions of everything. It forces you to have 8 (!) copies of higher order functions e.g. foldl foldlWithKey foldlM foldlWithKeyM foldl' foldlWithKey' foldlM' foldlWithKeyM' if you want to be consistent. -- Johan

On Tue, Sep 28, 2010 at 12:08 AM, Thomas DuBuisson
If the number of functions becomes a concern we can be effective and still conservative. Take Data.Map as an example, we can make updateLookupWithKeyM and omit alterM, [***]
alter is the most powerful function. It can perform an insertion, while updateLookupWithKey cannot. Cheers, JP.

On Tue, Sep 28, 2010 at 08:35:30AM -0400, Jean-Philippe Bernardy wrote:
On Tue, Sep 28, 2010 at 12:08 AM, Thomas DuBuisson
wrote: If the number of functions becomes a concern we can be effective and still conservative. Take Data.Map as an example, we can make updateLookupWithKeyM and omit alterM, [***]
alter is the most powerful function. It can perform an insertion, while updateLookupWithKey cannot.
I don't understand why the number of functions is such an issue. To me, ease of use is more important. For example, (assuming the performance is, or could be made, the same), would Data.List be improved by removing concat and map, as they can be written as (concatMap id) and (concatMap . (return .))? Thanks Ian

On Tue, Sep 28, 2010 at 10:57 AM, Ian Lynagh
I don't understand why the number of functions is such an issue. To me, ease of use is more important.
I agree. And I think the greatest problems with many are: - Maintainence burden: this can be alliviated by defining manually only the most general functions and reusing them in the library implementation. - Documentation: it may get harder to grok the documentation when the number of functions grows. Carefully using '-- ***' headers to put similar functions together may be a good compromise. -- Felipe.

On Tue, Sep 28, 2010 at 9:57 AM, Ian Lynagh
I don't understand why the number of functions is such an issue. To me, ease of use is more important.
But more functions hurts ease of use! An API gets harder to grasp the more functions it has and knowing which function to use gets harder when the number of functions increases. OO map data type get away with about 10-15 functions, we have 150! I've written about this topic before on haskell-cafe. That post contains a somewhat more thorough arguments for not adding too many functions to APIs. Let me know if you can't find it. (There is also an maintenance cost, but it's not as important as the cost to API users).
For example, (assuming the performance is, or could be made, the same), would Data.List be improved by removing concat and map, as they can be written as (concatMap id) and (concatMap . (return .))?
If we would remove any of these three functions it would be concatMap as it's a simple function composition of the concat and map! The only reason I can see for having concatMap is that it's >>= for lists. -- Johan

On Tue, Sep 28, 2010 at 02:23:58PM -0400, Johan Tibell wrote:
On Tue, Sep 28, 2010 at 9:57 AM, Ian Lynagh
wrote: I don't understand why the number of functions is such an issue. To me, ease of use is more important.
But more functions hurts ease of use!
But we're not really talking about adding another 150 functions; we're talking about adding 1 additional concept (monadic functions). If you know about the {map, filter, ...} concept and the *M concept then you already understand {mapM, filterM, ...}. Likewise *WithKey. As someone else said, it would be nice if the documentation grouped the functions by their "root" (e.g. all the filter* functions together.
An API gets harder to grasp the more functions it has and knowing which function to use gets harder when the number of functions increases.
I think the code is easier to read and maintain if it isn't full of const's, \_'s, etc. I'm not convinced it's harder for an expert to write with, and I think a beginner will generally prefer having the functionality they need directly available, rather than having to compose functions together.
OO map data type get away with about 10-15 functions, we have 150!
I'd need to see a comparison to comment.
I've written about this topic before on haskell-cafe. That post contains a somewhat more thorough arguments for not adding too many functions to APIs. Let me know if you can't find it.
A link would be useful. Thanks Ian

On 09/28/10 15:14, Ian Lynagh wrote:
I'm not convinced it's harder for an expert to write with, and I think a beginner will generally prefer having the functionality they need directly available, rather than having to compose functions together.
As a beginner, I liked the practice of having to compose functions together. It helped me grasp the ways in which that *can* be done. (This doesn't seem to me like a convincing argument to avoid the more functions. Just thought it was a doubt worth hearing.)

On 9/27/10 11:32 PM, Johan Tibell wrote:
On Mon, Sep 27, 2010 at 6:13 PM, Thomas DuBuisson
wrote: All,
Is there a reason not to have monadic version of the functions in containers? I've a need for functions of type:
Ack! Haskell needs effect polymorphism. The API already has 150 functions. How many more do we need to add if we want to cover all the monadic versions?
At the risk (read: guarantee) of compatibility breakage, might I suggest that the containers library move to a design like bytestring-trie[1] where there are about three modules for each structure: one for the minimal core functionality, one for reasonable coverage of basic/common use, and one for the other 125 convenience functions. The core vs basic distinction isn't strictly necessary, though it can put a helpful varnish over some unpolished primitives (e.g., showTrie, lookupBy_). Honestly, once you have the swiss army chainsaw primitives and the normal functions for mere mortals, all the rest are just SACPs plus some basic combinators for simplifying types. Few of the intermediate simplifications of SACPs are so useful that they oughtn't be pushed off to another module anyways. [1] http://hackage.haskell.org/package/bytestring-trie (Yes, I still need to add the monadic interface. I ran into that problem recently...) -- Live well, ~wren

Johan Tibell wrote:
Thomas DuBuisson wrote:
Is there a reason not to have monadic version of the functions in containers? I've a need for functions of type:
Ack! Haskell needs effect polymorphism. The API already has 150 functions. How many more do we need to add if we want to cover all the monadic versions?
I think this problem should be solved by making the API more general/flexible, not by adding more specialized versions. For instance, the function focus :: k -> Map k a -> (Maybe a, Maybe a -> Map k a) that returns the element together with its context ("map with a hole where the element was") can express all the insert, update etc. functions as well as their monadic versions. You can also use it for lookup , though that has a performance cost since the context is generated and then discarded. Of course, there ought to be a optimization pass that can catch these situations with a few hints and eliminate the superfluous work. Regards, Heinrich Apfelmus -- http://apfelmus.nfshost.com
participants (8)
-
Felipe Lessa
-
Heinrich Apfelmus
-
Ian Lynagh
-
Isaac Dupree
-
Jean-Philippe Bernardy
-
Johan Tibell
-
Thomas DuBuisson
-
wren ng thornton