ordered-containers-0.2.3/0000755000000000000000000000000007346545000013474 5ustar0000000000000000ordered-containers-0.2.3/ChangeLog.md0000644000000000000000000000142307346545000015645 0ustar0000000000000000# 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!) ## 0.2 -- 2019-03-24 * Support many more operations: * Semigroup,Monoid,Data,Typeable for OSet * Semigroup,Monoid,Functor,Traversable,Data,Typeable for OMap * union and intersection primitives for both * Document asymptotics (when they vary from Set and Map) ## 0.1.1 -- 2018-10-31 * Metadata changes only ## 0.1.0 -- 2016-12-26 * Documentation fix * Live up to the package version boundary claims * Use enough version parts to conform to the PVP ## 0.0 -- 2016-12-23 * First version released on an unsuspecting world ordered-containers-0.2.3/Data/Map/0000755000000000000000000000000007346545000015062 5ustar0000000000000000ordered-containers-0.2.3/Data/Map/Ordered.hs0000644000000000000000000000240507346545000017003 0ustar0000000000000000{-# 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 ( 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/Update , delete, filter, (\\) , (|/\), (/\|), intersectionWith , alter -- * Query , null, size, member, notMember, lookup -- * Indexing , Index, findIndex, elemAt -- * List conversions , fromList, assocs, toAscList -- * 'M.Map' conversion , toMap ) where import qualified Data.Map as M () import Data.Map.Ordered.Internal import Data.Map.Util import Prelude hiding (filter, lookup, null) ordered-containers-0.2.3/Data/Map/Ordered/0000755000000000000000000000000007346545000016446 5ustar0000000000000000ordered-containers-0.2.3/Data/Map/Ordered/Internal.hs0000644000000000000000000002277007346545000020566 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TupleSections #-} module Data.Map.Ordered.Internal where 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 -- | Alter the value at k, or absence of. Can be used to insert delete or update -- with the same semantics as 'Map's alter alter :: Ord k => (Maybe v -> Maybe v) -> k -> OMap k v -> OMap k v alter f k om@(OMap tvs kvs) = case fst <$> M.lookup k tvs of Just t -> OMap (M.alter (fmap (t,) . f . fmap snd) k tvs) (M.alter (fmap (k,) . f . fmap snd) t kvs) Nothing -> maybe om ((om |>) . (k, )) $ f Nothingordered-containers-0.2.3/Data/Map/Ordered/Strict.hs0000644000000000000000000001025707346545000020257 0ustar0000000000000000{-# 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' ordered-containers-0.2.3/Data/Map/Util.hs0000644000000000000000000000350607346545000016337 0ustar0000000000000000{-# 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! type Tag = Int -- | A 0-based index, much like the indices used by lists' '!!' operation. All -- indices are with respect to insertion order. type Index = Int nextLowerTag, nextHigherTag :: Map Tag a -> Tag nextLowerTag = maybe 0 pred . minTag nextHigherTag = maybe 0 succ . maxTag minTag, maxTag :: Map Tag a -> Maybe Tag minTag m = fmap (fst . fst) (M.minViewWithKey m) maxTag m = fmap (fst . fst) (M.maxViewWithKey m) showsPrecList :: Show a => (b -> [a]) -> Int -> b -> ShowS showsPrecList toList d o = showParen (d > 10) $ showString "fromList " . shows (toList o) readsPrecList :: Read a => ([a] -> b) -> Int -> ReadS b readsPrecList fromList d = readParen (d > 10) $ \r -> do ("fromList", s) <- lex r (xs, t) <- reads s return (fromList xs, t) -- | A newtype to hand a 'Monoid' instance on. The phantom first parameter -- 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 ordered-containers-0.2.3/Data/Set/0000755000000000000000000000000007346545000015100 5ustar0000000000000000ordered-containers-0.2.3/Data/Set/Ordered.hs0000644000000000000000000001611307346545000017022 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} -- | An 'OSet' behaves much like a 'Set', with mostly the same asymptotics, but -- also remembers the order that values were inserted. All operations whose -- asymptotics are worse than 'Set' have documentation saying so. module Data.Set.Ordered ( OSet -- * Trivial sets , empty, singleton -- * Insertion -- | Conventions: -- -- * The open side of an angle bracket points to an 'OSet' -- -- * The pipe appears on the side whose indices take precedence for keys that appear on both sides -- -- * The left argument's indices are lower than the right argument's indices , (<|), (|<), (>|), (|>) , (<>|), (|<>) , Bias(Bias, unbiased), L, R -- * Query , null, size, member, notMember -- * Deletion , delete, filter, (\\), (|/\), (/\|) -- * Indexing , Index, findIndex, elemAt -- * List conversions , fromList, toAscList -- * 'Set' conversion , toSet ) where import Control.Monad (guard) import Data.Data import Data.Foldable (Foldable, foldl', foldMap, foldr, toList) 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 import Data.Set (Set) -- so the haddocks link to the right place import Prelude hiding (filter, foldr, lookup, null) import qualified Data.Map as M data OSet a = OSet !(Map a Tag) !(Map Tag a) deriving Typeable -- | Values appear in insertion order, not ascending order. instance Foldable OSet where foldMap f (OSet _ vs) = foldMap f vs instance Eq a => Eq (OSet a) where (==) = (==) `on` toList instance Ord a => Ord (OSet a) where compare = compare `on` toList instance Show a => Show (OSet a) where showsPrec = showsPrecList toList instance (Ord a, Read a) => Read (OSet a) 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 a, Ord a) => Data (OSet a) where gfoldl f z set = z fromList `f` toList set toConstr _ = fromListConstr gunfold k z c = case constrIndex c of 1 -> k (z fromList) _ -> error "gunfold" dataTypeOf _ = oSetDataType -- dataCast1 /must/ be eta-expanded in order to build on GHC 7.8. dataCast1 f = gcast1 f fromListConstr :: Constr fromListConstr = mkConstr oSetDataType "fromList" [] Prefix oSetDataType :: DataType oSetDataType = mkDataType "Data.Set.Ordered.Set" [fromListConstr] #if MIN_VERSION_base(4,9,0) instance Ord a => Semigroup (Bias L (OSet a)) where Bias o <> Bias o' = Bias (o |<> o') instance Ord a => Semigroup (Bias R (OSet a)) where Bias o <> Bias o' = Bias (o <>| o') #endif -- | Empty sets and set union. When combining two sets that share elements, the -- indices of the left argument are preferred. -- -- See the asymptotics of ('|<>'). instance Ord a => Monoid (Bias L (OSet a)) where mempty = Bias empty mappend (Bias o) (Bias o') = Bias (o |<> o') -- | Empty sets and set union. When combining two sets that share elements, the -- indices of the right argument are preferred. -- -- See the asymptotics of ('<>|'). instance Ord a => Monoid (Bias R (OSet a)) where mempty = Bias empty mappend (Bias o) (Bias o') = Bias (o <>| o') infixr 5 <|, |< -- copy : infixl 5 >|, |> infixr 6 <>|, |<> -- copy <> (<|) , (|<) :: Ord a => a -> OSet a -> OSet a (>|) , (|>) :: Ord a => OSet a -> a -> OSet a -- | /O(m*log(n)+n)/, where /m/ is the size of the smaller set and /n/ is the -- size of the larger set. (<>|) :: Ord a => OSet a -> OSet a -> OSet a -- | /O(m*log(n)+n)/, where /m/ is the size of the smaller set and /n/ is the -- size of the larger set. (|<>) :: Ord a => OSet a -> OSet a -> OSet a v <| o@(OSet ts vs) | v `member` o = o | otherwise = OSet (M.insert v t ts) (M.insert t v vs) where t = nextLowerTag vs v |< o = OSet (M.insert v t ts) (M.insert t v vs) where t = nextLowerTag vs OSet ts vs = delete v o o@(OSet ts vs) |> v | v `member` o = o | otherwise = OSet (M.insert v t ts) (M.insert t v vs) where t = nextHigherTag vs o >| v = OSet (M.insert v t ts) (M.insert t v vs) where t = nextHigherTag vs OSet ts vs = delete v o o <>| o' = unsafeMappend (o \\ o') o' o |<> o' = unsafeMappend o (o' \\ o) -- assumes that ts and ts' have disjoint keys unsafeMappend (OSet ts vs) (OSet ts' vs') = OSet (M.union tsBumped tsBumped') (M.union vsBumped vsBumped') where bump = case maxTag vs of Nothing -> 0 Just k -> -k-1 bump' = case minTag vs' of Nothing -> 0 Just k -> -k tsBumped = fmap (bump +) ts tsBumped' = fmap (bump'+) ts' vsBumped = (bump +) `M.mapKeysMonotonic` vs vsBumped' = (bump'+) `M.mapKeysMonotonic` vs' -- | Set difference: @r \\\\ s@ deletes all the values in @s@ from @r@. The -- order of @r@ is unchanged. -- -- /O(m*log(n))/ where /m/ is the size of the smaller set and /n/ is the size -- of the larger set. (\\) :: Ord a => OSet a -> OSet a -> OSet a o@(OSet ts vs) \\ o'@(OSet ts' vs') = if size o < size o' then filter (`notMember` o') o else foldr delete o vs' -- | Intersection. (@/\\@ is meant to look a bit like the standard mathematical -- notation for intersection.) -- -- /O(m*log(n\/(m+1)) + r*log(r))/, where /m/ is the size of the smaller set, -- /n/ the size of the larger set, and /r/ the size of the result. (|/\) :: Ord a => OSet a -> OSet a -> OSet a OSet ts vs |/\ OSet ts' vs' = OSet ts'' vs'' where ts'' = M.intersection ts ts' vs'' = M.fromList [(t, v) | (v, t) <- M.toList ts] -- | @flip ('|/\')@ -- -- See asymptotics of '|/\'. (/\|) :: Ord a => OSet a -> OSet a -> OSet a (/\|) = flip (/\|) empty :: OSet a empty = OSet M.empty M.empty member, notMember :: Ord a => a -> OSet a -> Bool member v (OSet ts _) = M.member v ts notMember v (OSet ts _) = M.notMember v ts size :: OSet a -> Int size (OSet ts _) = M.size ts -- the Ord constraint is for compatibility with older (<0.5) versions of -- containers filter :: Ord a => (a -> Bool) -> OSet a -> OSet a filter f (OSet ts vs) = OSet (M.filterWithKey (\v t -> f v) ts) (M.filterWithKey (\t v -> f v) vs) delete :: Ord a => a -> OSet a -> OSet a delete v o@(OSet ts vs) = case M.lookup v ts of Nothing -> o Just t -> OSet (M.delete v ts) (M.delete t vs) singleton :: a -> OSet a singleton v = OSet (M.singleton v 0) (M.singleton 0 v) -- | If a value occurs multiple times, only the first occurrence is used. fromList :: Ord a => [a] -> OSet a fromList = foldl' (|>) empty null :: OSet a -> Bool null (OSet ts _) = M.null ts findIndex :: Ord a => a -> OSet a -> Maybe Index findIndex v o@(OSet ts vs) = do t <- M.lookup v ts M.lookupIndex t vs elemAt :: OSet a -> Index -> Maybe a elemAt o@(OSet ts vs) i = do guard (0 <= i && i < M.size vs) return . snd $ M.elemAt i vs -- | Returns values in ascending order. (Use 'toList' to return them in -- 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-0.2.3/LICENSE0000644000000000000000000000276407346545000014512 0ustar0000000000000000Copyright (c) 2016, Daniel Wagner All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Daniel Wagner nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ordered-containers-0.2.3/Setup.hs0000644000000000000000000000005607346545000015131 0ustar0000000000000000import Distribution.Simple main = defaultMain ordered-containers-0.2.3/ordered-containers.cabal0000644000000000000000000000145207346545000020251 0ustar0000000000000000name: ordered-containers version: 0.2.3 synopsis: Set- and Map-like types that remember the order elements were inserted license: BSD3 license-file: LICENSE author: Daniel Wagner maintainer: me@dmwit.com category: Data build-type: Simple extra-source-files: ChangeLog.md cabal-version: >=1.10 source-repository head type: git location: https://github.com/dmwit/ordered-containers library 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