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
data Entry a = Entry !Int a deriving (Show)
data MaybePair k v = NothingPair | JustPair k v deriving (Show)
data LinkedHashMap k v = LinkedHashMap (M.HashMap k (Entry v)) (Seq (MaybePair 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) -> JustPair 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@(JustPair k _)
| n == ix = (m, s |> jkv, n + 1)
| n > ix = (m, s, n)
| otherwise = (M.insert k (Entry n v) m, s |> JustPair k v, n + 1)
where
Entry ix v = fromJust $ M.lookup k m
skipDups _ _ = error "Data.LinkedHashMap.Seq invariant violated"
toList ::LinkedHashMap k v -> [(k, v)]
toList (LinkedHashMap _ s _) = [(k, v) | JustPair k v <- 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.update ix (JustPair k v) s, ix, n)
Nothing -> (s |> JustPair 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 NothingPair 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
Entry ixnew vnew = fromJust $ M.lookup k m'
(s', n') = if ixnew == slen
then (s |> JustPair k vnew, n + 1)
else (S.update ixnew (JustPair 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 (JustPair 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'' (JustPair k v1) = JustPair k $ f k v1
f'' _ = NothingPair
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' (JustPair k v1) = (\v -> JustPair k v) <$> f k v1
f' NothingPair = pure NothingPair
getV2 s (Entry ix _) = let JustPair _ v2 = 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 (JustPair _ 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 (JustPair 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' (JustPair 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 a, NFData b) => NFData (MaybePair a b) where
rnf (JustPair a b) = rnf a `seq` rnf b
rnf NothingPair = ()
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' (JustPair _ v) b = f v b
f' _ b = b
instance T.Traversable (LinkedHashMap k) where
traverse f = traverseWithKey (const f)