module Data.HashMap ( Map
, HashMap
, (!), (\\)
, null
, size
, member
, notMember
, lookup
, findWithDefault
, empty
, singleton
, insert
, insertWith, insertWithKey, insertLookupWithKey
, delete
, adjust
, adjustWithKey
, update
, updateWithKey
, updateLookupWithKey
, alter
, union
, unionWith
, unionWithKey
, unions
, unionsWith
, difference
, differenceWith
, differenceWithKey
, intersection
, intersectionWith
, intersectionWithKey
, map
, mapWithKey
, mapAccum
, mapAccumWithKey
, fold
, foldWithKey
, elems
, keys
, keysSet
, assocs
, toList
, fromList
, fromListWith
, fromListWithKey
, filter
, filterWithKey
, partition
, partitionWithKey
, mapMaybe
, mapMaybeWithKey
, mapEither
, mapEitherWithKey
, isSubmapOf, isSubmapOfBy
, isProperSubmapOf, isProperSubmapOfBy
) where
import Prelude hiding (lookup,map,filter,null)
import Control.Applicative (Applicative(pure,(<*>)))
import Control.DeepSeq
import Data.Hashable
import Data.Foldable (Foldable(foldMap))
import Data.List (foldl')
import Data.Monoid (Monoid(..))
import Data.Traversable (Traversable(traverse))
import Data.Typeable
#if __GLASGOW_HASKELL__
import Text.Read
import Data.Data (Data(..), mkNoRepType)
#endif
import qualified Data.IntMap as I
import qualified Data.Map as M
import qualified Data.Set as S
(!) :: (Hashable k, Ord k) => Map k a -> k -> a
m ! k = case lookup k m of
Nothing -> error "HashMap.(!): key not an element of the map"
Just v -> v
(\\) :: Ord k => Map k a -> Map k b -> Map k a
m1 \\ m2 = difference m1 m2
data Some k v = Only !k v | More !(M.Map k v) deriving (Eq, Ord)
instance (NFData k, NFData v) => NFData (Some k v) where
rnf (Only k v) = rnf k `seq` rnf v
rnf (More m) = rnf m
newtype Map k v = Map (I.IntMap (Some k v)) deriving (Eq, Ord)
type HashMap k v = Map k v
instance (NFData k, NFData v) => NFData (Map k v) where
rnf (Map m) = rnf m
instance Functor (Map k) where
fmap = map
instance Ord k => Monoid (Map k a) where
mempty = empty
mappend = union
mconcat = unions
instance Foldable (Map k) where
foldMap f (Map m) = foldMap some_fold m
where some_fold (Only _ x) = f x
some_fold (More s) = foldMap f s
instance Traversable (Map k) where
traverse f (Map m) = pure Map <*> traverse some_traverse m
where some_traverse (Only k x) = pure (Only k) <*> f x
some_traverse (More s) = pure More <*> traverse f s
instance (Show k, Show a) => Show (Map k a) where
showsPrec d m = showParen (d > 10) $
showString "fromList " . shows (toList m)
instance (Read k, Hashable k, Ord k, Read a) => Read (Map k a) where
#ifdef __GLASGOW_HASKELL__
readPrec = parens $ prec 10 $ do
Ident "fromList" <- lexP
xs <- readPrec
return (fromList xs)
readListPrec = readListPrecDefault
#else
readsPrec p = readParen (p > 10) $ \ r -> do
("fromList",s) <- lex r
(xs,t) <- reads s
return (fromList xs,t)
#endif
#include "Typeable.h"
INSTANCE_TYPEABLE2(Map,mapTc,"Map")
#if __GLASGOW_HASKELL__
instance (Data k, Hashable k, Ord k, Data a) => Data (Map k a) where
gfoldl f z m = z fromList `f` (toList m)
toConstr _ = error "toConstr"
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "Data.HashMap.Map"
dataCast1 f = gcast1 f
#endif
eq :: Ord a => a -> a -> Bool
eq x y = x `compare` y == EQ
null :: Map k a -> Bool
null (Map m) = I.null m
size :: Map k a -> Int
size (Map m) = I.fold ((+) . some_size) 0 m
where some_size (Only _ _) = 1
some_size (More s) = M.size s
member :: (Hashable k, Ord k) => k -> Map k a -> Bool
member k m = case lookup k m of
Nothing -> False
Just _ -> True
notMember :: (Hashable k, Ord k) => k -> Map k a -> Bool
notMember k m = not $ member k m
some_lookup :: Ord k => k -> Some k a -> Maybe a
some_lookup k (Only k' x) | k `eq` k' = Just x
| otherwise = Nothing
some_lookup k (More s) = M.lookup k s
lookup :: (Hashable k, Ord k) => k -> Map k a -> Maybe a
lookup k (Map m) = I.lookup (hash k) m >>= some_lookup k
findWithDefault :: (Hashable k, Ord k) => a -> k -> Map k a -> a
findWithDefault def k m = case lookup k m of
Nothing -> def
Just x -> x
empty :: Map k a
empty = Map I.empty
singleton :: Hashable k => k -> a -> Map k a
singleton k x = Map $
I.singleton (hash k) $ (Only k x)
insert :: (Hashable k, Ord k)
=> k -> a -> Map k a -> Map k a
insert k x (Map m) = Map $
I.insertWith some_insert (hash k) (Only k x) m
where some_insert _ (Only k' x') | k `eq` k' = Only k x
| otherwise = More $ M.insert k x (M.singleton k' x')
some_insert _ (More s) = More $ M.insert k x s
insertWith :: (Hashable k, Ord k)
=> (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith f k x (Map m) = Map $
I.insertWith some_insert_with (hash k) (Only k x) m
where some_insert_with _ (Only k' x') | k `eq` k' = Only k (f x x')
| otherwise = More $ M.insert k x (M.singleton k' x')
some_insert_with _ (More s) = More $ M.insertWith f k x s
insertWithKey :: (Hashable k, Ord k)
=> (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKey f k x (Map m) = Map $
I.insertWith some_insert_with_key (hash k) (Only k x) m
where some_insert_with_key _ (Only k' x') | k `eq` k' = Only k (f k x x')
| otherwise = More $ M.insert k x (M.singleton k' x')
some_insert_with_key _ (More s) = More $ M.insertWithKey f k x s
insertLookupWithKey :: (Hashable k, Ord k)
=> (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
insertLookupWithKey f k x (Map m) =
case I.insertLookupWithKey some_insert_with_key (hash k) (Only k x) m of
(found, m') -> (found >>= some_lookup k, Map m')
where some_insert_with_key _ _ (Only k' x') | k `eq` k' = Only k (f k x x')
| otherwise = More $ M.insert k x (M.singleton k' x')
some_insert_with_key _ _ (More s) = More $ M.insertWithKey f k x s
some_norm :: M.Map k v -> Maybe (Some k v)
some_norm s = case M.size s of 0 -> Nothing
1 -> case M.findMin s of (k, x) -> Just $ Only k x
_ -> Just $ More $ s
some_norm' :: M.Map k v -> Some k v
some_norm' s = case M.size s of 1 -> case M.findMin s of (k, x) -> Only k x
_ -> More $ s
delete :: (Hashable k, Ord k)
=> k -> Map k a -> Map k a
delete k (Map m) = Map $
I.update some_delete (hash k) m
where some_delete v@(Only k' _) | k `eq` k' = Nothing
| otherwise = Just v
some_delete (More t) = some_norm $ M.delete k t
adjust :: (Hashable k, Ord k)
=> (a -> a) -> k -> Map k a -> Map k a
adjust f k (Map m) = Map $
I.adjust some_adjust (hash k) m
where some_adjust v@(Only k' x) | k `eq` k' = Only k (f x)
| otherwise = v
some_adjust (More t) = More $ M.adjust f k t
adjustWithKey :: (Hashable k, Ord k)
=> (k -> a -> a) -> k -> Map k a -> Map k a
adjustWithKey f k (Map m) = Map $
I.adjust some_adjust_with_key (hash k) m
where some_adjust_with_key v@(Only k' x) | k `eq` k' = Only k (f k x)
| otherwise = v
some_adjust_with_key (More t) = More $ M.adjustWithKey f k t
update :: (Hashable k, Ord k)
=> (a -> Maybe a) -> k -> Map k a -> Map k a
update f k (Map m) = Map $
I.update some_update (hash k) m
where some_update v@(Only k' x) | k `eq` k' = f x >>= return . Only k'
| otherwise = Just v
some_update (More t) = some_norm $ M.update f k t
updateWithKey :: (Hashable k, Ord k)
=> (k -> a -> Maybe a) -> k -> Map k a -> Map k a
updateWithKey f k (Map m) = Map $
I.update some_update_with_key (hash k) m
where some_update_with_key v@(Only k' x) | k `eq` k' = f k x >>= return . Only k'
| otherwise = Just v
some_update_with_key (More t) = some_norm $ M.updateWithKey f k t
updateLookupWithKey :: (Hashable k, Ord k)
=> (k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
updateLookupWithKey f k (Map m) =
case I.updateLookupWithKey some_update_with_key (hash k) m of
(found, m') -> (found >>= some_lookup k, Map m')
where some_update_with_key _ v@(Only k' x) | k `eq` k' = f k x >>= return . Only k'
| otherwise = Just v
some_update_with_key _ (More t) = some_norm $ M.updateWithKey f k t
alter :: (Hashable k, Ord k)
=> (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
alter f k (Map m) = Map $
I.alter some_alter (hash k) m
where some_alter Nothing = f Nothing >>= return . Only k
some_alter (Just v@(Only k' x)) | k `eq` k' = f (Just x) >>= return . Only k'
| otherwise = Just v
some_alter (Just (More t)) = some_norm $ M.alter f k t
unions :: Ord k => [Map k a] -> Map k a
unions xs = foldl' union empty xs
unionsWith :: Ord k => (a->a->a) -> [Map k a] -> Map k a
unionsWith f xs = foldl' (unionWith f) empty xs
union :: Ord k => Map k a -> Map k a -> Map k a
union (Map m1) (Map m2) = Map $
I.unionWith some_union m1 m2
where some_union v@(Only k x) (Only l y) | k `eq` l = v
| otherwise = More (M.singleton k x `M.union` M.singleton l y)
some_union (Only k x) (More t) = More $ M.singleton k x `M.union` t
some_union (More t) (Only k x) = More $ t `M.union` M.singleton k x
some_union (More t) (More u) = More $ t `M.union` u
some_union_with_key :: Ord k => (k -> a -> a -> a) -> Some k a -> Some k a -> Some k a
some_union_with_key f (Only k x) (Only l y) | k `eq` l = Only k (f k x y)
| otherwise = More (M.unionWithKey f (M.singleton k x) (M.singleton l y))
some_union_with_key f (Only k x) (More t) = More $ M.unionWithKey f (M.singleton k x) t
some_union_with_key f (More t) (Only k x) = More $ M.unionWithKey f t (M.singleton k x)
some_union_with_key f (More t) (More u) = More $ M.unionWithKey f t u
unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith f (Map m1) (Map m2) = Map $
I.unionWith (some_union_with_key $ const f) m1 m2
unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWithKey f (Map m1) (Map m2) = Map $
I.unionWith (some_union_with_key f) m1 m2
difference :: Ord k => Map k a -> Map k b -> Map k a
difference (Map m1) (Map m2) = Map $
I.differenceWith some_diff m1 m2
where some_diff v@(Only k _) (Only l _) | k `eq` l = Nothing
| otherwise = Just v
some_diff v@(Only k _) (More t) | k `M.member` t = Nothing
| otherwise = Just v
some_diff (More t) (Only k _) = some_norm $ M.delete k t
some_diff (More t) (More u) = some_norm $ t `M.difference` u
some_diff_with_key :: Ord k => (k -> a -> b -> Maybe a) -> Some k a -> Some k b -> Maybe (Some k a)
some_diff_with_key f v@(Only k x) (Only l y) | k `eq` l = f k x y >>= return . Only k
| otherwise = Just v
some_diff_with_key f (Only k x) (More t) = some_norm $ M.differenceWithKey f (M.singleton k x) t
some_diff_with_key f (More t) (Only k x) = some_norm $ M.differenceWithKey f t (M.singleton k x)
some_diff_with_key f (More t) (More u) = some_norm $ M.differenceWithKey f t u
differenceWith :: Ord k => (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
differenceWith f (Map m1) (Map m2) = Map $
I.differenceWith (some_diff_with_key $ const f) m1 m2
differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
differenceWithKey f (Map m1) (Map m2) = Map $
I.differenceWith (some_diff_with_key f) m1 m2
delete_empty :: I.IntMap (Some k a) -> I.IntMap (Some k a)
delete_empty = I.filter some_empty
where some_empty (Only _ _) = True
some_empty (More t) = not $ M.null t
intersection :: Ord k => Map k a -> Map k b -> Map k a
intersection (Map m1) (Map m2) = Map $ delete_empty $
I.intersectionWith some_intersection m1 m2
where some_intersection v@(Only k _) (Only l _) | k `eq` l = v
| otherwise = More (M.empty)
some_intersection v@(Only k _) (More t) | k `M.member` t = v
| otherwise = More (M.empty)
some_intersection (More t) (Only k x) = some_norm' $ M.intersection t (M.singleton k x)
some_intersection (More t) (More u) = some_norm' $ M.intersection t u
some_intersection_with_key :: Ord k => (k -> a -> b -> c) -> Some k a -> Some k b -> Some k c
some_intersection_with_key f (Only k x) (Only l y) | k `eq` l = Only k (f k x y)
| otherwise = More (M.empty)
some_intersection_with_key f (Only k x) (More t) = some_norm' $ M.intersectionWithKey f (M.singleton k x) t
some_intersection_with_key f (More t) (Only k x) = some_norm' $ M.intersectionWithKey f t (M.singleton k x)
some_intersection_with_key f (More t) (More u) = some_norm' $ M.intersectionWithKey f t u
intersectionWith :: Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWith f (Map m1) (Map m2) = Map $ delete_empty $
I.intersectionWith (some_intersection_with_key $ const f) m1 m2
intersectionWithKey :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWithKey f (Map m1) (Map m2) = Map $ delete_empty $
I.intersectionWith (some_intersection_with_key f) m1 m2
isProperSubmapOf :: (Ord k, Eq a) => Map k a -> Map k a -> Bool
isProperSubmapOf m1 m2 = isSubmapOf m1 m2 && size m1 < size m2
isProperSubmapOfBy :: Ord k => (a -> b -> Bool) -> Map k a -> Map k b -> Bool
isProperSubmapOfBy f m1 m2 = isSubmapOfBy f m1 m2 && size m1 < size m2
isSubmapOf :: (Ord k, Eq a) => Map k a -> Map k a -> Bool
isSubmapOf (Map m1) (Map m2) =
I.isSubmapOfBy some_isSubmapOf m1 m2
where some_isSubmapOf (Only k _) (Only l _) = k `eq` l
some_isSubmapOf (Only k _) (More t) = k `M.member` t
some_isSubmapOf (More _) (Only _ _) = False
some_isSubmapOf (More t) (More u) = t `M.isSubmapOf` u
isSubmapOfBy :: Ord k => (a -> b -> Bool) -> Map k a -> Map k b -> Bool
isSubmapOfBy f (Map m1) (Map m2) =
I.isSubmapOfBy some_isSubmapOfBy m1 m2
where some_isSubmapOfBy (Only k x) (Only l y) = k `eq` l && x `f` y
some_isSubmapOfBy (Only k x) (More t) = case M.lookup k t of
Just y -> f x y
_ -> False
some_isSubmapOfBy (More _) (Only _ _) = False
some_isSubmapOfBy (More t) (More u) = M.isSubmapOfBy f t u
map :: (a -> b) -> Map k a -> Map k b
map f (Map m) = Map $
I.map some_map m
where some_map (Only k x) = Only k $ f x
some_map (More t) = More $ M.map f t
mapWithKey :: (k -> a -> b) -> Map k a -> Map k b
mapWithKey f (Map m) = Map $
I.map some_map_with_key m
where some_map_with_key (Only k x) = Only k $ f k x
some_map_with_key (More t) = More $ M.mapWithKey f t
mapAccum :: (a -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
mapAccum f a (Map m) =
case I.mapAccum some_map_accum a m of
(acc, m') -> (acc, Map m')
where some_map_accum acc (Only k x) = case f acc x of (acc', x') -> (acc', Only k x')
some_map_accum acc (More t) = case M.mapAccum f acc t of (acc', t') -> (acc', More t')
mapAccumWithKey :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
mapAccumWithKey f a (Map m) =
case I.mapAccum some_map_accum_with_key a m of
(acc, m') -> (acc, Map m')
where some_map_accum_with_key acc (Only k x) = case f acc k x of (acc', x') -> (acc', Only k x')
some_map_accum_with_key acc (More t) = case M.mapAccumWithKey f acc t of (acc', t') -> (acc', More t')
filter :: Ord k => (a -> Bool) -> Map k a -> Map k a
filter p (Map m) = Map $
I.mapMaybe some_filter m
where some_filter v@(Only _ x) | p x = Just v
| otherwise = Nothing
some_filter (More t) = some_norm $ M.filter p t
filterWithKey :: Ord k => (k -> a -> Bool) -> Map k a -> Map k a
filterWithKey p (Map m) = Map $
I.mapMaybe some_filter_with_key m
where some_filter_with_key v@(Only k x) | p k x = Just v
| otherwise = Nothing
some_filter_with_key (More t) = some_norm $ M.filterWithKey p t
partition :: Ord k => (a -> Bool) -> Map k a -> (Map k a, Map k a)
partition p m = (filter p m, filter (not . p) m)
partitionWithKey :: Ord k => (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
partitionWithKey p m = (filterWithKey p m, filterWithKey (\k -> not . p k) m)
mapMaybe :: Ord k => (a -> Maybe b) -> Map k a -> Map k b
mapMaybe f (Map m) = Map $
I.mapMaybe some_map_maybe m
where some_map_maybe (Only k x) = f x >>= return . Only k
some_map_maybe (More t) = some_norm $ M.mapMaybe f t
mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> Map k a -> Map k b
mapMaybeWithKey f (Map m) = Map $
I.mapMaybe some_map_maybe_with_key m
where some_map_maybe_with_key (Only k x) = f k x >>= return . Only k
some_map_maybe_with_key (More t) = some_norm $ M.mapMaybeWithKey f t
mapEither :: Ord k => (a -> Either b c) -> Map k a -> (Map k b, Map k c)
mapEither f m = (mapMaybe (maybe_left . f) m, mapMaybe (maybe_right . f) m)
mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> Map k a -> (Map k b, Map k c)
mapEitherWithKey f m = (mapMaybeWithKey (\k a -> maybe_left (f k a)) m
,mapMaybeWithKey (\k a -> maybe_right (f k a)) m)
maybe_left :: Either a b -> Maybe a
maybe_left (Left a) = Just a
maybe_left (Right _) = Nothing
maybe_right :: Either a b -> Maybe b
maybe_right (Right b) = Just b
maybe_right (Left _) = Nothing
fold :: (a -> b -> b) -> b -> Map k a -> b
fold f z (Map m) = I.fold some_fold z m
where some_fold (Only _ x) y = f x y
some_fold (More t) y = M.fold f y t
foldWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b
foldWithKey f z (Map m) = I.fold some_fold_with_key z m
where some_fold_with_key (Only k x) y = f k x y
some_fold_with_key (More t) y = M.foldWithKey f y t
elems :: Map k a -> [a]
elems (Map m) = I.fold some_append_elems [] m
where some_append_elems (Only _ x) acc = x : acc
some_append_elems (More t) acc = M.elems t ++ acc
keys :: Map k a -> [k]
keys (Map m) = I.fold some_append_keys [] m
where some_append_keys (Only k _) acc = k : acc
some_append_keys (More t) acc = M.keys t ++ acc
keysSet :: Ord k => Map k a -> S.Set k
keysSet (Map m) = I.fold (S.union . some_keys_set) S.empty m
where some_keys_set (Only k _) = S.singleton k
some_keys_set (More t) = M.keysSet t
assocs :: Map k a -> [(k,a)]
assocs = toList
toList :: Map k a -> [(k,a)]
toList (Map m) =
I.fold some_append [] m
where some_append (Only k x) acc = (k, x) : acc
some_append (More t) acc = M.toList t ++ acc
fromList :: (Hashable k, Ord k)
=> [(k,a)] -> Map k a
fromList xs = foldl' (\m (k, x) -> insert k x m) empty xs
fromListWith :: (Hashable k, Ord k) => (a -> a -> a) -> [(k,a)] -> Map k a
fromListWith f xs = foldl' (\m (k, x) -> insertWith f k x m) empty xs
fromListWithKey :: (Hashable k, Ord k) => (k -> a -> a -> a) -> [(k,a)] -> Map k a
fromListWithKey f xs = foldl' (\m (k, x) -> insertWithKey f k x m) empty xs