# Bringing the IntMap API up to par with the Map API

Stephan Friedrichs deduktionstheorem at web.de
Fri Aug 20 08:57:32 EDT 2010

On 06/08/10 19:08, Johan Tibell wrote:
> [...]
>
> Definitely worth researching. I think we should pursue this as a
> separate track and fix what we have in the mean time.

I had a little time for playing with the idea and came up with this:

===============================================================

import qualified Data.Map as DMap
import qualified Data.IntMap as IMap
import Prelude hiding ( lookup )

-- class with very general functions
class MapC m k v where
data MapImpl m k v :: *

null :: MapImpl m k v -> Bool
null = (== 0) . size -- default implementation for finite maps
size :: MapImpl m k v -> Int

empty :: MapImpl m k v
insertLookupWithKey :: (k -> v -> v -> v) -> k -> v -> MapImpl m k v
-> (Maybe v, MapImpl m k v)
alter :: (Maybe v -> Maybe v) -> k -> MapImpl m k v -> MapImpl m k v

toList :: MapImpl m k v -> [(k, v)]

-- instance declarations covering Data.Map and Data.IntMap

instance MapC (IMap.IntMap v) Int v where
newtype MapImpl (IMap.IntMap v) Int v = IMapImpl (IMap.IntMap v)

size (IMapImpl mp) = IMap.size mp

empty = IMapImpl IMap.empty
insertLookupWithKey f k v (IMapImpl mp) =
let (found, mp') = IMap.insertLookupWithKey f k v mp
in (found, IMapImpl mp')
alter f k (IMapImpl mp) = IMapImpl (IMap.alter f k mp)

toList (IMapImpl mp) = IMap.toList mp

instance (Ord k) => MapC (DMap.Map k v) k v where
newtype MapImpl (DMap.Map k v) k v = DMapImpl (DMap.Map k v)

size (DMapImpl mp) = DMap.size mp

empty = DMapImpl DMap.empty
insertLookupWithKey f k v (DMapImpl mp) =
let (found, mp') = DMap.insertLookupWithKey f k v mp
in (found, DMapImpl mp')
alter f k (DMapImpl mp) = DMapImpl (DMap.alter f k mp)

toList (DMapImpl mp) = DMap.toList mp

instance (MapC m k v, Show k, Show v) => Show (MapImpl m k v) where
show = show . toList

-- functions implemented on top of the type family

singleton :: (MapC m k v) => k -> v -> MapImpl m k v
singleton k v = insert k v empty

insert :: (MapC m k v) => k -> v -> MapImpl m k v -> MapImpl m k v
insert = insertWith const

insertWith :: (MapC m k v) => (v -> v -> v) -> k -> v -> MapImpl m k v
-> MapImpl m k v
insertWith f = insertWithKey (const f)

insertWithKey :: (MapC m k v) => (k -> v -> v -> v) -> k -> v -> MapImpl
m k v -> MapImpl m k v
insertWithKey f k v mp = snd \$ insertLookupWithKey f k v mp

lookup :: (MapC m k v) => k -> MapImpl m k v -> Maybe v
lookup k = fst . insertLookupWithKey undefined k undefined

findWithDefault :: (MapC m k v) => v -> k -> MapImpl m k v -> v
findWithDefault v k = maybe v id . lookup k

delete :: (MapC m k v) => k -> MapImpl m k v -> MapImpl m k v
delete = update (const Nothing)

adjust :: (MapC m k v) => (v -> v) -> k -> MapImpl m k v -> MapImpl m k v
adjust f = alter (fmap f)

update :: (MapC m k v) => (v -> Maybe v) -> k -> MapImpl m k v ->
MapImpl m k v
update f k mp = alter (maybe Nothing f) k mp

===============================================================

Sorry for the long mail, but it isn't worth opening a repository yet.