How to implement Data.Map.insertList*?

[Ross Paterson]

On Wed, Feb 23, 2005 at 12:16:13PM +0100, Mirko Rahn wrote:
> 
> The old FiniteMap module contains the addListToFM* functions that are 
> missing in Data.Map. But how to implement it?

Here's a cheatsheet I use for converting to Data.Map:

-- Definitions of FiniteMap operations in terms of Map, for porting purposes.

module FiniteMap (
	FiniteMap,
	emptyFM, unitFM, listToFM,
	lookupFM, lookupWithDefaultFM, elemFM,
	addToFM, addToFM_C, addListToFM, addListToFM_C,
	delFromFM, delListFromFM,
	plusFM, plusFM_C,
	fmToList, keysFM, eltsFM, sizeFM, isEmptyFM,
	minusFM, foldFM, intersectFM, intersectFM_C, mapFM, filterFM,
	foldFM_GE, fmToList_GE, keysFM_GE, eltsFM_GE,
	foldFM_LE, fmToList_LE, keysFM_LE, eltsFM_LE,
	minFM, maxFM
    ) where

import Data.Map as Map
import Data.List (foldl')

type FiniteMap = Map

emptyFM :: FiniteMap k a
emptyFM = empty

unitFM :: k -> a -> FiniteMap k a
unitFM = singleton

listToFM :: (Ord k) => [(k,a)] -> FiniteMap k a
listToFM = fromList

addToFM :: (Ord k) => FiniteMap k a -> k -> a  -> FiniteMap k a
addToFM m k v = insert k v m

addListToFM :: (Ord k) => FiniteMap k a -> [(k,a)] -> FiniteMap k a
addListToFM m kvs = foldl' add m kvs
  where add m' (k,v) = insert k v m'

addToFM_C :: (Ord k) =>
	(a -> a -> a) -> FiniteMap k a -> k -> a -> FiniteMap k a
addToFM_C c m k v = insertWith (flip c) k v m

addListToFM_C :: (Ord k) =>
	(a -> a -> a) -> FiniteMap k a -> [(k,a)] -> FiniteMap k a
addListToFM_C c m kvs = foldl' add m kvs
  where add m' (k,v) = insertWith (flip c) k v m'

delFromFM :: (Ord k) => FiniteMap k a -> k -> FiniteMap k a
delFromFM m k = delete k m

delListFromFM :: (Ord k) => FiniteMap k a -> [k] -> FiniteMap k a
delListFromFM m keys = foldl' (flip delete) m keys

plusFM :: (Ord k) => FiniteMap k a -> FiniteMap k a -> FiniteMap k a
plusFM = flip union

plusFM_C :: (Ord k) =>
	(a -> a -> a) -> FiniteMap k a -> FiniteMap k a -> FiniteMap k a
plusFM_C = unionWith

minusFM :: (Ord k) => FiniteMap k a -> FiniteMap k b -> FiniteMap k a
minusFM = difference

intersectFM :: (Ord k) => FiniteMap k a -> FiniteMap k a -> FiniteMap k a
intersectFM = flip intersection

intersectFM_C :: (Ord k) =>
	(a -> b -> c) -> FiniteMap k a -> FiniteMap k b -> FiniteMap k c
intersectFM_C = intersectionWith

foldFM :: (k -> a -> b -> b) -> b -> FiniteMap k a -> b
foldFM = foldWithKey

mapFM :: (k -> elt1 -> elt2) -> FiniteMap k elt1 -> FiniteMap k elt2
mapFM = mapWithKey

filterFM :: (Ord k) => (k -> a -> Bool) -> FiniteMap k a -> FiniteMap k a
filterFM = filterWithKey

sizeFM :: FiniteMap k a -> Int
sizeFM = size

isEmptyFM :: FiniteMap k a -> Bool
isEmptyFM = Map.null

elemFM :: (Ord k) => k -> FiniteMap k a -> Bool
elemFM = member

lookupFM :: (Ord k) => FiniteMap k a -> k -> Maybe a
lookupFM m k = Map.lookup k m

lookupWithDefaultFM :: (Ord k) => FiniteMap k a -> a -> k -> a
lookupWithDefaultFM m v k = findWithDefault v k m

fmToList :: FiniteMap k a -> [(k,a)]
fmToList = toList

keysFM :: FiniteMap k a -> [k]
keysFM = keys

eltsFM :: FiniteMap k a -> [a]
eltsFM = elems

-- NB: if == is less discriminating than true equality, then these are
-- slightly different from the originals: they use the key supplied,
-- rather than the one in the tree that's equal to it.

foldFM_GE :: Ord k => (k -> a -> b -> b) -> b -> k -> FiniteMap k a -> b
foldFM_GE f z k m
  | Map.null m = z
  | otherwise  = case splitLookup k m of
	(_, Nothing, m_gt) -> foldWithKey f z m_gt
	(_, Just x, m_gt) -> f k x (foldWithKey f z m_gt)

fmToList_GE :: Ord k => FiniteMap k a -> k ->  [(k,a)]
fmToList_GE m k
  | Map.null m = []
  | otherwise  = case splitLookup k m of
	(_, Nothing, m_gt) -> toList m_gt
	(_, Just x, m_gt) -> (k,x) : toList m_gt

keysFM_GE :: Ord k => FiniteMap k a -> k -> [k]
keysFM_GE m k
  | Map.null m = []
  | otherwise  = case splitLookup k m of
	(_, Nothing, m_gt) -> keys m_gt
	(_, Just _, m_gt) -> k : keys m_gt

eltsFM_GE :: Ord k => FiniteMap k a -> k -> [a]
eltsFM_GE m k
  | Map.null m = []
  | otherwise  = case splitLookup k m of
	(_, Nothing, m_gt) -> elems m_gt
	(_, Just x, m_gt) -> x : elems m_gt

foldFM_LE :: Ord k => (k -> a -> b -> b) -> b -> k -> FiniteMap k a -> b
foldFM_LE f z k m
  | Map.null m = z
  | otherwise  = case splitLookup k m of
	(m_lt, Nothing, _) -> foldWithKey f z m_lt
	(m_lt, Just x, _) -> foldWithKey f (f k x z) m_lt

fmToList_LE :: Ord k => FiniteMap k a -> k ->  [(k,a)]
fmToList_LE m k
  | Map.null m = []
  | otherwise  = case splitLookup k m of
	(m_lt, Nothing, _) -> toList m_lt
	(m_lt, Just x, _) -> toList m_lt ++ [(k,x)]

keysFM_LE :: Ord k => FiniteMap k a -> k -> [k]
keysFM_LE m k
  | Map.null m = []
  | otherwise  = case splitLookup k m of
	(m_lt, Nothing, _) -> keys m_lt
	(m_lt, Just x, _) -> keys m_lt ++ [k]

eltsFM_LE :: Ord k => FiniteMap k a -> k -> [a]
eltsFM_LE m k
  | Map.null m = []
  | otherwise  = case splitLookup k m of
	(m_lt, Nothing, _) -> elems m_lt
	(m_lt, Just x, _) -> elems m_lt ++ [x]

minFM :: Ord k => FiniteMap k a -> Maybe k
minFM m
  | Map.null m = Nothing
  | otherwise  = Just (fst (findMin m))

maxFM :: Ord k => FiniteMap k a -> Maybe k
maxFM m
  | Map.null m = Nothing
  | otherwise  = Just (fst (findMax m))