[#17] Add more map-like functions (#19)

* [#17] Add more map-like functions

* Fix review comments

README.md

@@ -9,7 +9,7 @@
 `typerep-map` introduces `TypeRepMap` — data structure like [`Map`](http://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Map-Lazy.html#t:Map), but where types serve as keys, and values have the types specified in the corresponding key spots.
 
 ```haskell
-ghci> let typeRepMap = insert (Identity True) $ insert (Identity (42 :: Int)) empty
+ghci> let typeRepMap = insert (Identity True) $ one (Identity (42 :: Int))
 
 ghci> size typeRepMap
 2
@@ -27,4 +27,12 @@ Nothing
 
 ghci> lookup (insert (Identity "hello") typeRepMap) :: Maybe (Identity String)
 Just (Identity "hello")
+
+ghci> member @Int typeRepMap
+True
+
+ghci> let trMap = delete @Int typeRepMap
+
+ghci> member @Int trMap
+False
 ```

internal/Data/TypeRep/CacheMap.hs

@@ -1,10 +1,11 @@
-{-# LANGUAGE BangPatterns   #-}
-{-# LANGUAGE DataKinds      #-}
-{-# LANGUAGE GADTs          #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE MagicHash      #-}
-{-# LANGUAGE PolyKinds      #-}
-{-# LANGUAGE TypeFamilies   #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns        #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE KindSignatures      #-}
+{-# LANGUAGE MagicHash           #-}
+{-# LANGUAGE TypeInType           #-}
+{-# LANGUAGE TypeFamilies        #-}
 
 -- {-# OPTIONS_GHC -ddump-simpl -dsuppress-idinfo -dsuppress-coercions -dsuppress-type-applications -dsuppress-uniques -dsuppress-module-prefixes #-}
 
@@ -14,8 +15,11 @@ module Data.TypeRep.CacheMap
 
          -- 'TypeRepMap' interface
        , empty
+       , one
        , insert
+       , delete
        , lookup
+       , member
        , size
 
          -- * Helpful testing functions
@@ -34,7 +38,6 @@ import Data.List (nubBy)
 import Data.Maybe (fromJust)
 import Data.Proxy (Proxy (..))
 import Data.Typeable (Typeable, typeRep, typeRepFingerprint)
-import Data.Word (Word64)
 import GHC.Base (Any, Int (..), Int#, (*#), (+#), (<#))
 import GHC.Exts (inline, sortWith)
 import GHC.Fingerprint (Fingerprint (..))
@@ -57,7 +60,7 @@ data TypeRepMap (f :: k -> Type) = TypeRepMap
 instance Show (TypeRepMap f) where
     show = show . toFps
 
--- | Returnes the list of 'Fingerprint's from 'TypeRepMap'.
+-- | Returns the list of 'Fingerprint's from 'TypeRepMap'.
 toFps :: TypeRepMap f -> [Fingerprint]
 toFps TypeRepMap{..} = zipWith Fingerprint
                                (Unboxed.toList fingerprintAs)
@@ -70,20 +73,52 @@ fromAny = unsafeCoerce
 empty :: TypeRepMap f
 empty = TypeRepMap mempty mempty mempty
 
+-- | Construct a 'TypeRepMap' with a single element.
+one :: forall a f . Typeable a => f a -> TypeRepMap f
+one x = insert x empty
+{-# INLINE one #-}
+
 -- | Inserts the value with its type as a key.
 insert :: forall a f . Typeable a => f a -> TypeRepMap f -> TypeRepMap f
 insert x = fromListPairs . addX . toPairList
   where
-    toPairList :: TypeRepMap f -> [(Fingerprint, Any)]
-    toPairList trMap = zip (toFps trMap) (V.toList $ anys trMap)
-
     pairX :: (Fingerprint, Any)
     pairX@(fpX, _) = (calcFp x, unsafeCoerce x)
 
     addX :: [(Fingerprint, Any)] -> [(Fingerprint, Any)]
-    addX l = pairX : filter ((/= fpX) . fst) l
+    addX l = pairX : deleteByFst fpX l
 {-# INLINE insert #-}
 
+-- Helper type to workaround some issues with types
+type KindOf (a :: k) = k
+
+{- | Deletes value from list.
+
+>>> let trMap = delete @Bool $ insert (Identity True) $ one (Identity 'a')
+>>> size trMap
+1
+>>> member @Bool trMap
+False
+>>> member @Char trMap
+True
+-}
+delete :: forall a (f :: KindOf a -> Type) . Typeable a => TypeRepMap f -> TypeRepMap f
+delete = fromListPairs . deleteByFst (typeFp @a) . toPairList
+{-# INLINE delete #-}
+
+{- | Returns 'True' if there exist value of given type.
+
+>>> member @Char $ one (Identity 'a')
+True
+>>> member @Bool $ one (Identity 'a')
+False
+-}
+member :: forall a (f :: KindOf a -> Type) . Typeable a => TypeRepMap f -> Bool
+member trMap = case lookup @a trMap of
+    Nothing -> False
+    Just _  -> True
+{-# INLINE member #-}
+
 {- | Looks up the value at the type.
 
 >>> let x = lookup $ insert (Identity (11 :: Int)) empty
@@ -91,11 +126,10 @@ insert x = fromListPairs . addX . toPairList
 Just (Identity 11)
 >>> x :: Maybe (Identity ())
 Nothing
-
 -}
 lookup :: forall a f . Typeable a => TypeRepMap f -> Maybe (f a)
 lookup tVect = fromAny . (anys tVect V.!)
-           <$> cachedBinarySearch (typeRepFingerprint $ typeRep $ Proxy @a)
+           <$> cachedBinarySearch (typeFp @a)
                                   (fingerprintAs tVect)
                                   (fingerprintBs tVect)
 {-# INLINE lookup #-}
@@ -128,6 +162,23 @@ cachedBinarySearch (Fingerprint (W64# a) (W64# b)) fpAs fpBs = inline (go 0#)
     len = let !(I# l) = Unboxed.length fpAs in l
 {-# INLINE cachedBinarySearch #-}
 
+----------------------------------------------------------------------------
+-- Internal functions
+----------------------------------------------------------------------------
+
+typeFp :: forall a . Typeable a => Fingerprint
+typeFp = typeRepFingerprint $ typeRep $ Proxy @a
+{-# INLINE typeFp #-}
+
+toPairList :: TypeRepMap f -> [(Fingerprint, Any)]
+toPairList trMap = zip (toFps trMap) (V.toList $ anys trMap)
+
+deleteByFst :: Eq a => a -> [(a, b)] -> [(a, b)]
+deleteByFst x = filter ((/= x) . fst)
+
+nubByFst :: (Eq a) => [(a, b)] -> [(a, b)]
+nubByFst = nubBy ((==) `on` fst)
+
 ----------------------------------------------------------------------------
 -- Functions for testing and benchmarking
 ----------------------------------------------------------------------------
@@ -165,10 +216,7 @@ fromListPairs :: [(Fingerprint, Any)] -> TypeRepMap f
 fromListPairs kvs = TypeRepMap (Unboxed.fromList fpAs) (Unboxed.fromList fpBs) (V.fromList ans)
   where
     (fpAs, fpBs) = unzip $ map (\(Fingerprint a b) -> (a, b)) fps
-    (fps, ans) = unzip $ fromSortedList $ sortWith fst $ nubPairs kvs
-
-nubPairs :: (Eq a) => [(a, b)] -> [(a, b)]
-nubPairs = nubBy ((==) `on` fst)
+    (fps, ans) = unzip $ fromSortedList $ sortWith fst $ nubByFst kvs
 
 ----------------------------------------------------------------------------
 -- Tree-like conversion

src/Data/TypeRep/Map.hs

@@ -6,8 +6,11 @@ module Data.TypeRep.Map
 
          -- 'TypeRepMap' interface
        , empty
+       , one
        , insert
+       , delete
        , lookup
+       , member
        , size
 
          -- * Helpful testing functions

test/Test/TypeRep/MapProperty.hs

@@ -15,7 +15,7 @@ import Hedgehog (MonadGen, PropertyT, forAll, property, (===))
 import Test.Tasty (TestName, TestTree)
 import Test.Tasty.Hedgehog (testProperty)
 
-import Data.TypeRep.CacheMap (TF (..), TypeRepMap, fromList, insert, lookup)
+import Data.TypeRep.CacheMap (TF (..), TypeRepMap, delete, fromList, insert, lookup, member)
 
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
@@ -39,6 +39,16 @@ test_InsertInsert = prop "insert k b . insert k a == insert k b" $ do
     let b = IntProxy proxy (i + 1)
     lookup @n @IntProxy (insert b $ insert a m) === Just b
 
+test_DeleteMember :: PropertyTest
+test_DeleteMember = prop "member k . delete k == False" $ do
+    m <- forAll genMap
+    TF (proxy :: IntProxy n) <- forAll genTF
+    shouldInsert <- forAll Gen.bool
+
+    if shouldInsert then
+        member @n (delete @n $ insert proxy m) === False
+    else
+        member @n (delete @n m) === False
 
 ----------------------------------------------------------------------------
 -- Generators
@@ -47,11 +57,9 @@ test_InsertInsert = prop "insert k b . insert k a == insert k b" $ do
 data IntProxy (n :: Nat) = IntProxy (Proxy n) Int
     deriving (Show, Eq)
 
-
 genMap :: MonadGen m => m (TypeRepMap IntProxy)
 genMap = fromList <$> Gen.list (Range.linear 0 1000) genTF
 
-
 genTF :: MonadGen m => m (TF IntProxy)
 genTF = do
     randNat :: Integer <- Gen.integral (Range.linear 0 10000)

typerep-map.cabal

@@ -1,14 +1,15 @@
 name:                typerep-map
-version:             0.1.0.0
-description:         Efficient implementation of data type with types as keys
-homepage:            https://github.com/vrom911/typerep-map
-bug-reports:         https://github.com/vrom911/typerep-map/issues
+version:             1.0
+synopsis:            Efficient implementation of data type with types as keys
+description:         See README.md for more details.
+homepage:            https://github.com/kowainik/typerep-map
+bug-reports:         https://github.com/kowainik/typerep-map/issues
 license:             MIT
 license-file:        LICENSE
-author:              Veronika Romashkina
-maintainer:          vrom911@gmail.com
-copyright:           2017 Veronika Romashkina
-category:            Data Structures
+author:              Kowainik, Vladislav Zavialov
+maintainer:          xrom.xkov@gmail.com
+copyright:           2017-2018 Kowainik
+category:            Data, Data Structures, Types
 build-type:          Simple
 extra-source-files:  README.md
 cabal-version:       2.0
@@ -16,6 +17,10 @@ tested-with:         GHC == 8.0.2
                    , GHC == 8.2.2
                    , GHC == 8.4.3
 
+source-repository head
+  type:                git
+  location:            https://github.com/kowainik/typerep-map.git
+
 library
   hs-source-dirs:      src
   exposed-modules:     Data.TypeRep.Map
@@ -94,7 +99,3 @@ benchmark typerep-map-benchmark
                        TypeApplications
   if impl(ghc >= 8.2.2)
     other-modules:     DMap
-
-source-repository head
-  type:                git
-  location:            https://github.com/vrom911/typerep-map.git