ordered-containers (empty) → 0.0

raw patch · 7 files changed

+355/−0 lines, 7 filesdep +basedep +containerssetup-changed

Dependencies added: base, containers

Files

• ChangeLog.md +5/−0
• Data/Map/Ordered.hs +124/−0
• Data/Map/Util.hs +31/−0
• Data/Set/Ordered.hs +138/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• ordered-containers.cabal +25/−0

@@ -0,0 +1,5 @@+# Revision history for ordered-containers++## 0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

@@ -0,0 +1,124 @@+-- | An 'OMap' behaves much like a 'Map', with all the same asymptotics, but+-- also remembers the order that keys were inserted.+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+	, (<|), (|<), (>|), (|>)+	-- * Deletion+	, delete, filter, (\\)+	-- * Query+	, null, size, member, notMember, lookup+	-- * Indexing+	, Index, findIndex, elemAt+	-- * List conversions+	, fromList, assocs, toAscList+	) where++import Control.Applicative ((<|>))+import Control.Monad (guard)+import Data.Foldable (Foldable(foldl', foldMap))+import Data.Function (on)+import Data.Map (Map)+import Data.Map.Util (Index, Tag, maxTag, minTag, nextHigherTag, nextLowerTag, readsPrecList, showsPrecList)+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))++-- | 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++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)++-- | @m \\\\ n@ deletes all the keys that exist in @n@ from @m@+(\\) :: 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 (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 _) = snd <$> M.lookup k tvs++-- | @filter f m@ contains exactly the key-value pairs of @m@ that satisfy @f@,+-- without changing the order they appear+filter :: (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)++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

@@ -0,0 +1,31 @@+module Data.Map.Util where++import Data.Map (Map)+import qualified Data.Map as M++-- | 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 = fst . fst <$> M.minViewWithKey m+maxTag m = 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)

@@ -0,0 +1,138 @@+-- | An 'OSet' behaves much like a 'Set', with all the same asymptotics, but+-- also remembers the order that values were inserted.+module Data.Set.Ordered+	( OSet+	-- * Trivial sets+	, empty, singleton+	-- * Insertion+	-- | Conventionts:+	--+	-- * 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+	, (<|), (|<), (>|), (|>)+	, (<>|), (|<>)+	-- * Query+	, null, size, member, notMember+	-- * Deletion+	, delete, filter, (\\)+	-- * Indexing+	, Index, findIndex, elemAt+	-- * List conversions+	, fromList, toAscList+	) where++import Control.Monad (guard)+import Data.Foldable (Foldable(foldl', foldMap, toList))+import Data.Function (on)+import Data.Map (Map)+import Data.Map.Util (Index, Tag, maxTag, minTag, nextHigherTag, nextLowerTag, readsPrecList, showsPrecList)+import Prelude hiding (filter, lookup, null)+import qualified Data.Map as M++data OSet a = OSet !(Map a Tag) !(Map Tag a)++-- | 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++infixr 5 <|, |<   -- copy :+infixl 5 >|, |>+infixr 6 <>|, |<> -- copy <>++(<|) , (|<)  :: Ord a =>      a -> OSet a -> OSet a+(>|) , (|>)  :: Ord a => OSet a ->      a -> OSet a+(<>|), (|<>) :: 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  = (bump +) <$> ts+	tsBumped' = (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.+(\\) :: 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'++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++filter :: (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 _) = fst <$> M.toAscList ts

@@ -0,0 +1,30 @@+Copyright (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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,25 @@+-- Initial ordered-containers.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                ordered-containers+version:             0.0+synopsis:            Set- and Map-like types that remember the order elements were inserted+-- description:         +license:             BSD3+license-file:        LICENSE+author:              Daniel Wagner+maintainer:          me@dmwit.com+-- copyright:           +category:            Data+build-type:          Simple+extra-source-files:  ChangeLog.md+cabal-version:       >=1.10++library+  exposed-modules:     Data.Map.Ordered, Data.Set.Ordered+  other-modules:       Data.Map.Util+  -- other-extensions:    +  build-depends:       base >=4 && <5, containers >=0.1 && <0.6+  -- hs-source-dirs:      +  default-language:    Haskell2010+  ghc-options:         -fno-warn-tabs