[#6] Add README, refresh docs, refactor, add hlint (#18)

* [#6] Add README, refresh docs, refactor, add hlint * Fix after review
kowainik · Jul 9, 2018 · 75b6a57 · 75b6a57
1 parent e346251
commit 75b6a57
Show file tree

Hide file tree

Showing 12 changed files with 86 additions and 76 deletions.
diff --git a/.hlint.yaml 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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