@@ -3,9 +3,9 @@
33{-# LANGUAGE DeriveFunctor #-}
44{-# LANGUAGE FlexibleInstances #-}
55
6−-- | An 'OMap' behaves much like a 'Map', with mostly the same asymptotics, but
6+-- | An 'OMap' behaves much like a 'M.Map', with mostly the same asymptotics, but
77-- also remembers the order that keys were inserted. All operations whose
8−-- asymptotics are worse than 'Map' have documentation saying so.
8+-- asymptotics are worse than 'M.Map' have documentation saying so.
99module Data.Map.Ordered
1010 ( OMap
1111 -- * Trivial maps
@@ -32,242 +32,11 @@ module Data.Map.Ordered
3232 , Index, findIndex, elemAt
3333 -- * List conversions
3434 , fromList, assocs, toAscList
35+ -- * 'M.Map' conversion
36+ , toMap
3537 ) where
3638
37−import Control.Applicative ((<|>))
38−import Control.Monad (guard)
39−import Data.Data
40−import Data.Foldable (Foldable, foldl', foldMap)
41−import Data.Function (on)
42−import Data.Map (Map)
39+import qualified Data.Map as M ()
40+import Data.Map.Ordered.Internal
4341import Data.Map.Util
44−import Data.Monoid (Monoid(..))
45−#if MIN_VERSION_base(4,9,0)
46−import Data.Semigroup (Semigroup(..))
47−#endif
48−#if !(MIN_VERSION_base(4,8,0))
49−import Control.Applicative ((<$>))
50−import Data.Traversable
51−#endif
5242import Prelude hiding (filter, lookup, null)
53−import qualified Data.Map as M
54−
55−data OMap k v = OMap !(Map k (Tag, v)) !(Map Tag (k, v))
56− deriving (Functor, Typeable)
57−
58−-- | Values are produced in insertion order, not key order.
59−instance Foldable (OMap k) where foldMap f (OMap _ kvs) = foldMap (f . snd) kvs
60−instance ( Eq k, Eq v) => Eq (OMap k v) where (==) = (==) `on` assocs
61−instance ( Ord k, Ord v) => Ord (OMap k v) where compare = compare `on` assocs
62−instance ( Show k, Show v) => Show (OMap k v) where showsPrec = showsPrecList assocs
63−instance (Ord k, Read k, Read v) => Read (OMap k v) where readsPrec = readsPrecList fromList
64−
65−-- This instance preserves data abstraction at the cost of inefficiency.
66−-- We provide limited reflection services for the sake of data abstraction.
67−instance (Data k, Data a, Ord k) => Data (OMap k a) where
68− gfoldl f z m = z fromList `f` assocs m
69− toConstr _ = fromListConstr
70− gunfold k z c = case constrIndex c of
71− 1 -> k (z fromList)
72− _ -> error "gunfold"
73− dataTypeOf _ = oMapDataType
74− -- dataCast2 /must/ be eta-expanded in order to build on GHC 7.8.
75− dataCast2 f = gcast2 f
76−
77−fromListConstr :: Constr
78−fromListConstr = mkConstr oMapDataType "fromList" [] Prefix
79−
80−oMapDataType :: DataType
81−oMapDataType = mkDataType "Data.Map.Ordered.Map" [fromListConstr]
82−
83−#if MIN_VERSION_base(4,9,0)
84−instance (Ord k, Semigroup v) => Semigroup (Bias L (OMap k v)) where
85− Bias o <> Bias o' = Bias (unionWithL (const (<>)) o o')
86−instance (Ord k, Semigroup v) => Semigroup (Bias R (OMap k v)) where
87− Bias o <> Bias o' = Bias (unionWithR (const (<>)) o o')
88−#endif
89−
90−-- | Empty maps and map union. When combining two sets that share elements, the
91−-- indices of the left argument are preferred, and the values are combined with
92−-- 'mappend'.
93−--
94−-- See the asymptotics of 'unionWithL'.
95−instance (Ord k, Monoid v) => Monoid (Bias L (OMap k v)) where
96− mempty = Bias empty
97− mappend (Bias o) (Bias o') = Bias (unionWithL (const mappend) o o')
98−
99−-- | Empty maps and map union. When combining two sets that share elements, the
100−-- indices of the right argument are preferred, and the values are combined
101−-- with 'mappend'.
102−--
103−-- See the asymptotics of 'unionWithR'.
104−instance (Ord k, Monoid v) => Monoid (Bias R (OMap k v)) where
105− mempty = Bias empty
106− mappend (Bias o) (Bias o') = Bias (unionWithR (const mappend) o o')
107−
108−-- | Values are traversed in insertion order, not key order.
109−--
110−-- /O(n*log(n))/ where /n/ is the size of the map.
111−instance Ord k => Traversable (OMap k) where
112− traverse f (OMap tvs kvs) = fromKV <$> traverse (\(k,v) -> (,) k <$> f v) kvs
113−
114−infixr 5 <|, |< -- copy :
115−infixl 5 >|, |>
116−infixr 6 <>|, |<> -- copy <>
117−
118−(<|) , (|<) :: Ord k => (,) k v -> OMap k v -> OMap k v
119−(>|) , (|>) :: Ord k => OMap k v -> (,) k v -> OMap k v
120−
121−-- | When a key occurs in both maps, prefer the value from the first map.
122−--
123−-- See asymptotics of 'unionWithR'.
124−(<>|) :: Ord k => OMap k v -> OMap k v -> OMap k v
125−
126−-- | When a key occurs in both maps, prefer the value from the first map.
127−--
128−-- See asymptotics of 'unionWithL'.
129−(|<>) :: Ord k => OMap k v -> OMap k v -> OMap k v
130−
131−(k, v) <| OMap tvs kvs = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
132− t = maybe (nextLowerTag kvs) fst (M.lookup k tvs)
133−
134−(k, v) |< o = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
135− t = nextLowerTag kvs
136− OMap tvs kvs = delete k o
137−
138−o >| (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
139− t = nextHigherTag kvs
140− OMap tvs kvs = delete k o
141−
142−OMap tvs kvs |> (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
143− t = maybe (nextHigherTag kvs) fst (M.lookup k tvs)
144−
145−(<>|) = unionWithR (const const)
146−(|<>) = unionWithL (const const)
147−
148−-- | Take the union. The first 'OMap' \'s argument's indices are lower than the
149−-- second. If a key appears in both maps, the first argument's index takes
150−-- precedence, and the supplied function is used to combine the values.
151−--
152−-- /O(r*log(r))/ where /r/ is the size of the result
153−unionWithL :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
154−unionWithL = unionWithInternal (\t t' -> t )
155−
156−-- | Take the union. The first 'OMap' \'s argument's indices are lower than the
157−-- second. If a key appears in both maps, the second argument's index takes
158−-- precedence, and the supplied function is used to combine the values.
159−--
160−-- /O(r*log(r))/ where /r/ is the size of the result
161−unionWithR :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
162−unionWithR = unionWithInternal (\t t' -> t')
163−
164−unionWithInternal :: Ord k => (Tag -> Tag -> Tag) -> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
165−unionWithInternal fT fKV (OMap tvs kvs) (OMap tvs' kvs') = fromTV tvs'' where
166− bump = case maxTag kvs of
167− Nothing -> 0
168− Just k -> -k-1
169− bump' = case minTag kvs' of
170− Nothing -> 0
171− Just k -> -k
172− tvs'' = M.unionWithKey (\k (t,v) (t',v') -> (fT t t', fKV k v v'))
173− (fmap (\(t,v) -> (bump +t,v)) tvs )
174− (fmap (\(t,v) -> (bump'+t,v)) tvs')
175−
176−-- | @m \\\\ n@ deletes all the keys that exist in @n@ from @m@
177−--
178−-- /O(m*log(n))/ where /m/ is the size of the smaller map and /n/ is the size
179−-- of the larger map.
180−(\\) :: Ord k => OMap k v -> OMap k v' -> OMap k v
181−o@(OMap tvs kvs) \\ o'@(OMap tvs' kvs') = if size o < size o'
182− then filter (const . (`notMember` o')) o
183− else foldr delete o (fmap fst (assocs o'))
184−
185−empty :: OMap k v
186−empty = OMap M.empty M.empty
187−
188−singleton :: (k, v) -> OMap k v
189−singleton kv@(k, v) = OMap (M.singleton k (0, v)) (M.singleton 0 kv)
190−
191−-- | If a key appears multiple times, the first occurrence is used for ordering
192−-- and the last occurrence is used for its value. The library author welcomes
193−-- comments on whether this default is sane.
194−fromList :: Ord k => [(k, v)] -> OMap k v
195−fromList = foldl' (|>) empty
196−
197−null :: OMap k v -> Bool
198−null (OMap tvs _) = M.null tvs
199−
200−size :: OMap k v -> Int
201−size (OMap tvs _) = M.size tvs
202−
203−member, notMember :: Ord k => k -> OMap k v -> Bool
204−member k (OMap tvs _) = M.member k tvs
205−notMember k (OMap tvs _) = M.notMember k tvs
206−
207−lookup :: Ord k => k -> OMap k v -> Maybe v
208−lookup k (OMap tvs _) = fmap snd (M.lookup k tvs)
209−
210−-- The Ord constraint is for compatibility with older (<0.5) versions of
211−-- containers.
212−-- | @filter f m@ contains exactly the key-value pairs of @m@ that satisfy @f@,
213−-- without changing the order they appear
214−filter :: Ord k => (k -> v -> Bool) -> OMap k v -> OMap k v
215−filter f (OMap tvs kvs) = OMap (M.filterWithKey (\k (t, v) -> f k v) tvs)
216− (M.filterWithKey (\t (k, v) -> f k v) kvs)
217−
218−delete :: Ord k => k -> OMap k v -> OMap k v
219−delete k o@(OMap tvs kvs) = case M.lookup k tvs of
220− Nothing -> o
221− Just (t, _) -> OMap (M.delete k tvs) (M.delete t kvs)
222−
223−-- | Intersection. (The @/\\@ is intended to look a bit like the standard
224−-- mathematical notation for set intersection.)
225−--
226−-- See asymptotics of 'intersectionWith'.
227−(/\|) :: Ord k => OMap k v -> OMap k v' -> OMap k v
228−o /\| o' = intersectionWith (\k v' v -> v) o' o
229−
230−-- | Intersection. (The @/\\@ is intended to look a bit like the standard
231−-- mathematical notation for set intersection.)
232−--
233−-- See asymptotics of 'intersectionWith'.
234−(|/\) :: Ord k => OMap k v -> OMap k v' -> OMap k v
235−o |/\ o' = intersectionWith (\k v v' -> v) o o'
236−
237−-- | Take the intersection. The first 'OMap' \'s argument's indices are used for
238−-- the result.
239−--
240−-- /O(m*log(n\/(m+1)) + r*log(r))/ where /m/ is the size of the smaller map, /n/
241−-- is the size of the larger map, and /r/ is the size of the result.
242−intersectionWith ::
243− Ord k =>
244− (k -> v -> v' -> v'') ->
245− OMap k v -> OMap k v' -> OMap k v''
246−intersectionWith f (OMap tvs kvs) (OMap tvs' kvs') = fromTV
247− $ M.intersectionWithKey (\k (t,v) (t',v') -> (t, f k v v')) tvs tvs'
248−
249−fromTV :: Ord k => Map k (Tag, v) -> OMap k v
250−fromTV tvs = OMap tvs kvs where
251− kvs = M.fromList [(t,(k,v)) | (k,(t,v)) <- M.toList tvs]
252−
253−fromKV :: Ord k => Map Tag (k, v) -> OMap k v
254−fromKV kvs = OMap tvs kvs where
255− tvs = M.fromList [(k,(t,v)) | (t,(k,v)) <- M.toList kvs]
256−
257−findIndex :: Ord k => k -> OMap k v -> Maybe Index
258−findIndex k o@(OMap tvs kvs) = do
259− (t, _) <- M.lookup k tvs
260− M.lookupIndex t kvs
261−
262−elemAt :: OMap k v -> Index -> Maybe (k, v)
263−elemAt o@(OMap tvs kvs) i = do
264− guard (0 <= i && i < M.size kvs)
265− return . snd $ M.elemAt i kvs
266−
267−-- | Return key-value pairs in the order they were inserted.
268−assocs :: OMap k v -> [(k, v)]
269−assocs (OMap _ kvs) = map snd $ M.toAscList kvs
270−
271−-- | Return key-value pairs in order of increasing key.
272−toAscList :: OMap k v -> [(k, v)]
273−toAscList (OMap tvs kvs) = map (\(k, (t, v)) -> (k, v)) $ M.toAscList tvs