module Data.LinkedHashMap.Seq
(
LinkedHashMap(..)
, empty
, singleton
, null
, size
, member
, lookup
, lookupDefault
, (!)
, insert
, insertWith
, delete
, adjust
, union
, unionWith
, unions
, map
, mapWithKey
, traverseWithKey
, difference
, intersection
, intersectionWith
, foldl'
, foldlWithKey'
, foldr
, foldrWithKey
, filter
, filterWithKey
, keys
, elems
, toList
, fromList
, fromListWith
, pack
) where
import Prelude hiding (foldr, map, null, lookup, filter)
import Data.Maybe
import Control.Applicative ((<$>), Applicative(pure))
import Control.DeepSeq (NFData(rnf))
import Data.Hashable (Hashable)
import Data.Sequence (Seq, (|>))
import Data.Traversable (Traversable(..))
import qualified Data.Sequence as S
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import qualified Data.List as L
import qualified Data.HashMap.Strict as M
newtype Entry a = Entry { unEntry :: (Int, a) } deriving (Show)
instance Eq a => Eq (Entry a) where
(Entry (_, a)) == (Entry (_, b)) = a == b
data LinkedHashMap k v = LinkedHashMap (M.HashMap k (Entry v)) (Seq (Maybe (k, v))) !Int
instance (Show k, Show v) => Show (LinkedHashMap k v) where
showsPrec d m@(LinkedHashMap _ _ _) = showParen (d > 10) $
showString "fromList " . shows (toList m)
lookup :: (Eq k, Hashable k) => k -> LinkedHashMap k v -> Maybe v
lookup k0 (LinkedHashMap m0 _ _) = case M.lookup k0 m0 of
Just (Entry (_, v)) -> Just v
Nothing -> Nothing
fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> LinkedHashMap k v
fromListWith f = L.foldl' (\ m (k, v) -> insertWith f k v m) empty
fromList :: (Eq k, Hashable k) => [(k, v)] -> LinkedHashMap k v
fromList ps = LinkedHashMap m' s' len'
where
m0 = M.fromList $ L.map (\(i, (k, v)) -> (k, Entry (i, v))) $ zip [0..] ps
s0 = S.fromList $ L.map (\(k, v) -> Just (k, v)) ps
len = M.size m0
(m', s', len') = if len == S.length s0
then (m0, s0, len)
else F.foldl' skipDups (m0, S.empty, 0) s0
skipDups (m, s, n) jkv@(Just (k, _))
| n == ix = (m, s |> jkv, n + 1)
| n > ix = (m, s, n)
| otherwise = (M.insert k (Entry (n, v)) m, s |> Just (k, v), n + 1)
where
(ix, v) = unEntry $ fromJust $ M.lookup k m
skipDups _ _ = error "Data.LinkedHashMap.Seq invariant violated"
toList ::LinkedHashMap k v -> [(k, v)]
toList (LinkedHashMap _ s _) = catMaybes (F.toList s)
insert :: (Eq k, Hashable k) => k -> v -> LinkedHashMap k v -> LinkedHashMap k v
insert k !v (LinkedHashMap m s n) = LinkedHashMap m' s' n'
where
m' = M.insert k (Entry (ix', v)) m
(s', ix', n') = case M.lookup k m of
Just (Entry (ix, _)) -> (s, ix, n)
Nothing -> (s |> Just (k, v), S.length s, n+1)
pack :: (Eq k, Hashable k) => LinkedHashMap k v -> LinkedHashMap k v
pack = fromList . toList
delete :: (Eq k, Hashable k) => k -> LinkedHashMap k v -> LinkedHashMap k v
delete k0 (LinkedHashMap m s n) = if S.length s `div` 2 >= n
then pack lhm
else lhm
where
lhm = LinkedHashMap m' s' n'
(m', s', n') = case M.lookup k0 m of
Nothing -> (m, s, n)
Just (Entry (i, _)) -> (M.delete k0 m, S.update i Nothing s, n1)
empty :: LinkedHashMap k v
empty = LinkedHashMap M.empty S.empty 0
singleton :: (Eq k, Hashable k) => k -> v -> LinkedHashMap k v
singleton k v = fromList [(k, v)]
null :: LinkedHashMap k v -> Bool
null (LinkedHashMap m _ _) = M.null m
member :: (Eq k, Hashable k) => k -> LinkedHashMap k a -> Bool
member k m = case lookup k m of
Nothing -> False
Just _ -> True
size :: LinkedHashMap k v -> Int
size (LinkedHashMap _ _ n) = n
lookupDefault :: (Eq k, Hashable k)
=> v
-> k -> LinkedHashMap k v -> v
lookupDefault def k t = case lookup k t of
Just v -> v
_ -> def
(!) :: (Eq k, Hashable k) => LinkedHashMap k v -> k -> v
(!) m k = case lookup k m of
Just v -> v
Nothing -> error "Data.LinkedHashMap.Seq.(!): key not found"
keys :: (Eq k, Hashable k) => LinkedHashMap k v -> [k]
keys m = L.map (\(k, _) -> k) $ toList m
elems :: (Eq k, Hashable k) => LinkedHashMap k v -> [v]
elems m = L.map (\(_, v) -> v) $ toList m
insertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> LinkedHashMap k v -> LinkedHashMap k v
insertWith f k v (LinkedHashMap m s n) = LinkedHashMap m' s' n'
where
m' = M.insertWith f' k v' m
f' (Entry (_, v1)) (Entry (ix, v2)) = Entry (ix, f v1 v2)
slen = S.length s
v' = Entry (slen, v)
(ixnew, vnew) = unEntry $ fromJust $ M.lookup k m'
(s', n') = if ixnew == slen
then (s |> Just (k, vnew), n + 1)
else (S.update ixnew (Just (k, vnew)) s, n)
adjust :: (Eq k, Hashable k) => (v -> v) -> k -> LinkedHashMap k v -> LinkedHashMap k v
adjust f k (LinkedHashMap m s n) = LinkedHashMap m' s' n
where
m' = M.adjust f' k m
f' (Entry (ix, v)) = Entry (ix, f v)
s' = case M.lookup k m' of
Just (Entry (ix, v)) -> S.update ix (Just (k, v)) s
Nothing -> s
union :: (Eq k, Hashable k) => LinkedHashMap k v -> LinkedHashMap k v -> LinkedHashMap k v
union = unionWith const
unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> LinkedHashMap k v -> LinkedHashMap k v
-> LinkedHashMap k v
unionWith f m1 m2 = m'
where
m' = F.foldl' (\m (k, v) -> insertWith (flip f) k v m) m1 $ toList m2
unions :: (Eq k, Hashable k) => [LinkedHashMap k v] -> LinkedHashMap k v
unions = F.foldl' union empty
map :: (v1 -> v2) -> LinkedHashMap k v1 -> LinkedHashMap k v2
map f = mapWithKey (const f)
mapWithKey :: (k -> v1 -> v2) -> LinkedHashMap k v1 -> LinkedHashMap k v2
mapWithKey f (LinkedHashMap m s n) = (LinkedHashMap m' s' n)
where
m' = M.mapWithKey f' m
s' = fmap f'' s
f' k (Entry (ix, v1)) = Entry (ix, f k v1)
f'' (Just (k, v1)) = Just (k, f k v1)
f'' _ = Nothing
traverseWithKey :: Applicative f => (k -> v1 -> f v2) -> LinkedHashMap k v1
-> f (LinkedHashMap k v2)
traverseWithKey f (LinkedHashMap m0 s0 n) = (\s -> LinkedHashMap (M.map (getV2 s) m0) s n) <$> s'
where
s' = T.traverse f' s0
f' (Just (k, v1)) = (\v -> Just (k, v)) <$> f k v1
f' Nothing = pure Nothing
getV2 s (Entry (ix, _)) = let (_, v2) = fromJust $ S.index s ix in Entry (ix, v2)
difference :: (Eq k, Hashable k) => LinkedHashMap k v -> LinkedHashMap k w -> LinkedHashMap k v
difference a b = foldlWithKey' go empty a
where
go m k v = case lookup k b of
Nothing -> insert k v m
_ -> m
intersection :: (Eq k, Hashable k) => LinkedHashMap k v -> LinkedHashMap k w -> LinkedHashMap k v
intersection a b = foldlWithKey' go empty a
where
go m k v = case lookup k b of
Just _ -> insert k v m
_ -> m
intersectionWith :: (Eq k, Hashable k) => (v1 -> v2 -> v3) -> LinkedHashMap k v1
-> LinkedHashMap k v2 -> LinkedHashMap k v3
intersectionWith f a b = foldlWithKey' go empty a
where
go m k v = case lookup k b of
Just w -> insert k (f v w) m
_ -> m
foldl' :: (a -> v -> a) -> a -> LinkedHashMap k v -> a
foldl' f b0 (LinkedHashMap _ s _) = F.foldl' f' b0 s
where
f' b (Just (_, v)) = f b v
f' b _ = b
foldr :: (v -> a -> a) -> a -> LinkedHashMap k v -> a
foldr = F.foldr
foldlWithKey' :: (a -> k -> v -> a) -> a -> LinkedHashMap k v -> a
foldlWithKey' f b0 (LinkedHashMap _ s _) = F.foldl' f' b0 s
where
f' b (Just (k, v)) = f b k v
f' b _ = b
foldrWithKey :: (k -> v -> a -> a) -> a -> LinkedHashMap k v -> a
foldrWithKey f b0 (LinkedHashMap _ s _) = F.foldr f' b0 s
where
f' (Just (k, v)) b = f k v b
f' _ b = b
filterWithKey :: (Eq k, Hashable k) => (k -> v -> Bool) -> LinkedHashMap k v -> LinkedHashMap k v
filterWithKey p m = fromList $ L.filter (uncurry p) $ toList m
filter :: (Eq k, Hashable k) => (v -> Bool) -> LinkedHashMap k v -> LinkedHashMap k v
filter p = filterWithKey (\_ v -> p v)
instance (NFData a) => NFData (Entry a) where
rnf (Entry a) = rnf a
instance (NFData k, NFData v) => NFData (LinkedHashMap k v) where
rnf (LinkedHashMap m s _) = rnf m `seq` rnf s
instance Functor (LinkedHashMap k) where
fmap = map
instance F.Foldable (LinkedHashMap k) where
foldr f b0 (LinkedHashMap _ s _) = F.foldr f' b0 s
where
f' (Just (_, v)) b = f v b
f' _ b = b
instance T.Traversable (LinkedHashMap k) where
traverse f = traverseWithKey (const f)