@@ -0,0 +1,126 @@
1+-- | An 'OMap' behaves much like a 'Map', with all the same asymptotics, but
2+-- also remembers the order that keys were inserted.
3+module Data.Map.Ordered
4+ ( OMap
5+ -- * Trivial maps
6+ , empty, singleton
7+ -- * Insertion
8+ -- | Conventions:
9+ --
10+ -- * The open side of an angle bracket points to an 'OMap'
11+ --
12+ -- * The pipe appears on the side whose indices take precedence if both sides contain the same key
13+ --
14+ -- * The left argument's indices are lower than the right argument's indices
15+ --
16+ -- * If both sides contain the same key, the tuple's value wins
17+ , (<|), (|<), (>|), (|>)
18+ -- * Deletion
19+ , delete, filter, (\\)
20+ -- * Query
21+ , null, size, member, notMember, lookup
22+ -- * Indexing
23+ , Index, findIndex, elemAt
24+ -- * List conversions
25+ , fromList, assocs, toAscList
26+ ) where
27+
28+import Control.Applicative ((<|>))
29+import Control.Monad (guard)
30+import Data.Foldable (Foldable, foldl', foldMap)
31+import Data.Function (on)
32+import Data.Map (Map)
33+import Data.Map.Util (Index, Tag, maxTag, minTag, nextHigherTag, nextLowerTag, readsPrecList, showsPrecList)
34+import Prelude hiding (filter, lookup, null)
35+import qualified Data.Map as M
36+
37+data OMap k v = OMap !(Map k (Tag, v)) !(Map Tag (k, v))
38+
39+-- | Values are produced in insertion order, not key order.
40+instance Foldable (OMap k) where foldMap f (OMap _ kvs) = foldMap (f . snd) kvs
41+instance ( Eq k, Eq v) => Eq (OMap k v) where (==) = (==) `on` assocs
42+instance ( Ord k, Ord v) => Ord (OMap k v) where compare = compare `on` assocs
43+instance ( Show k, Show v) => Show (OMap k v) where showsPrec = showsPrecList assocs
44+instance (Ord k, Read k, Read v) => Read (OMap k v) where readsPrec = readsPrecList fromList
45+
46+infixr 5 <|, |< -- copy :
47+infixl 5 >|, |>
48+
49+(<|) , (|<) :: Ord k => (,) k v -> OMap k v -> OMap k v
50+(>|) , (|>) :: Ord k => OMap k v -> (,) k v -> OMap k v
51+
52+(k, v) <| OMap tvs kvs = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
53+ t = maybe (nextLowerTag kvs) fst (M.lookup k tvs)
54+
55+(k, v) |< o = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
56+ t = nextLowerTag kvs
57+ OMap tvs kvs = delete k o
58+
59+o >| (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
60+ t = nextHigherTag kvs
61+ OMap tvs kvs = delete k o
62+
63+OMap tvs kvs |> (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
64+ t = maybe (nextHigherTag kvs) fst (M.lookup k tvs)
65+
66+-- | @m \\\\ n@ deletes all the keys that exist in @n@ from @m@
67+(\\) :: Ord k => OMap k v -> OMap k v' -> OMap k v
68+o@(OMap tvs kvs) \\ o'@(OMap tvs' kvs') = if size o < size o'
69+ then filter (const . (`notMember` o')) o
70+ else foldr delete o (fmap fst (assocs o'))
71+
72+empty :: OMap k v
73+empty = OMap M.empty M.empty
74+
75+singleton :: (k, v) -> OMap k v
76+singleton kv@(k, v) = OMap (M.singleton k (0, v)) (M.singleton 0 kv)
77+
78+-- | If a key appears multiple times, the first occurrence is used for ordering
79+-- and the last occurrence is used for its value. The library author welcomes
80+-- comments on whether this default is sane.
81+fromList :: Ord k => [(k, v)] -> OMap k v
82+fromList = foldl' (|>) empty
83+
84+null :: OMap k v -> Bool
85+null (OMap tvs _) = M.null tvs
86+
87+size :: OMap k v -> Int
88+size (OMap tvs _) = M.size tvs
89+
90+member, notMember :: Ord k => k -> OMap k v -> Bool
91+member k (OMap tvs _) = M.member k tvs
92+notMember k (OMap tvs _) = M.notMember k tvs
93+
94+lookup :: Ord k => k -> OMap k v -> Maybe v
95+lookup k (OMap tvs _) = fmap snd (M.lookup k tvs)
96+
97+-- The Ord constraint is for compatibility with older (<0.5) versions of
98+-- containers.
99+-- | @filter f m@ contains exactly the key-value pairs of @m@ that satisfy @f@,
100+-- without changing the order they appear
101+filter :: Ord k => (k -> v -> Bool) -> OMap k v -> OMap k v
102+filter f (OMap tvs kvs) = OMap (M.filterWithKey (\k (t, v) -> f k v) tvs)
103+ (M.filterWithKey (\t (k, v) -> f k v) kvs)
104+
105+delete :: Ord k => k -> OMap k v -> OMap k v
106+delete k o@(OMap tvs kvs) = case M.lookup k tvs of
107+ Nothing -> o
108+ Just (t, _) -> OMap (M.delete k tvs) (M.delete t kvs)
109+
110+findIndex :: Ord k => k -> OMap k v -> Maybe Index
111+findIndex k o@(OMap tvs kvs) = do
112+ (t, _) <- M.lookup k tvs
113+ M.lookupIndex t kvs
114+
115+elemAt :: OMap k v -> Index -> Maybe (k, v)
116+elemAt o@(OMap tvs kvs) i = do
117+ guard (0 <= i && i < M.size kvs)
118+ return . snd $ M.elemAt i kvs
119+
120+-- | Return key-value pairs in the order they were inserted.
121+assocs :: OMap k v -> [(k, v)]
122+assocs (OMap _ kvs) = map snd $ M.toAscList kvs
123+
124+-- | Return key-value pairs in order of increasing key.
125+toAscList :: OMap k v -> [(k, v)]
126+toAscList (OMap tvs kvs) = map (\(k, (t, v)) -> (k, v)) $ M.toAscList tvs