Bringing the IntMap API up to par with the Map API

[Stephan Friedrichs]

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.
Comments? :)

//Stephan