71aa479 · typerep-map · git.iko.soy

git.iko.soy/typerep-map

[#7] Implement insert for CachedMap (#13)

commit71aa47980689fbec3e21a61309dc327bf590ba31 authorDmitrii Kovanikov <kovanikov@gmail.com> dateSat 7 Jul 2018, 18:30 (8 years ago) parent43e8973

3 files changed+51−33

compare with main

unifiedsplit

internal/Data/TypeRep/CacheMap.hs+26−7 test/Test/TypeRep/CacheMap.hs+24−25 typerep-map.cabal+1−1

internal/Data/TypeRep/CacheMap.hs+26−7

@@ -53,8 +53,21 @@ empty :: TypeRepMap f

5353empty = TypeRepMap mempty mempty mempty

5454

5555-- | Inserts the value with its type as a key.

56−insert :: forall a f . Typeable a => a -> TypeRepMap f -> TypeRepMap f

57−insert = undefined

56+insert :: forall a f . Typeable a => f a -> TypeRepMap f -> TypeRepMap f

57+insert x = fromListPairs . addX . toPairList

58+ where

59+ toPairList :: TypeRepMap f -> [(Fingerprint, Any)]

60+ toPairList (TypeRepMap as bs ans) = zip (zipWith Fingerprint

61+ (Unboxed.toList as)

62+ (Unboxed.toList bs))

63+ (V.toList ans)

64+

65+ pairX :: (Fingerprint, Any)

66+ pairX@(fpX, _) = (calcFp x, unsafeCoerce x)

67+

68+ addX :: [(Fingerprint, Any)] -> [(Fingerprint, Any)]

69+ addX l = pairX : filter ((/= fpX) . fst) l

70+{-# INLINE insert #-}

5871

5972-- | Looks up the value at the type.

6073-- >>> let x = lookup $ insert (11 :: Int) empty

@@ -106,14 +119,20 @@ data TF f where

106119fromF :: Typeable a => f a -> Proxy a

107120fromF _ = Proxy

108121

109−fromList :: forall f . [TF f] -> TypeRepMap f

110−fromList tfs = TypeRepMap (Unboxed.fromList fpAs) (Unboxed.fromList fpBs) (V.fromList ans)

122+calcFp :: Typeable a => f a -> Fingerprint

123+calcFp = typeRepFingerprint . typeRep . fromF

124+

125+fromListPairs :: [(Fingerprint, Any)] -> TypeRepMap f

126+fromListPairs kvs = TypeRepMap (Unboxed.fromList fpAs) (Unboxed.fromList fpBs) (V.fromList ans)

111127 where

112− (fpAs, fpBs) = unzip $ fmap (\(Fingerprint a b) -> (a, b)) fps

113− (fps, ans) = unzip $ breadthFirst $ fromListToTree $ sortWith fst $ map (fp &&& an) tfs

128+ (fpAs, fpBs) = unzip $ map (\(Fingerprint a b) -> (a, b)) fps

129+ (fps, ans) = unzip $ breadthFirst $ fromListToTree $ sortWith fst kvs

114130

131+fromList :: forall f . [TF f] -> TypeRepMap f

132+fromList = fromListPairs . map (fp &&& an)

133+ where

115134 fp :: TF f -> Fingerprint

116− fp (TF x) = typeRepFingerprint $ typeRep $ fromF x

135+ fp (TF x) = calcFp x

117136

118137 an :: TF f -> Any

119138 an (TF x) = unsafeCoerce x

test/Test/TypeRep/CacheMap.hs+24−25

@@ -3,10 +3,9 @@ module Test.TypeRep.CacheMap where

33import Prelude hiding (lookup)

55import Data.Functor.Identity (Identity (..))

6+import Test.Tasty.Hspec (Spec, describe, it, shouldBe)

7−import Test.Tasty.Hspec

8−

9−import Data.TypeRep.CacheMap (TF (..), fromList, lookup)

8+import Data.TypeRep.CacheMap (TF (..), TypeRepMap, empty, fromList, insert, lookup, size)

109

1110-- Simple test for 'lookup', 'insert' and 'size' functions.

1211spec_insertLookup :: Spec

@@ -17,25 +16,25 @@ spec_insertLookup = do

1716 -- it "returns the second inserted value of the same type" $

1817 -- lookup (fromList [TF (Identity 'b'), TF (Identity 'a')]) `shouldBe` Just (Identity 'b')

1918

20−-- describe "Size Test" $ do

21−-- it "is empty" $

22−-- size empty `shouldBe` 0

23−-- it "is of size 1 when 1 element inserted" $

24−-- size (insert (Identity 'a') empty) `shouldBe` 1

25−-- it "doesn't increase size when element of the same type is added" $

26−-- size (insert (Identity 'b') $ insert (Identity 'a') empty) `shouldBe` 1

27−-- it "returns 10 when 10 different types are inserted" $

28−-- size mapOf10 `shouldBe` 10

29−--

30−--

31−--mapOf10 :: TypeRepMap Identity

32−--mapOf10 = insert (Identity True)

33−-- $ insert (Identity [True, False])

34−-- $ insert (Identity $ Just True)

35−-- $ insert (Identity $ Just ())

36−-- $ insert (Identity [()])

37−-- $ insert (Identity ())

38−-- $ insert (Identity "aaa")

39−-- $ insert (Identity $ Just 'a')

40−-- $ insert (Identity 'a')

41−-- $ insert (Identity (11 :: Int)) empty

19+ describe "Size Test" $ do

20+ it "is empty" $

21+ size empty `shouldBe` 0

22+ it "is of size 1 when 1 element inserted" $

23+ size (insert (Identity 'a') empty) `shouldBe` 1

24+ it "doesn't increase size when element of the same type is added" $

25+ size (insert (Identity 'b') $ insert (Identity 'a') empty) `shouldBe` 1

26+ it "returns 10 when 10 different types are inserted" $

27+ size mapOf10 `shouldBe` 10

28+

29+

30+mapOf10 :: TypeRepMap Identity

31+mapOf10 = insert (Identity True)

32+ $ insert (Identity [True, False])

33+ $ insert (Identity $ Just True)

34+ $ insert (Identity $ Just ())

35+ $ insert (Identity [()])

36+ $ insert (Identity ())

37+ $ insert (Identity "aaa")

38+ $ insert (Identity $ Just 'a')

39+ $ insert (Identity 'a')

40+ $ insert (Identity (11 :: Int)) empty

typerep-map.cabal+1−1

@@ -21,7 +21,7 @@ library

2121 exposed-modules: Data.TypeRep.Map

2222 ghc-options: -Wall

2323 build-depends: base

24− , typerep-map-internal -any

24+ , typerep-map-internal

2525 default-extensions: OverloadedStrings

2626 RecordWildCards

2727 ScopedTypeVariables