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

kowainik · Jul 7, 2018 · 71aa479 · 71aa479
1 parent 43e8973
commit 71aa479
Show file tree

Hide file tree

Showing 3 changed files with 51 additions and 33 deletions.
diff --git a/internal/Data/TypeRep/CacheMap.hs b/internal/Data/TypeRep/CacheMap.hs
@@ -53,8 +53,21 @@ empty :: TypeRepMap f
 empty = TypeRepMap mempty mempty mempty
 
 -- | Inserts the value with its type as a key.
-insert :: forall a f . Typeable a => a -> TypeRepMap f -> TypeRepMap f
-insert = undefined
+insert :: forall a f . Typeable a => f a -> TypeRepMap f -> TypeRepMap f
+insert x = fromListPairs . addX . toPairList
+  where
+    toPairList :: TypeRepMap f -> [(Fingerprint, Any)]
+    toPairList (TypeRepMap as bs ans) = zip (zipWith Fingerprint
+                                                    (Unboxed.toList as)
+                                                    (Unboxed.toList bs))
+                                            (V.toList ans)
+
+    pairX :: (Fingerprint, Any)
+    pairX@(fpX, _) = (calcFp x, unsafeCoerce x)
+
+    addX :: [(Fingerprint, Any)] -> [(Fingerprint, Any)]
+    addX l = pairX : filter ((/= fpX) . fst) l
+{-# INLINE insert #-}
 
 -- | Looks up the value at the type.
 -- >>> let x = lookup $ insert (11 :: Int) empty
@@ -106,14 +119,20 @@ data TF f where
 fromF :: Typeable a => f a -> Proxy a
 fromF _ = Proxy
 
-fromList :: forall f . [TF f] -> TypeRepMap f
-fromList tfs = TypeRepMap (Unboxed.fromList fpAs) (Unboxed.fromList fpBs) (V.fromList ans)
+calcFp :: Typeable a => f a -> Fingerprint
+calcFp = typeRepFingerprint . typeRep . fromF
+
+fromListPairs :: [(Fingerprint, Any)] -> TypeRepMap f
+fromListPairs kvs = TypeRepMap (Unboxed.fromList fpAs) (Unboxed.fromList fpBs) (V.fromList ans)
   where
-    (fpAs, fpBs) = unzip $ fmap (\(Fingerprint a b) -> (a, b)) fps
-    (fps, ans) = unzip $ breadthFirst $ fromListToTree $ sortWith fst $ map (fp &&& an) tfs
+    (fpAs, fpBs) = unzip $ map (\(Fingerprint a b) -> (a, b)) fps
+    (fps, ans) = unzip $ breadthFirst $ fromListToTree $ sortWith fst kvs
 
+fromList :: forall f . [TF f] -> TypeRepMap f
+fromList = fromListPairs . map (fp &&& an)
+  where
     fp :: TF f -> Fingerprint
-    fp (TF x) = typeRepFingerprint $ typeRep $ fromF x
+    fp (TF x) = calcFp x
 
     an :: TF f -> Any
     an (TF x) = unsafeCoerce x

diff --git a/test/Test/TypeRep/CacheMap.hs b/test/Test/TypeRep/CacheMap.hs
@@ -3,10 +3,9 @@ module Test.TypeRep.CacheMap where
 import Prelude hiding (lookup)
 
 import Data.Functor.Identity (Identity (..))
+import Test.Tasty.Hspec (Spec, describe, it, shouldBe)
 
-import Test.Tasty.Hspec
-
-import Data.TypeRep.CacheMap (TF (..), fromList, lookup)
+import Data.TypeRep.CacheMap (TF (..), TypeRepMap, empty, fromList, insert, lookup, size)
 
 -- Simple test for 'lookup', 'insert' and 'size' functions.
 spec_insertLookup :: Spec
@@ -17,25 +16,25 @@ spec_insertLookup = do
        -- it "returns the second inserted value of the same type" $
        --     lookup (fromList [TF (Identity 'b'), TF (Identity 'a')]) `shouldBe` Just (Identity 'b')
 
---    describe "Size Test" $ do
---        it "is empty" $
---            size empty `shouldBe` 0
---        it "is of size 1 when 1 element inserted" $
---            size (insert (Identity 'a') empty) `shouldBe` 1
---        it "doesn't increase size when element of the same type is added" $
---            size (insert (Identity 'b') $ insert (Identity 'a') empty) `shouldBe` 1
---        it "returns 10 when 10 different types are inserted" $
---            size mapOf10 `shouldBe` 10
---
---
---mapOf10 :: TypeRepMap Identity
---mapOf10 = insert (Identity True)
---        $ insert (Identity [True, False])
---        $ insert (Identity $ Just True)
---        $ insert (Identity $ Just ())
---        $ insert (Identity [()])
---        $ insert (Identity ())
---        $ insert (Identity "aaa")
---        $ insert (Identity $ Just 'a')
---        $ insert (Identity 'a')
---        $ insert (Identity (11 :: Int)) empty
+    describe "Size Test" $ do
+        it "is empty" $
+            size empty `shouldBe` 0
+        it "is of size 1 when 1 element inserted" $
+            size (insert (Identity 'a') empty) `shouldBe` 1
+        it "doesn't increase size when element of the same type is added" $
+            size (insert (Identity 'b') $ insert (Identity 'a') empty) `shouldBe` 1
+        it "returns 10 when 10 different types are inserted" $
+            size mapOf10 `shouldBe` 10
+
+
+mapOf10 :: TypeRepMap Identity
+mapOf10 = insert (Identity True)
+        $ insert (Identity [True, False])
+        $ insert (Identity $ Just True)
+        $ insert (Identity $ Just ())
+        $ insert (Identity [()])
+        $ insert (Identity ())
+        $ insert (Identity "aaa")
+        $ insert (Identity $ Just 'a')
+        $ insert (Identity 'a')
+        $ insert (Identity (11 :: Int)) empty
diff --git a/typerep-map.cabal b/typerep-map.cabal
@@ -21,7 +21,7 @@ library
   exposed-modules:     Data.TypeRep.Map
   ghc-options:         -Wall
   build-depends:       base
-                     , typerep-map-internal -any
+                     , typerep-map-internal
   default-extensions:  OverloadedStrings
                        RecordWildCards
                        ScopedTypeVariables