git.iko.soy/typeable/ordered-containers
on master help sign in
more instances

Two Monoid instances each for OSet and OMap, and a Traversable instance for OMap. We used to avoid these because they had worse asymptotics than in Set and Map, but that's no barrier any more. Fixes issue #3.

commit87708b052954f8ac88fcc35f37326549b5537466 authorDaniel Wagner <me@dmwit.com> dateSun 24 Mar 2019, 21:47 (8 years ago) parentf163377
3 files changed+84−2
compare with master
unifiedsplit
Data/Map/Ordered.hs+43−1 Data/Map/Util.hs+12 Data/Set/Ordered.hs+29−1
Data/Map/Ordered.hs+43−1
@@ -1,5 +1,7 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE DeriveDataTypeable #-}
23{-# LANGUAGE DeriveFunctor #-}
4+{-# LANGUAGE FlexibleInstances #-}
35
46-- | An 'OMap' behaves much like a 'Map', with mostly the same asymptotics, but
57-- also remembers the order that keys were inserted. All operations whose
@@ -20,6 +22,7 @@ module Data.Map.Ordered
2022 -- * If both sides contain the same key, the tuple's value wins
2123 , (<|), (|<), (>|), (|>)
2224 , (<>|), (|<>), unionWithL, unionWithR
25+ , Bias(Bias, unbiased), L, R
2326 -- * Deletion
2427 , delete, filter, (\\)
2528 , (|/\), (/\|), intersectionWith
@@ -37,7 +40,11 @@ import Data.Data
3740import Data.Foldable (Foldable, foldl', foldMap)
3841import Data.Function (on)
3942import Data.Map (Map)
40−import Data.Map.Util (Index, Tag, maxTag, minTag, nextHigherTag, nextLowerTag, readsPrecList, showsPrecList)
43+import Data.Map.Util
44+import Data.Monoid
45+#if MIN_VERSION_base(4,9,0)
46+import Data.Semigroup
47+#endif
4148import Prelude hiding (filter, lookup, null)
4249import qualified Data.Map as M
4350
@@ -68,6 +75,37 @@ fromListConstr = mkConstr oMapDataType "fromList" [] Prefix
6875oMapDataType :: DataType
6976oMapDataType = mkDataType "Data.Map.Ordered.Map" [fromListConstr]
7077
78+#if MIN_VERSION_base(4,9,0)
79+instance (Ord k, Semigroup v) => Semigroup (Bias L (OMap k v)) where
80+ Bias o <> Bias o' = Bias (unionWithL (const (<>)) o o')
81+instance (Ord k, Semigroup v) => Semigroup (Bias R (OMap k v)) where
82+ Bias o <> Bias o' = Bias (unionWithR (const (<>)) o o')
83+#endif
84+
85+-- | Empty maps and map union. When combining two sets that share elements, the
86+-- indices of the left argument are preferred, and the values are combined with
87+-- 'mappend'.
88+--
89+-- See the asymptotics of 'unionWithL'.
90+instance (Ord k, Monoid v) => Monoid (Bias L (OMap k v)) where
91+ mempty = Bias empty
92+ mappend (Bias o) (Bias o') = Bias (unionWithL (const mappend) o o')
93+
94+-- | Empty maps and map union. When combining two sets that share elements, the
95+-- indices of the right argument are preferred, and the values are combined
96+-- with 'mappend'.
97+--
98+-- See the asymptotics of 'unionWithR'.
99+instance (Ord k, Monoid v) => Monoid (Bias R (OMap k v)) where
100+ mempty = Bias empty
101+ mappend (Bias o) (Bias o') = Bias (unionWithR (const mappend) o o')
102+
103+-- | Values are traversed in insertion order, not key order.
104+--
105+-- /O(n*log(n))/ where /n/ is the size of the map.
106+instance Ord k => Traversable (OMap k) where
107+ traverse f (OMap tvs kvs) = fromKV <$> traverse (\(k,v) -> (,) k <$> f v) kvs
108+
71109infixr 5 <|, |< -- copy :
72110infixl 5 >|, |>
73111infixr 6 <>|, |<> -- copy <>
@@ -207,6 +245,10 @@ fromTV :: Ord k => Map k (Tag, v) -> OMap k v
207245fromTV tvs = OMap tvs kvs where
208246 kvs = M.fromList [(t,(k,v)) | (k,(t,v)) <- M.toList tvs]
209247
248+fromKV :: Ord k => Map Tag (k, v) -> OMap k v
249+fromKV kvs = OMap tvs kvs where
250+ tvs = M.fromList [(k,(t,v)) | (t,(k,v)) <- M.toList kvs]
251+
210252findIndex :: Ord k => k -> OMap k v -> Maybe Index
211253findIndex k o@(OMap tvs kvs) = do
212254 (t, _) <- M.lookup k tvs
Data/Map/Util.hs+12
@@ -1,6 +1,10 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE KindSignatures #-}
3+
14module Data.Map.Util where
25
36import Data.Map (Map)
7+import Data.Monoid -- so that the docs for Monoid link to the right place
48import qualified Data.Map as M
59
610-- | An internal index used to track ordering only -- its magnitude doesn't
@@ -29,3 +33,11 @@ readsPrecList fromList d = readParen (d > 10) $ \r -> do
2933 ("fromList", s) <- lex r
3034 (xs, t) <- reads s
3135 return (fromList xs, t)
36+
37+-- | A newtype to hand a 'Monoid' instance on. The phantom first parameter
38+-- tells whether 'mappend' will prefer the indices of its first or second
39+-- argument if there are shared elements in both.
40+newtype Bias (dir :: IndexPreference) a = Bias { unbiased :: a }
41+data IndexPreference = L | R
42+type L = 'L
43+type R = 'R
Data/Set/Ordered.hs+29−1
@@ -1,4 +1,6 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE FlexibleInstances #-}
24
35-- | An 'OSet' behaves much like a 'Set', with mostly the same asymptotics, but
46-- also remembers the order that values were inserted. All operations whose
@@ -17,6 +19,7 @@ module Data.Set.Ordered
1719 -- * The left argument's indices are lower than the right argument's indices
1820 , (<|), (|<), (>|), (|>)
1921 , (<>|), (|<>)
22+ , Bias(Bias, unbiased), L, R
2023 -- * Query
2124 , null, size, member, notMember
2225 -- * Deletion
@@ -32,7 +35,11 @@ import Data.Data
3235import Data.Foldable (Foldable, foldl', foldMap, foldr, toList)
3336import Data.Function (on)
3437import Data.Map (Map)
35−import Data.Map.Util (Index, Tag, maxTag, minTag, nextHigherTag, nextLowerTag, readsPrecList, showsPrecList)
38+import Data.Map.Util
39+import Data.Monoid
40+#if MIN_VERSION_base(4,9,0)
41+import Data.Semigroup
42+#endif
3643import Data.Set (Set) -- so the haddocks link to the right place
3744import Prelude hiding (filter, foldr, lookup, null)
3845import qualified Data.Map as M
@@ -64,6 +71,27 @@ fromListConstr = mkConstr oSetDataType "fromList" [] Prefix
6471oSetDataType :: DataType
6572oSetDataType = mkDataType "Data.Set.Ordered.Set" [fromListConstr]
6673
74+#if MIN_VERSION_base(4,9,0)
75+instance Ord a => Semigroup (Bias L (OSet a)) where Bias o <> Bias o' = Bias (o |<> o')
76+instance Ord a => Semigroup (Bias R (OSet a)) where Bias o <> Bias o' = Bias (o <>| o')
77+#endif
78+
79+-- | Empty sets and set union. When combining two sets that share elements, the
80+-- indices of the left argument are preferred.
81+--
82+-- See the asymptotics of ('|<>').
83+instance Ord a => Monoid (Bias L (OSet a)) where
84+ mempty = Bias empty
85+ mappend (Bias o) (Bias o') = Bias (o |<> o')
86+
87+-- | Empty sets and set union. When combining two sets that share elements, the
88+-- indices of the right argument are preferred.
89+--
90+-- See the asymptotics of ('<>|').
91+instance Ord a => Monoid (Bias R (OSet a)) where
92+ mempty = Bias empty
93+ mappend (Bias o) (Bias o') = Bias (o <>| o')
94+
6795infixr 5 <|, |< -- copy :
6896infixl 5 >|, |>
6997infixr 6 <>|, |<> -- copy <>