packages feed

ordered-containers 0.2.1 → 0.2.2

raw patch · 7 files changed

+399/−240 lines, 7 files

Files

ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for ordered-containers +## 0.2.2 -- 2019-07-05++* Add `toMap` and `toSet`, which support efficient conversions from+  `OMap`s/`OSet`s to `Map`s/`Set`s, respectively.+ ## 0.2.1 -- 2019-03-25  * Compatibility fixes from Ryan Scott (thanks!)
Data/Map/Ordered.hs view
@@ -3,9 +3,9 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-} --- | An 'OMap' behaves much like a 'Map', with mostly the same asymptotics, but+-- | An 'OMap' behaves much like a 'M.Map', with mostly the same asymptotics, but -- also remembers the order that keys were inserted. All operations whose--- asymptotics are worse than 'Map' have documentation saying so.+-- asymptotics are worse than 'M.Map' have documentation saying so. module Data.Map.Ordered 	( OMap 	-- * Trivial maps@@ -32,242 +32,11 @@ 	, Index, findIndex, elemAt 	-- * List conversions 	, fromList, assocs, toAscList+	-- * 'M.Map' conversion+	, toMap 	) where -import Control.Applicative ((<|>))-import Control.Monad (guard)-import Data.Data-import Data.Foldable (Foldable, foldl', foldMap)-import Data.Function (on)-import Data.Map (Map)+import qualified Data.Map as M ()+import Data.Map.Ordered.Internal import Data.Map.Util-import Data.Monoid (Monoid(..))-#if MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup(..))-#endif-#if !(MIN_VERSION_base(4,8,0))-import Control.Applicative ((<$>))-import Data.Traversable-#endif import Prelude hiding (filter, lookup, null)-import qualified Data.Map as M--data OMap k v = OMap !(Map k (Tag, v)) !(Map Tag (k, v))-	deriving (Functor, Typeable)---- | Values are produced in insertion order, not key order.-instance Foldable (OMap k) where foldMap f (OMap _ kvs) = foldMap (f . snd) kvs-instance (       Eq   k, Eq   v) => Eq   (OMap k v) where (==)    = (==)    `on` assocs-instance (       Ord  k, Ord  v) => Ord  (OMap k v) where compare = compare `on` assocs-instance (       Show k, Show v) => Show (OMap k v) where showsPrec = showsPrecList assocs-instance (Ord k, Read k, Read v) => Read (OMap k v) where readsPrec = readsPrecList fromList---- This instance preserves data abstraction at the cost of inefficiency.--- We provide limited reflection services for the sake of data abstraction.-instance (Data k, Data a, Ord k) => Data (OMap k a) where-	gfoldl f z m   = z fromList `f` assocs m-	toConstr _     = fromListConstr-	gunfold k z c  = case constrIndex c of-		1 -> k (z fromList)-		_ -> error "gunfold"-	dataTypeOf _   = oMapDataType-	-- dataCast2 /must/ be eta-expanded in order to build on GHC 7.8.-	dataCast2 f    = gcast2 f--fromListConstr :: Constr-fromListConstr = mkConstr oMapDataType "fromList" [] Prefix--oMapDataType :: DataType-oMapDataType = mkDataType "Data.Map.Ordered.Map" [fromListConstr]--#if MIN_VERSION_base(4,9,0)-instance (Ord k, Semigroup v) => Semigroup (Bias L (OMap k v)) where-	Bias o <> Bias o' = Bias (unionWithL (const (<>)) o o')-instance (Ord k, Semigroup v) => Semigroup (Bias R (OMap k v)) where-	Bias o <> Bias o' = Bias (unionWithR (const (<>)) o o')-#endif---- | Empty maps and map union. When combining two sets that share elements, the--- indices of the left argument are preferred, and the values are combined with--- 'mappend'.------ See the asymptotics of 'unionWithL'.-instance (Ord k, Monoid v) => Monoid (Bias L (OMap k v)) where-	mempty = Bias empty-	mappend (Bias o) (Bias o') = Bias (unionWithL (const mappend) o o')---- | Empty maps and map union. When combining two sets that share elements, the--- indices of the right argument are preferred, and the values are combined--- with 'mappend'.------ See the asymptotics of 'unionWithR'.-instance (Ord k, Monoid v) => Monoid (Bias R (OMap k v)) where-	mempty = Bias empty-	mappend (Bias o) (Bias o') = Bias (unionWithR (const mappend) o o')---- | Values are traversed in insertion order, not key order.------ /O(n*log(n))/ where /n/ is the size of the map.-instance Ord k => Traversable (OMap k) where-	traverse f (OMap tvs kvs) = fromKV <$> traverse (\(k,v) -> (,) k <$> f v) kvs--infixr 5 <|, |< -- copy :-infixl 5 >|, |>-infixr 6 <>|, |<> -- copy <>--(<|) , (|<) :: Ord k => (,)  k v -> OMap k v -> OMap k v-(>|) , (|>) :: Ord k => OMap k v -> (,)  k v -> OMap k v---- | When a key occurs in both maps, prefer the value from the first map.------ See asymptotics of 'unionWithR'.-(<>|) :: Ord k => OMap k v -> OMap k v -> OMap k v---- | When a key occurs in both maps, prefer the value from the first map.------ See asymptotics of 'unionWithL'.-(|<>) :: Ord k => OMap k v -> OMap k v -> OMap k v--(k, v) <| OMap tvs kvs = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where-	t = maybe (nextLowerTag kvs) fst (M.lookup k tvs)--(k, v) |< o = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where-	t = nextLowerTag kvs-	OMap tvs kvs = delete k o--o >| (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where-	t = nextHigherTag kvs-	OMap tvs kvs = delete k o--OMap tvs kvs |> (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where-	t = maybe (nextHigherTag kvs) fst (M.lookup k tvs)--(<>|) = unionWithR (const const)-(|<>) = unionWithL (const const)---- | Take the union. The first 'OMap' \'s argument's indices are lower than the--- second. If a key appears in both maps, the first argument's index takes--- precedence, and the supplied function is used to combine the values.------ /O(r*log(r))/ where /r/ is the size of the result-unionWithL :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v-unionWithL = unionWithInternal (\t t' -> t )---- | Take the union. The first 'OMap' \'s argument's indices are lower than the--- second. If a key appears in both maps, the second argument's index takes--- precedence, and the supplied function is used to combine the values.------ /O(r*log(r))/ where /r/ is the size of the result-unionWithR :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v-unionWithR = unionWithInternal (\t t' -> t')--unionWithInternal :: Ord k => (Tag -> Tag -> Tag) -> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v-unionWithInternal fT fKV (OMap tvs kvs) (OMap tvs' kvs') = fromTV tvs'' where-	bump  = case maxTag kvs  of-		Nothing -> 0-		Just k  -> -k-1-	bump' = case minTag kvs' of-		Nothing -> 0-		Just k  -> -k-	tvs'' = M.unionWithKey (\k (t,v) (t',v') -> (fT t t', fKV k v v'))-		(fmap (\(t,v) -> (bump +t,v)) tvs )-		(fmap (\(t,v) -> (bump'+t,v)) tvs')---- | @m \\\\ n@ deletes all the keys that exist in @n@ from @m@------ /O(m*log(n))/ where /m/ is the size of the smaller map and /n/ is the size--- of the larger map.-(\\) :: Ord k => OMap k v -> OMap k v' -> OMap k v-o@(OMap tvs kvs) \\ o'@(OMap tvs' kvs') = if size o < size o'-	then filter (const . (`notMember` o')) o-	else foldr delete o (fmap fst (assocs o'))--empty :: OMap k v-empty = OMap M.empty M.empty--singleton :: (k, v) -> OMap k v-singleton kv@(k, v) = OMap (M.singleton k (0, v)) (M.singleton 0 kv)---- | If a key appears multiple times, the first occurrence is used for ordering--- and the last occurrence is used for its value. The library author welcomes--- comments on whether this default is sane.-fromList :: Ord k => [(k, v)] -> OMap k v-fromList = foldl' (|>) empty--null :: OMap k v -> Bool-null (OMap tvs _) = M.null tvs--size :: OMap k v -> Int-size (OMap tvs _) = M.size tvs--member, notMember :: Ord k => k -> OMap k v -> Bool-member    k (OMap tvs _) = M.member    k tvs-notMember k (OMap tvs _) = M.notMember k tvs--lookup :: Ord k => k -> OMap k v -> Maybe v-lookup k (OMap tvs _) = fmap snd (M.lookup k tvs)---- The Ord constraint is for compatibility with older (<0.5) versions of--- containers.--- | @filter f m@ contains exactly the key-value pairs of @m@ that satisfy @f@,--- without changing the order they appear-filter :: Ord k => (k -> v -> Bool) -> OMap k v -> OMap k v-filter f (OMap tvs kvs) = OMap (M.filterWithKey (\k (t, v) -> f k v) tvs)-                               (M.filterWithKey (\t (k, v) -> f k v) kvs)--delete :: Ord k => k -> OMap k v -> OMap k v-delete k o@(OMap tvs kvs) = case M.lookup k tvs of-	Nothing     -> o-	Just (t, _) -> OMap (M.delete k tvs) (M.delete t kvs)---- | Intersection. (The @/\\@ is intended to look a bit like the standard--- mathematical notation for set intersection.)------ See asymptotics of 'intersectionWith'.-(/\|) :: Ord k => OMap k v -> OMap k v' -> OMap k v-o /\| o' = intersectionWith (\k v' v -> v) o' o---- | Intersection. (The @/\\@ is intended to look a bit like the standard--- mathematical notation for set intersection.)------ See asymptotics of 'intersectionWith'.-(|/\) :: Ord k => OMap k v -> OMap k v' -> OMap k v-o |/\ o' = intersectionWith (\k v v' -> v) o o'---- | Take the intersection. The first 'OMap' \'s argument's indices are used for--- the result.------ /O(m*log(n\/(m+1)) + r*log(r))/ where /m/ is the size of the smaller map, /n/--- is the size of the larger map, and /r/ is the size of the result.-intersectionWith ::-	Ord k =>-	(k -> v -> v' -> v'') ->-	OMap k v -> OMap k v' -> OMap k v''-intersectionWith f (OMap tvs kvs) (OMap tvs' kvs') = fromTV-	$ M.intersectionWithKey (\k (t,v) (t',v') -> (t, f k v v')) tvs tvs'--fromTV :: Ord k => Map k (Tag, v) -> OMap k v-fromTV tvs = OMap tvs kvs where-	kvs = M.fromList [(t,(k,v)) | (k,(t,v)) <- M.toList tvs]--fromKV :: Ord k => Map Tag (k, v) -> OMap k v-fromKV kvs = OMap tvs kvs where-	tvs = M.fromList [(k,(t,v)) | (t,(k,v)) <- M.toList kvs]--findIndex :: Ord k => k -> OMap k v -> Maybe Index-findIndex k o@(OMap tvs kvs) = do-	(t, _) <- M.lookup k tvs-	M.lookupIndex t kvs--elemAt :: OMap k v -> Index -> Maybe (k, v)-elemAt o@(OMap tvs kvs) i = do-	guard (0 <= i && i < M.size kvs)-	return . snd $ M.elemAt i kvs---- | Return key-value pairs in the order they were inserted.-assocs :: OMap k v -> [(k, v)]-assocs (OMap _ kvs) = map snd $ M.toAscList kvs---- | Return key-value pairs in order of increasing key.-toAscList :: OMap k v -> [(k, v)]-toAscList (OMap tvs kvs) = map (\(k, (t, v)) -> (k, v)) $ M.toAscList tvs
+ Data/Map/Ordered/Internal.hs view
@@ -0,0 +1,250 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.Map.Ordered.Internal where++import Control.Applicative ((<|>))+import Control.Monad (guard)+import Data.Data+import Data.Foldable (Foldable, foldl', foldMap)+import Data.Function (on)+import Data.Map (Map)+import Data.Map.Util+import Data.Monoid (Monoid(..))+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup (Semigroup(..))+#endif+#if !(MIN_VERSION_base(4,8,0))+import Control.Applicative ((<$>))+import Data.Traversable+#endif+import Prelude hiding (filter, lookup, null)+import qualified Data.Map as M++data OMap k v = OMap !(Map k (Tag, v)) !(Map Tag (k, v))+	deriving (Functor, Typeable)++-- | Values are produced in insertion order, not key order.+instance Foldable (OMap k) where foldMap f (OMap _ kvs) = foldMap (f . snd) kvs+instance (       Eq   k, Eq   v) => Eq   (OMap k v) where (==)    = (==)    `on` assocs+instance (       Ord  k, Ord  v) => Ord  (OMap k v) where compare = compare `on` assocs+instance (       Show k, Show v) => Show (OMap k v) where showsPrec = showsPrecList assocs+instance (Ord k, Read k, Read v) => Read (OMap k v) where readsPrec = readsPrecList fromList++-- This instance preserves data abstraction at the cost of inefficiency.+-- We provide limited reflection services for the sake of data abstraction.+instance (Data k, Data a, Ord k) => Data (OMap k a) where+	gfoldl f z m   = z fromList `f` assocs m+	toConstr _     = fromListConstr+	gunfold k z c  = case constrIndex c of+		1 -> k (z fromList)+		_ -> error "gunfold"+	dataTypeOf _   = oMapDataType+	-- dataCast2 /must/ be eta-expanded in order to build on GHC 7.8.+	dataCast2 f    = gcast2 f++fromListConstr :: Constr+fromListConstr = mkConstr oMapDataType "fromList" [] Prefix++oMapDataType :: DataType+oMapDataType = mkDataType "Data.Map.Ordered.Map" [fromListConstr]++#if MIN_VERSION_base(4,9,0)+instance (Ord k, Semigroup v) => Semigroup (Bias L (OMap k v)) where+	Bias o <> Bias o' = Bias (unionWithL (const (<>)) o o')+instance (Ord k, Semigroup v) => Semigroup (Bias R (OMap k v)) where+	Bias o <> Bias o' = Bias (unionWithR (const (<>)) o o')+#endif++-- | Empty maps and map union. When combining two sets that share elements, the+-- indices of the left argument are preferred, and the values are combined with+-- 'mappend'.+--+-- See the asymptotics of 'unionWithL'.+instance (Ord k, Monoid v) => Monoid (Bias L (OMap k v)) where+	mempty = Bias empty+	mappend (Bias o) (Bias o') = Bias (unionWithL (const mappend) o o')++-- | Empty maps and map union. When combining two sets that share elements, the+-- indices of the right argument are preferred, and the values are combined+-- with 'mappend'.+--+-- See the asymptotics of 'unionWithR'.+instance (Ord k, Monoid v) => Monoid (Bias R (OMap k v)) where+	mempty = Bias empty+	mappend (Bias o) (Bias o') = Bias (unionWithR (const mappend) o o')++-- | Values are traversed in insertion order, not key order.+--+-- /O(n*log(n))/ where /n/ is the size of the map.+instance Ord k => Traversable (OMap k) where+	traverse f (OMap tvs kvs) = fromKV <$> traverse (\(k,v) -> (,) k <$> f v) kvs++infixr 5 <|, |< -- copy :+infixl 5 >|, |>+infixr 6 <>|, |<> -- copy <>++(<|) , (|<) :: Ord k => (,)  k v -> OMap k v -> OMap k v+(>|) , (|>) :: Ord k => OMap k v -> (,)  k v -> OMap k v++-- | When a key occurs in both maps, prefer the value from the first map.+--+-- See asymptotics of 'unionWithR'.+(<>|) :: Ord k => OMap k v -> OMap k v -> OMap k v++-- | When a key occurs in both maps, prefer the value from the first map.+--+-- See asymptotics of 'unionWithL'.+(|<>) :: Ord k => OMap k v -> OMap k v -> OMap k v++(k, v) <| OMap tvs kvs = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where+	t = maybe (nextLowerTag kvs) fst (M.lookup k tvs)++(k, v) |< o = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where+	t = nextLowerTag kvs+	OMap tvs kvs = delete k o++o >| (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where+	t = nextHigherTag kvs+	OMap tvs kvs = delete k o++OMap tvs kvs |> (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where+	t = maybe (nextHigherTag kvs) fst (M.lookup k tvs)++(<>|) = unionWithR (const const)+(|<>) = unionWithL (const const)++-- | Take the union. The first 'OMap' \'s argument's indices are lower than the+-- second. If a key appears in both maps, the first argument's index takes+-- precedence, and the supplied function is used to combine the values.+--+-- /O(r*log(r))/ where /r/ is the size of the result+unionWithL :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v+unionWithL = unionWithInternal (\t t' -> t )++-- | Take the union. The first 'OMap' \'s argument's indices are lower than the+-- second. If a key appears in both maps, the second argument's index takes+-- precedence, and the supplied function is used to combine the values.+--+-- /O(r*log(r))/ where /r/ is the size of the result+unionWithR :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v+unionWithR = unionWithInternal (\t t' -> t')++unionWithInternal :: Ord k => (Tag -> Tag -> Tag) -> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v+unionWithInternal fT fKV (OMap tvs kvs) (OMap tvs' kvs') = fromTV tvs'' where+	bump  = case maxTag kvs  of+		Nothing -> 0+		Just k  -> -k-1+	bump' = case minTag kvs' of+		Nothing -> 0+		Just k  -> -k+	tvs'' = M.unionWithKey (\k (t,v) (t',v') -> (fT t t', fKV k v v'))+		(fmap (\(t,v) -> (bump +t,v)) tvs )+		(fmap (\(t,v) -> (bump'+t,v)) tvs')++-- | @m \\\\ n@ deletes all the keys that exist in @n@ from @m@+--+-- /O(m*log(n))/ where /m/ is the size of the smaller map and /n/ is the size+-- of the larger map.+(\\) :: Ord k => OMap k v -> OMap k v' -> OMap k v+o@(OMap tvs kvs) \\ o'@(OMap tvs' kvs') = if size o < size o'+	then filter (const . (`notMember` o')) o+	else foldr delete o (fmap fst (assocs o'))++empty :: OMap k v+empty = OMap M.empty M.empty++singleton :: (k, v) -> OMap k v+singleton kv@(k, v) = OMap (M.singleton k (0, v)) (M.singleton 0 kv)++-- | If a key appears multiple times, the first occurrence is used for ordering+-- and the last occurrence is used for its value. The library author welcomes+-- comments on whether this default is sane.+fromList :: Ord k => [(k, v)] -> OMap k v+fromList = foldl' (|>) empty++null :: OMap k v -> Bool+null (OMap tvs _) = M.null tvs++size :: OMap k v -> Int+size (OMap tvs _) = M.size tvs++member, notMember :: Ord k => k -> OMap k v -> Bool+member    k (OMap tvs _) = M.member    k tvs+notMember k (OMap tvs _) = M.notMember k tvs++lookup :: Ord k => k -> OMap k v -> Maybe v+lookup k (OMap tvs _) = fmap snd (M.lookup k tvs)++-- The Ord constraint is for compatibility with older (<0.5) versions of+-- containers.+-- | @filter f m@ contains exactly the key-value pairs of @m@ that satisfy @f@,+-- without changing the order they appear+filter :: Ord k => (k -> v -> Bool) -> OMap k v -> OMap k v+filter f (OMap tvs kvs) = OMap (M.filterWithKey (\k (t, v) -> f k v) tvs)+                               (M.filterWithKey (\t (k, v) -> f k v) kvs)++delete :: Ord k => k -> OMap k v -> OMap k v+delete k o@(OMap tvs kvs) = case M.lookup k tvs of+	Nothing     -> o+	Just (t, _) -> OMap (M.delete k tvs) (M.delete t kvs)++-- | Intersection. (The @/\\@ is intended to look a bit like the standard+-- mathematical notation for set intersection.)+--+-- See asymptotics of 'intersectionWith'.+(/\|) :: Ord k => OMap k v -> OMap k v' -> OMap k v+o /\| o' = intersectionWith (\k v' v -> v) o' o++-- | Intersection. (The @/\\@ is intended to look a bit like the standard+-- mathematical notation for set intersection.)+--+-- See asymptotics of 'intersectionWith'.+(|/\) :: Ord k => OMap k v -> OMap k v' -> OMap k v+o |/\ o' = intersectionWith (\k v v' -> v) o o'++-- | Take the intersection. The first 'OMap' \'s argument's indices are used for+-- the result.+--+-- /O(m*log(n\/(m+1)) + r*log(r))/ where /m/ is the size of the smaller map, /n/+-- is the size of the larger map, and /r/ is the size of the result.+intersectionWith ::+	Ord k =>+	(k -> v -> v' -> v'') ->+	OMap k v -> OMap k v' -> OMap k v''+intersectionWith f (OMap tvs kvs) (OMap tvs' kvs') = fromTV+	$ M.intersectionWithKey (\k (t,v) (t',v') -> (t, f k v v')) tvs tvs'++fromTV :: Ord k => Map k (Tag, v) -> OMap k v+fromTV tvs = OMap tvs kvs where+	kvs = M.fromList [(t,(k,v)) | (k,(t,v)) <- M.toList tvs]++fromKV :: Ord k => Map Tag (k, v) -> OMap k v+fromKV kvs = OMap tvs kvs where+	tvs = M.fromList [(k,(t,v)) | (t,(k,v)) <- M.toList kvs]++findIndex :: Ord k => k -> OMap k v -> Maybe Index+findIndex k o@(OMap tvs kvs) = do+	(t, _) <- M.lookup k tvs+	M.lookupIndex t kvs++elemAt :: OMap k v -> Index -> Maybe (k, v)+elemAt o@(OMap tvs kvs) i = do+	guard (0 <= i && i < M.size kvs)+	return . snd $ M.elemAt i kvs++-- | Return key-value pairs in the order they were inserted.+assocs :: OMap k v -> [(k, v)]+assocs (OMap _ kvs) = map snd $ M.toAscList kvs++-- | Return key-value pairs in order of increasing key.+toAscList :: OMap k v -> [(k, v)]+toAscList (OMap tvs kvs) = map (\(k, (t, v)) -> (k, v)) $ M.toAscList tvs++-- | Convert an 'OMap' to a 'Map'.+--+-- /O(n)/, where /n/ is the size of the 'OMap'.+toMap :: OMap k v -> Map k v+toMap (OMap tvs _) = fmap snd tvs
+ Data/Map/Ordered/Strict.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}++-- | An 'OMap' behaves much like a 'M.Map', with mostly the same asymptotics, but+-- also remembers the order that keys were inserted. All operations whose+-- asymptotics are worse than 'M.Map' have documentation saying so.+module Data.Map.Ordered.Strict+	( OMap+	-- * Trivial maps+	, empty, singleton+	-- * Insertion+	-- | Conventions:+	--+	-- * The open side of an angle bracket points to an 'OMap'+	--+	-- * The pipe appears on the side whose indices take precedence if both sides contain the same key+	--+	-- * The left argument's indices are lower than the right argument's indices+	--+	-- * If both sides contain the same key, the tuple's value wins+	, (<|), (|<), (>|), (|>)+	, (<>|), (|<>), unionWithL, unionWithR+	, Bias(Bias, unbiased), L, R+	-- * Deletion+	, delete, filter, (\\)+	, (|/\), (/\|), intersectionWith+	-- * Query+	, null, size, member, notMember, lookup+	-- * Indexing+	, Index, findIndex, elemAt+	-- * List conversions+	, fromList, assocs, toAscList+	-- * 'M.Map' conversion+	, toMap+	) where++import Data.Foldable (foldl')+import qualified Data.Map.Strict as M+import Data.Map.Ordered.Internal+	( OMap(..), empty, (<>|), (|<>), delete, filter, (\\), (|/\), (/\|), null, size+	, member, notMember, lookup, findIndex, elemAt, assocs, toAscList, fromTV, toMap )+import Data.Map.Util+import Prelude hiding (filter, lookup, null)++infixr 5 <|, |< -- copy :+infixl 5 >|, |>++(<|) , (|<) :: Ord k => (,)  k v -> OMap k v -> OMap k v+(>|) , (|>) :: Ord k => OMap k v -> (,)  k v -> OMap k v++(k, v) <| OMap tvs kvs = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where+	t = maybe (nextLowerTag kvs) fst (M.lookup k tvs)++(k, v) |< o = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where+	t = nextLowerTag kvs+	OMap tvs kvs = delete k o++o >| (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where+	t = nextHigherTag kvs+	OMap tvs kvs = delete k o++OMap tvs kvs |> (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where+	t = maybe (nextHigherTag kvs) fst (M.lookup k tvs)++-- | Take the union. The first 'OMap' \'s argument's indices are lower than the+-- second. If a key appears in both maps, the first argument's index takes+-- precedence, and the supplied function is used to combine the values.+--+-- /O(r*log(r))/ where /r/ is the size of the result+unionWithL :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v+unionWithL = unionWithInternal (\t t' -> t )++-- | Take the union. The first 'OMap' \'s argument's indices are lower than the+-- second. If a key appears in both maps, the second argument's index takes+-- precedence, and the supplied function is used to combine the values.+--+-- /O(r*log(r))/ where /r/ is the size of the result+unionWithR :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v+unionWithR = unionWithInternal (\t t' -> t')++unionWithInternal :: Ord k => (Tag -> Tag -> Tag) -> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v+unionWithInternal fT fKV (OMap tvs kvs) (OMap tvs' kvs') = fromTV tvs'' where+	bump  = case maxTag kvs  of+		Nothing -> 0+		Just k  -> -k-1+	bump' = case minTag kvs' of+		Nothing -> 0+		Just k  -> -k+	tvs'' = M.unionWithKey (\k (t,v) (t',v') -> (fT t t', fKV k v v'))+		(fmap (\(t,v) -> (bump +t,v)) tvs )+		(fmap (\(t,v) -> (bump'+t,v)) tvs')++singleton :: (k, v) -> OMap k v+singleton kv@(k, v) = OMap (M.singleton k (0, v)) (M.singleton 0 kv)++-- | If a key appears multiple times, the first occurrence is used for ordering+-- and the last occurrence is used for its value. The library author welcomes+-- comments on whether this default is sane.+fromList :: Ord k => [(k, v)] -> OMap k v+fromList = foldl' (|>) empty++-- | Take the intersection. The first 'OMap' \'s argument's indices are used for+-- the result.+--+-- /O(m*log(n\/(m+1)) + r*log(r))/ where /m/ is the size of the smaller map, /n/+-- is the size of the larger map, and /r/ is the size of the result.+intersectionWith ::+	Ord k =>+	(k -> v -> v' -> v'') ->+	OMap k v -> OMap k v' -> OMap k v''+intersectionWith f (OMap tvs kvs) (OMap tvs' kvs') = fromTV+	$ M.intersectionWithKey (\k (t,v) (t',v') -> (t, f k v v')) tvs tvs'
Data/Map/Util.hs view
@@ -1,12 +1,23 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE KindSignatures #-}  module Data.Map.Util where +import Data.Data (Data, Typeable) import Data.Map (Map) import Data.Monoid -- so that the docs for Monoid link to the right place import qualified Data.Map as M +#if !(MIN_VERSION_base(4,8,0))+import Data.Foldable (Foldable)+import Data.Traversable (Traversable)+#endif+ -- | An internal index used to track ordering only -- its magnitude doesn't -- matter. If you manage to see this documentation, the library author has made -- a mistake!@@ -38,6 +49,8 @@ -- tells whether 'mappend' will prefer the indices of its first or second -- argument if there are shared elements in both. newtype Bias (dir :: IndexPreference) a = Bias { unbiased :: a }+	deriving (Data, Eq, Foldable, Functor, Ord, Read, Show, Traversable, Typeable) data IndexPreference = L | R+	deriving Typeable type L = 'L type R = 'R
Data/Set/Ordered.hs view
@@ -28,6 +28,8 @@ 	, Index, findIndex, elemAt 	-- * List conversions 	, fromList, toAscList+	-- * 'Set' conversion+	, toSet 	) where  import Control.Monad (guard)@@ -216,3 +218,9 @@ -- insertion order.) toAscList :: OSet a -> [a] toAscList o@(OSet ts _) = fmap fst (M.toAscList ts)++-- | Convert an 'OSet' to a 'Set'.+--+-- /O(n)/, where /n/ is the size of the 'OSet'.+toSet :: OSet a -> Set a+toSet (OSet ts _) = M.keysSet ts
ordered-containers.cabal view
@@ -1,5 +1,5 @@ name:                ordered-containers-version:             0.2.1+version:             0.2.2 synopsis:            Set- and Map-like types that remember the order elements were inserted license:             BSD3 license-file:        LICENSE@@ -15,8 +15,8 @@   location:            https://github.com/dmwit/ordered-containers  library-  exposed-modules:     Data.Map.Ordered, Data.Set.Ordered-  other-modules:       Data.Map.Util+  exposed-modules:     Data.Map.Ordered, Data.Map.Ordered.Strict, Data.Set.Ordered+  other-modules:       Data.Map.Ordered.Internal, Data.Map.Util   build-depends:       base >=4.7 && <5, containers >=0.1 && <0.7   default-language:    Haskell98   ghc-options:         -fno-warn-tabs