I find generalizing even more with "at" or "alterF" a very interesting suggestion and I'm fine with either title. I however was not able to trace any practical use of it, because in my imagination the original proposal covered all scenarios, so it'd be helpful to see some examples. Also since the performance turned out to be such an intricate issue in this case I think it is worth benchmarking both the functorial and the simple version. But either way I like the idea.

I also want to highlight the expressed idea that either version of this function should make it into the library no matter whether we're able to come up with an efficient implementation, since those functions also provide another important benefit by abstracting over a common pattern, thus simplifying the client code.

Schachaf, concerning your implementation. Great! It looks like a beginning of an implementation process. What do you think about posting it with the benchmark as a branch of your fork of "containers" project on GitHub? This way other participants will be able to fork from you and continue on with experiments, so it'll be easier for us to manage code and to keep in sync. 


2013/5/1 Shachaf Ben-Kiki <shachaf@gmail.com>
On Tue, Apr 30, 2013 at 8:20 AM, Milan Straka <fox@ucw.cz> wrote:
> Hi all,
>
>> -----Original message-----
>> From: Nikita Volkov <nikita.y.volkov@gmail.com>
>> Sent: 30 Apr 2013, 17:18
>>
>> Because of the above I have very often found myself in requirement for the following function:
>>
>>    withItem ::
>>      (Ord k) =>
>>      k ->
>>      (Maybe i -> (r, Maybe i)) ->
>>      Map k i -> (r, Map k i)
>>    withItem k f m =
>>      let
>>        item = Map.lookup k m
>>        (r, item') = f item
>>        m' = Map.update (const item') k m
>>      in (r, m')
>
> last time we talked about adding
>   lens :: k -> Map k a -> (Maybe a -> Map k a, Maybe a)
> the performance of the direct implementation was actually worse than
> using lookup+insert or such, see the thread
> http://www.haskell.org/pipermail/libraries/2012-January/017423.html
> and the benchmark results at
> http://www.haskell.org/pipermail/libraries/2012-January/017435.html
>

If this is a good API, and the direct implementation is slower than an
indirect implementation in terms of lookup+insert+delete, then the
indirect implementation should be exported. Keep in mind that this
operation is just `alterM` (except generalized to Functor --
`alterF`?).

However: I just wrote a quick direct version:

    alterF :: (Ord k, Functor f) => k -> (Maybe a -> f (Maybe a)) ->
Map k a -> f (Map k a)
    STRICT_1_OF_2(alterF)
    alterF k f = go
      where
        go Tip = maybe Tip (singleton k) <$> f Nothing
        go (Bin sx kx x l r) =
          case compare k kx of
            LT -> (\l' -> balance kx x l' r) <$> go l
            GT -> (\r' -> balance kx x l r') <$> go r
            EQ -> maybe (glue l r) (\x' -> Bin sx kx x' l r) <$> f (Just x)

And benchmarked lookup-via-alterF, insert-via-alterF, etc. -- they
come out much slower. However, if I add an INLINE pragma or SPECIALIZE
pragmas for common/relevant functors (e.g. Const r, Identity, (r,)),
then they come out almost the same speed as the primitive function.

I don't think INLINE is necessarily bad for this function. (I don't
like the idea of using SPECIALIZE here because I don't think e.g.
Identity should have special privileges over some other newtype with
the same Functor instance.) So maybe the direct implementation should
be reconsidered. I can do a more thorough benchmark later if people
are interested.

>
> I am also a bit worried whether withItem is the "right" general
> function. For example Shachaf Ben-Kiki mentions the
>   at :: (Ord k, Functor f) => k -> (Maybe i -> f (Maybe i)) -> Map k i -> f (Map k i)
> from the lens package in other mail, but maybe there are others.
>

I think that alterF almost certainly *a* right function -- it's just a
monadic/functorial version of `alter`, which is the most general
"simple" updating function. Possibly there should be others too, but
this one is useful and general. Although it needs a better name. :-)

(Note that e.g.
    adjustF :: (Ord k, Applicative f) => k -> (a -> f a) -> M.Map k a
-> f (M.Map k a)
can just be
    \k -> alterF k . traverse
just as with alter/adjust.
)

>
>>    1. Implement an efficient version of "withItem" for lazy and strict versions of "Map" and "IntMap".
>
> Maybe we will need a benchmark to see whether withItem is really faster
> than combination of lookup+update.
>
>>    3. Begin the deprecation process of the following functions: insertWith, insertWithKey, insertLookupWithKey, adjust, adjustWithKey, update, updateWithKey, updateLookupWithKey, alter.
>
> I am against deprecating insertWith, insertWithKey, updateWithKey,
> updateWithKey, because they are useful.
>
> I am against deprecating adjust, adjustWithKey and alter, mostly because
> of compatibility reasons, although I agree that their name is not
> descriptive.
>
> I am indifferent about insertLookupWithKey and updateLookupWithKey. It
> would be nice to show that their implementation is really faster than
> lookup+insert / lookup+update combo.
>

    Shachaf