From 75b6a57f20cc3a0cc4e488cbd39fcfc1cdeff9af Mon Sep 17 00:00:00 2001 From: Veronika Romashkina Date: Mon, 9 Jul 2018 12:59:32 +0800 Subject: [PATCH] [#6] Add README, refresh docs, refactor, add hlint (#18) * [#6] Add README, refresh docs, refactor, add hlint * Fix after review --- .hlint.yaml | 6 ++++ README.md | 27 +++++++++++++++- benchmark/CacheMap.hs | 6 +++- benchmark/OptimalVector.hs | 6 +++- benchmark/Vector.hs | 6 +++- internal/Data/TypeRep/CacheMap.hs | 45 +++++++++++++++++--------- internal/Data/TypeRep/OptimalVector.hs | 9 ++---- internal/Data/TypeRep/Vector.hs | 1 - src/Data/TypeRep/Map.hs | 2 ++ test/Test/TypeRep/CacheMap.hs | 4 +-- test/Test/TypeRep/Vector.hs | 25 +------------- test/Test/TypeRep/VectorOpt.hs | 25 +------------- 12 files changed, 86 insertions(+), 76 deletions(-) create mode 100644 .hlint.yaml diff --git a/.hlint.yaml b/.hlint.yaml new file mode 100644 index 0000000..fcd3b1c --- /dev/null +++ b/.hlint.yaml @@ -0,0 +1,6 @@ +- ignore: {name: "Use camelCase"} + +- arguments: + - -XTypeApplications + +- warn: {name: "Use explicit module export list"} diff --git a/README.md b/README.md index 6611f80..a93da22 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,30 @@ # typerep-map [![Hackage](https://img.shields.io/hackage/v/typerep-map.svg)](https://hackage.haskell.org/package/typerep-map) -[![Build status](https://secure.travis-ci.org/vrom911/typerep-map.svg)](https://travis-ci.org/vrom911/typerep-map) +[![Build status](https://secure.travis-ci.org/kowainik/typerep-map.svg)](https://travis-ci.org/kowainik/typerep-map) +[![Stackage LTS](http://stackage.org/package/typerep-map/badge/lts)](http://stackage.org/lts/package/typerep-map) +[![Stackage Nightly](http://stackage.org/package/typerep-map/badge/nightly)](http://stackage.org/nightly/package/typerep-map) [![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](https://github.com/vrom911/typerep-map/blob/master/LICENSE) + +`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> size typeRepMap +2 + +ghci> let res = lookup typeRepMap + +ghci> res :: Maybe (Identity Int) +Just (Identity 42) + +ghci> res :: Maybe (Identity Bool) +Just (Identity True) + +ghci> res :: Maybe (Identity String) +Nothing + +ghci> lookup (insert (Identity "hello") typeRepMap) :: Maybe (Identity String) +Just (Identity "hello") +``` diff --git a/benchmark/CacheMap.hs b/benchmark/CacheMap.hs index 0a24d5b..299b146 100644 --- a/benchmark/CacheMap.hs +++ b/benchmark/CacheMap.hs @@ -46,7 +46,11 @@ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp) bigMap :: TypeRepMap (Proxy :: Nat -> *) bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) [] -buildBigMap :: forall a . (KnownNat a) => Int -> Proxy (a :: Nat) -> [TF (Proxy :: Nat -> *)] -> [TF (Proxy :: Nat -> *)] +buildBigMap :: forall a . (KnownNat a) + => Int + -> Proxy (a :: Nat) + -> [TF (Proxy :: Nat -> *)] + -> [TF (Proxy :: Nat -> *)] buildBigMap 1 x = (TF x :) buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1)) diff --git a/benchmark/OptimalVector.hs b/benchmark/OptimalVector.hs index 220f607..901e700 100644 --- a/benchmark/OptimalVector.hs +++ b/benchmark/OptimalVector.hs @@ -47,7 +47,11 @@ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp) bigMap :: TypeRepMap (Proxy :: Nat -> *) bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) [] -buildBigMap :: forall a . (KnownNat a) => Int -> Proxy (a :: Nat) -> [TF (Proxy :: Nat -> *)] -> [TF (Proxy :: Nat -> *)] +buildBigMap :: forall a . (KnownNat a) + => Int + -> Proxy (a :: Nat) + -> [TF (Proxy :: Nat -> *)] + -> [TF (Proxy :: Nat -> *)] buildBigMap 1 x = (TF x :) buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1)) diff --git a/benchmark/Vector.hs b/benchmark/Vector.hs index c29500e..20334cd 100644 --- a/benchmark/Vector.hs +++ b/benchmark/Vector.hs @@ -47,7 +47,11 @@ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp) bigMap :: TypeRepVector (Proxy :: Nat -> *) bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) [] -buildBigMap :: forall a . (KnownNat a) => Int -> Proxy (a :: Nat) -> [TF (Proxy :: Nat -> *)] -> [TF (Proxy :: Nat -> *)] +buildBigMap :: forall a . (KnownNat a) + => Int + -> Proxy (a :: Nat) + -> [TF (Proxy :: Nat -> *)] + -> [TF (Proxy :: Nat -> *)] buildBigMap 1 x = (TF x :) buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1)) diff --git a/internal/Data/TypeRep/CacheMap.hs b/internal/Data/TypeRep/CacheMap.hs index cc3366b..cbcd49b 100644 --- a/internal/Data/TypeRep/CacheMap.hs +++ b/internal/Data/TypeRep/CacheMap.hs @@ -46,15 +46,18 @@ import qualified Data.IntMap.Strict as IM import qualified Data.Vector as V import qualified Data.Vector.Unboxed as Unboxed +-- | Map-like data structure that keeps types as keys. data TypeRepMap (f :: k -> Type) = TypeRepMap { fingerprintAs :: Unboxed.Vector Word64 , fingerprintBs :: Unboxed.Vector Word64 , anys :: V.Vector Any } +-- | Shows only 'Fingerprint's. instance Show (TypeRepMap f) where show = show . toFps +-- | Returnes the list of 'Fingerprint's from 'TypeRepMap'. toFps :: TypeRepMap f -> [Fingerprint] toFps TypeRepMap{..} = zipWith Fingerprint (Unboxed.toList fingerprintAs) @@ -81,12 +84,15 @@ insert x = fromListPairs . addX . toPairList addX l = pairX : filter ((/= fpX) . fst) l {-# INLINE insert #-} --- | Looks up the value at the type. --- >>> let x = lookup $ insert (11 :: Int) empty --- >>> x :: Maybe Int --- Just 11 --- >>> x :: Maybe () --- Nothing +{- | Looks up the value at the type. + +>>> let x = lookup $ insert (Identity (11 :: Int)) empty +>>> x :: Maybe (Identity Int) +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) @@ -97,6 +103,7 @@ lookup tVect = fromAny . (anys tVect V.!) -- | Returns the size of the 'TypeRepMap'. size :: TypeRepMap f -> Int size = Unboxed.length . fingerprintAs +{-# INLINE size #-} -- | Binary searched based on this article -- http://bannalia.blogspot.com/2015/06/cache-friendly-binary-search.html @@ -125,12 +132,29 @@ cachedBinarySearch (Fingerprint (W64# a) (W64# b)) fpAs fpBs = inline (go 0#) -- Functions for testing and benchmarking ---------------------------------------------------------------------------- +-- | Existential wrapper around 'Typeable' indexed by @f@ type parameter. +-- Useful for 'TypeRepMap' structure creation form list of 'TF's. data TF f where TF :: Typeable a => f a -> TF f instance Show (TF f) where show (TF tf) = show $ calcFp tf +{- | Creates 'TypeRepMap' from a list of 'TF's. + +>>> size $ fromList [TF $ Identity True, TF $ Identity 'a'] +2 + +-} +fromList :: forall f . [TF f] -> TypeRepMap f +fromList = fromListPairs . map (fp &&& an) + where + fp :: TF f -> Fingerprint + fp (TF x) = calcFp x + + an :: TF f -> Any + an (TF x) = unsafeCoerce x + fromF :: Typeable a => f a -> Proxy a fromF _ = Proxy @@ -143,15 +167,6 @@ fromListPairs kvs = TypeRepMap (Unboxed.fromList fpAs) (Unboxed.fromList fpBs) ( (fpAs, fpBs) = unzip $ map (\(Fingerprint a b) -> (a, b)) fps (fps, ans) = unzip $ fromSortedList $ sortWith fst $ nubPairs kvs -fromList :: forall f . [TF f] -> TypeRepMap f -fromList = fromListPairs . map (fp &&& an) - where - fp :: TF f -> Fingerprint - fp (TF x) = calcFp x - - an :: TF f -> Any - an (TF x) = unsafeCoerce x - nubPairs :: (Eq a) => [(a, b)] -> [(a, b)] nubPairs = nubBy ((==) `on` fst) diff --git a/internal/Data/TypeRep/OptimalVector.hs b/internal/Data/TypeRep/OptimalVector.hs index 2d09b79..7a2a93f 100644 --- a/internal/Data/TypeRep/OptimalVector.hs +++ b/internal/Data/TypeRep/OptimalVector.hs @@ -77,12 +77,9 @@ binarySearch (Fingerprint a b) fpAs fpBs = checkfpBs i = case i <# len of 0# -> Nothing - _ -> - if a /= Unboxed.unsafeIndex fpAs (I# i) - then Nothing - else if b == Unboxed.unsafeIndex fpBs (I# i) - then Just (I# i) - else checkfpBs (i +# 1#) + _ | a /= Unboxed.unsafeIndex fpAs (I# i) -> Nothing + | b == Unboxed.unsafeIndex fpBs (I# i) -> Just (I# i) + | otherwise -> checkfpBs (i +# 1#) in inline (checkfpBs (binSearchHelp (-1#) len)) where diff --git a/internal/Data/TypeRep/Vector.hs b/internal/Data/TypeRep/Vector.hs index f1358b7..63db19a 100644 --- a/internal/Data/TypeRep/Vector.hs +++ b/internal/Data/TypeRep/Vector.hs @@ -2,7 +2,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} diff --git a/src/Data/TypeRep/Map.hs b/src/Data/TypeRep/Map.hs index 5504481..f24f465 100644 --- a/src/Data/TypeRep/Map.hs +++ b/src/Data/TypeRep/Map.hs @@ -1,3 +1,5 @@ +-- | This module introduces the 'TypeRepMap' data structure and functions to work with it. + module Data.TypeRep.Map ( -- * Map type TypeRepMap (..) diff --git a/test/Test/TypeRep/CacheMap.hs b/test/Test/TypeRep/CacheMap.hs index 37ab976..743af9d 100644 --- a/test/Test/TypeRep/CacheMap.hs +++ b/test/Test/TypeRep/CacheMap.hs @@ -13,8 +13,8 @@ spec_insertLookup = do describe "Lookup Test" $ do it "returns the inserted element" $ lookup (fromList [TF $ Identity 'a']) `shouldBe` Just (Identity 'a') - -- it "returns the second inserted value of the same type" $ - -- lookup (fromList [TF (Identity 'b'), TF (Identity 'a')]) `shouldBe` Just (Identity 'b') + 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" $ diff --git a/test/Test/TypeRep/Vector.hs b/test/Test/TypeRep/Vector.hs index c63b50c..58d3957 100644 --- a/test/Test/TypeRep/Vector.hs +++ b/test/Test/TypeRep/Vector.hs @@ -10,32 +10,9 @@ import Data.TypeRep.Vector -- Simple test for 'lookup', 'insert' and 'size' functions. spec_insertLookup :: Spec -spec_insertLookup = do +spec_insertLookup = describe "Lookup Test" $ do it "returns the inserted element" $ lookup (fromList [TF (Identity 'a')]) `shouldBe` Just (Identity 'a') 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 diff --git a/test/Test/TypeRep/VectorOpt.hs b/test/Test/TypeRep/VectorOpt.hs index b360ce7..65a6fbd 100644 --- a/test/Test/TypeRep/VectorOpt.hs +++ b/test/Test/TypeRep/VectorOpt.hs @@ -10,32 +10,9 @@ import Data.TypeRep.OptimalVector (TF (..), fromList, lookup) -- Simple test for 'lookup', 'insert' and 'size' functions. spec_insertLookup :: Spec -spec_insertLookup = do +spec_insertLookup = describe "Lookup Test" $ do it "returns the inserted element" $ lookup (fromList [TF $ Identity 'a']) `shouldBe` Just (Identity 'a') 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