on main help sign in
[#24] Add union and unionWith (#29)
commit979991b437e681a006072533499f2c0c5371ce03 authorDmitrii Kovanikov <kovanikov@gmail.com> dateMon 9 Jul 2018, 21:02 (8 years ago) parent9e744d8
3 files changed+32−1
internal/Data/TypeRep/CacheMap.hs+22 src/Data/TypeRep/Map.hs+2 test/Test/TypeRep/CacheMap.hs+8−1
internal/Data/TypeRep/CacheMap.hs+22
@@ -21,6 +21,8 @@ module Data.TypeRep.CacheMap
2121 , insert
2222 , delete
2323 , hoist
24+ , unionWith
25+ , union
2426 , lookup
2527 , member
2628 , size
@@ -51,6 +53,7 @@ import GHC.Word (Word64 (..))
5153import Unsafe.Coerce (unsafeCoerce)
5254
5355import qualified Data.IntMap.Strict as IM
56+import qualified Data.Map.Strict as Map
5457import qualified GHC.Exts as GHC (fromList, toList)
5558
5659-- | Map-like data structure that keeps types as keys.
@@ -123,6 +126,25 @@ Just "a"
123126-}
124127hoist :: (forall x. f x -> g x) -> TypeRepMap f -> TypeRepMap g
125128hoist f (TypeRepMap as bs ans) = TypeRepMap as bs $ mapArray' (toAny . f . fromAny) ans
129+{-# INLINE hoist #-}
130+
131+-- | The union with a combining function.
132+unionWith :: (forall x. f x -> f x -> f x) -> TypeRepMap f -> TypeRepMap f -> TypeRepMap f
133+unionWith f m1 m2 = fromListPairs
134+ $ Map.toList
135+ $ Map.unionWith combine
136+ (Map.fromList $ toPairList m1)
137+ (Map.fromList $ toPairList m2)
138+ where
139+ combine :: Any -> Any -> Any
140+ combine a b = toAny $ f (fromAny a) (fromAny b)
141+{-# INLINE unionWith #-}
142+
143+-- | The (left-biased) union of two maps. It prefers the first map when
144+-- duplicate keys are encountered, i.e. @'union' == 'unionWith' const@.
145+union :: TypeRepMap f -> TypeRepMap f -> TypeRepMap f
146+union = unionWith const
147+{-# INLINE union #-}
126148
127149{- | Returns 'True' if there exist value of given type.
128150
src/Data/TypeRep/Map.hs+2
@@ -12,6 +12,8 @@ module Data.TypeRep.Map
1212 , insert
1313 , delete
1414 , hoist
15+ , unionWith
16+ , union
1517
1618 -- * Query
1719 , lookup
test/Test/TypeRep/CacheMap.hs+8−1
@@ -5,7 +5,7 @@ import Prelude hiding (lookup)
55import Data.Functor.Identity (Identity (..))
66import Test.Tasty.Hspec (Spec, describe, it, shouldBe)
77
8−import Data.TypeRep.CacheMap (TF (..), TypeRepMap, empty, fromList, insert, lookup, size)
8+import Data.TypeRep.CacheMap (TF (..), TypeRepMap, empty, fromList, insert, lookup, size, union)
99
1010-- Simple test for 'lookup', 'insert' and 'size' functions.
1111spec_insertLookup :: Spec
@@ -26,6 +26,13 @@ spec_insertLookup = do
2626 it "returns 10 when 10 different types are inserted" $
2727 size mapOf10 `shouldBe` 10
2828
29+ describe "Union test" $ do
30+ let m = fromList [TF $ Identity 'a', TF $ Identity True] `union` fromList [TF $ Identity 'b']
31+ it "lookup works on union as expected" $ do
32+ lookup m `shouldBe` Just (Identity 'a')
33+ lookup m `shouldBe` Just (Identity True)
34+ lookup @Int m `shouldBe` Nothing
35+
2936
3037mapOf10 :: TypeRepMap Identity
3138mapOf10 = insert (Identity True)