identifiers 0.3.1.0 → 0.4.0.0
raw patch · 8 files changed
+192/−273 lines, 8 files
Files
- bench/BenchAll.hs +0/−58
- bench/Identifiers.hs +0/−36
- bench/IdentifiersHashable.hs +36/−0
- identifiers.cabal +4/−18
- src/Data/Identifiers.hs +0/−145
- src/Data/Identifiers/Hashable.hs +145/−0
- src/Data/TrieMap.hs +0/−9
- test/TestAll.hs +7/−7
− bench/BenchAll.hs
@@ -1,58 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Main where--import Control.DeepSeq-import Criterion.Main-import Data.Binary-import Data.ByteString.Lazy (ByteString)-import Data.Identifiers- -genNames :: Int -> [String]-genNames n = map show . take n $ ([100000000..] :: [Int])--decodeI :: ByteString -> Identifiers Word32 String-decodeI = decode--fromListI :: [String] -> Identifiers Word32 String-fromListI = fromList--main :: IO ()-main = do- let setA = genNames 1000- setB = genNames 10000- setC = genNames 100000- idA = fromListI setA- idB = fromListI setB- idC = fromListI setC- encA = encode idA- encB = encode idB- encC = encode idC- defaultMain- [ bgroup "fromList"- [ setA `deepseq` bench " 1,000" $ nf fromListI setA- , setB `deepseq` bench " 10,000" $ nf fromListI setB- , setC `deepseq` bench "100,000" $ nf fromListI setC- ]- , bgroup "lookupKey"- [ idA `deepseq` bench " 1,000" $ nf (`lookupKey` 500) idA- , idB `deepseq` bench " 10,000" $ nf (`lookupKey` 5000) idB- , idC `deepseq` bench "100,000" $ nf (`lookupKey` 50000) idC- ]- , bgroup "lookupId"- [ bench " 1,000" $ nf (`lookupId` "100000500") idA- , bench " 10,000" $ nf (`lookupId` "100005000") idB- , bench "100,000" $ nf (`lookupId` "100050000") idC- ]- , bgroup "encode"- [ bench " 1,000" $ nf encode idA- , bench " 10,000" $ nf encode idB- , bench "100,000" $ nf encode idC- ]- , bgroup "decode"- [ encA `deepseq` bench " 1,000" $ nf decodeI encA- , encB `deepseq` bench " 10,000" $ nf decodeI encB- , encC `deepseq` bench "100,000" $ nf decodeI encC- ]- ]-
− bench/Identifiers.hs
@@ -1,36 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Main where--import Control.DeepSeq-import Criterion.Main-import Data.Binary-import Data.Identifiers-import Data.Text (Text, pack)- -genNames :: Int -> [Text]-genNames n = map (pack . show) . take n $ ([100000000..] :: [Int])--fromListI :: [Text] -> Identifiers Word32 Text-fromListI = fromList--main :: IO ()-main = do- let setA = genNames 2000- setB = genNames 200000- idA = fromListI setA- idB = fromListI setB- defaultMain- [ bgroup "fromList"- [ setA `deepseq` bench " 2,000" $ nf fromListI setA- , setB `deepseq` bench "200,000" $ nf fromListI setB- ]- , bgroup "lookupKey"- [ idA `deepseq` bench " 2,000" $ nf (`lookupKey` 500) idA- , idB `deepseq` bench "200,000" $ nf (`lookupKey` 50000) idB- ]- , bgroup "lookupId"- [ bench " 2,000" $ nf (`lookupId` "100000500") idA- , bench "200,000" $ nf (`lookupId` "100050000") idB- ]- ]-
+ bench/IdentifiersHashable.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.DeepSeq+import Criterion.Main+import Data.Binary+import Data.Identifiers.Hashable+import Data.Text (Text, pack)+ +genNames :: Int -> [Text]+genNames n = map (pack . show) . take n $ ([100000000..] :: [Int])++fromListI :: [Text] -> Identifiers Word32 Text+fromListI = fromList++main :: IO ()+main = do+ let setA = genNames 2000+ setB = genNames 200000+ idA = fromListI setA+ idB = fromListI setB+ defaultMain+ [ bgroup "fromList"+ [ setA `deepseq` bench " 2,000" $ nf fromListI setA+ , setB `deepseq` bench "200,000" $ nf fromListI setB+ ]+ , bgroup "lookupKey"+ [ idA `deepseq` bench " 2,000" $ nf (`lookupKey` 500) idA+ , idB `deepseq` bench "200,000" $ nf (`lookupKey` 50000) idB+ ]+ , bgroup "lookupId"+ [ bench " 2,000" $ nf (`lookupId` "100000500") idA+ , bench "200,000" $ nf (`lookupId` "100050000") idB+ ]+ ]+
identifiers.cabal view
@@ -1,5 +1,5 @@ name: identifiers-version: 0.3.1.0+version: 0.4.0.0 synopsis: Numeric identifiers for values. description: Useful for situations where repeated-storage requirements of values become too costly.@@ -16,7 +16,7 @@ location: https://github.com/awagner83/identifiers.git library- exposed-modules: Data.Identifiers Data.Identifiers.ListLike+ exposed-modules: Data.Identifiers.Hashable Data.Identifiers.ListLike other-modules: Data.TrieMap build-depends: base >=4.6 && <4.8, binary ==0.7.*,@@ -31,24 +31,10 @@ default-language: Haskell2010 ghc-options: -Wall -O2 -funbox-strict-fields -benchmark bench-builder-all- type: exitcode-stdio-1.0- hs-source-dirs: bench- main-is: BenchAll.hs- build-depends: base >=4.6 && <4.8,- criterion,- binary ==0.7.*,- cereal <0.5,- deepseq ==1.3.*,- bytestring ==0.10.*,- identifiers- default-language: Haskell2010- ghc-options: -Wall -rtsopts -with-rtsopts=-t--benchmark identifiers-generic+benchmark identifiers-hashable type: exitcode-stdio-1.0 hs-source-dirs: bench- main-is: Identifiers.hs+ main-is: IdentifiersHashable.hs build-depends: base >=4.6 && <4.8, criterion, binary ==0.7.*,
− src/Data/Identifiers.hs
@@ -1,145 +0,0 @@-module Data.Identifiers- ( Identifiers ()- - -- * Construction- , empty- , fromList- - -- * Insertion- , insert- , insertMany-- -- * Info- , size- - -- * Extraction- , toList-- -- * Lookups- , lookupId- , lookupKey- , lookupKeys- , unsafeLookupId- , unsafeLookupKey- , (!)-- -- * Properties- , prop_hasId- , prop_stableId- , prop_keyRetrieval- , prop_keyRetrievalUnsafe- , prop_idempotent-- ) where--import Control.Applicative hiding (empty)-import Control.DeepSeq-import Data.Binary-import Data.List (foldl')-import Data.Hashable-import Data.HashMap.Lazy (HashMap)-import Data.Maybe-import Data.Sequence (Seq, (|>))-import Data.Serialize (Serialize)-import qualified Data.HashMap.Lazy as H-import qualified Data.Sequence as S-import qualified Data.Serialize as C---data Identifiers i a = Identifiers { ids :: !(HashMap a i)- , names :: !(Seq a)- } deriving Eq--instance Show a => Show (Identifiers i a) where- show s = "insertMany empty " ++ show (H.keys (ids s))--instance (Binary i, Eq a, Hashable a, Binary a) => Binary (Identifiers i a) where- put s = put (H.toList $ ids s) >> put (names s)- get = Identifiers <$> (H.fromList <$> get) <*> get--instance (Serialize i, Eq a, Hashable a, Serialize a) => Serialize (Identifiers i a) where- put s = C.put (H.toList $ ids s) >> C.put (names s)- get = Identifiers <$> (H.fromList <$> C.get) <*> C.get--instance (NFData i, NFData a) => NFData (Identifiers i a) where- rnf (Identifiers i n) = rnf (i, n)---- | The empty Identifiers-empty :: Identifiers i a-empty = Identifiers H.empty S.empty---- | New Identifiers from list-fromList :: (Integral i, Hashable a, Eq a) => [a] -> Identifiers i a-fromList = insertMany empty---- | Insert item into set (given it a new id)-insert :: (Integral i, Hashable a, Eq a) => Identifiers i a -> a -> Identifiers i a-insert xs v = case H.lookup v (ids xs) of- Just _ -> xs- Nothing -> Identifiers (H.insert v next $ ids xs) (names xs |> v)- where next = fromIntegral $ S.length $ names xs---- | Insert many items into set-insertMany :: (Integral i, Hashable a, Eq a) => Identifiers i a -> [a] -> Identifiers i a-insertMany = foldl' insert---- | New List from Identifiers-toList :: Identifiers i a -> [a]-toList = H.keys . ids---- | Find id for given key-lookupId :: (Hashable a, Eq a) => Identifiers i a -> a -> Maybe i-lookupId = flip H.lookup . ids--size :: Identifiers i a -> Int-size = S.length . names--unsafeLookupId :: (Hashable a, Eq a) => Identifiers i a -> a -> i-unsafeLookupId = (H.!) . ids---- | Find key for given id-lookupKey :: (Integral i) => Identifiers i a -> i -> Maybe a-lookupKey ident x = let xs = names ident- in if S.length xs < fromIntegral x- then Nothing- else Just $ unsafeLookupKey ident x---- | Given many ids, return many keys-lookupKeys :: (Integral i) => Identifiers i a -> [i] -> [a]-lookupKeys s = mapMaybe (lookupKey s)--unsafeLookupKey :: Integral i => Identifiers i a -> i -> a-unsafeLookupKey xs x = S.index (names xs) (fromIntegral x)--(!) :: Integral i => Identifiers i a -> i -> a-(!) = unsafeLookupKey---- | Items inserted are given ids-prop_hasId :: String -> Bool-prop_hasId x = isJust . lookupId (insert (empty :: Identifiers Int String) x) $ x---- | Inserted items have stable ids-prop_stableId :: String -> Bool-prop_stableId x = isJust a && a == b- where a = lookupId firstSet x- b = lookupId secondSet x- firstSet = insert (empty :: Identifiers Int String) x- secondSet = insert firstSet x---- | Given id can be used to fetch inserted item-prop_keyRetrievalUnsafe :: [String] -> Bool-prop_keyRetrievalUnsafe xs = all (\x -> ret x == x) xs- where ret = unsafeLookupKey s . unsafeLookupId s- s = insertMany (empty :: Identifiers Int String) xs---- | Given id can be used to fetch inserted item-prop_keyRetrieval :: [String] -> Bool-prop_keyRetrieval xs = all (\x -> ret x == Just (Just x)) xs- where ret x = lookupKey s <$> lookupId s x- s = insertMany (empty :: Identifiers Int String) xs---- | Inserting something more than once does not change the set-prop_idempotent :: String -> Bool-prop_idempotent x = insert (empty :: Identifiers Int String) x- == insert (insert empty x) x-
+ src/Data/Identifiers/Hashable.hs view
@@ -0,0 +1,145 @@+module Data.Identifiers.Hashable+ ( Identifiers ()+ + -- * Construction+ , empty+ , fromList+ + -- * Insertion+ , insert+ , insertMany++ -- * Info+ , size+ + -- * Extraction+ , toList++ -- * Lookups+ , lookupId+ , lookupKey+ , lookupKeys+ , unsafeLookupId+ , unsafeLookupKey+ , (!)++ -- * Properties+ , prop_hasId+ , prop_stableId+ , prop_keyRetrieval+ , prop_keyRetrievalUnsafe+ , prop_idempotent++ ) where++import Control.Applicative hiding (empty)+import Control.DeepSeq+import Data.Binary+import Data.List (foldl')+import Data.Hashable+import Data.HashMap.Lazy (HashMap)+import Data.Maybe+import Data.Sequence (Seq, (|>))+import Data.Serialize (Serialize)+import qualified Data.HashMap.Lazy as H+import qualified Data.Sequence as S+import qualified Data.Serialize as C+++data Identifiers i a = Identifiers { ids :: !(HashMap a i)+ , names :: !(Seq a)+ } deriving Eq++instance Show a => Show (Identifiers i a) where+ show s = "insertMany empty " ++ show (H.keys (ids s))++instance (Binary i, Eq a, Hashable a, Binary a) => Binary (Identifiers i a) where+ put s = put (H.toList $ ids s) >> put (names s)+ get = Identifiers <$> (H.fromList <$> get) <*> get++instance (Serialize i, Eq a, Hashable a, Serialize a) => Serialize (Identifiers i a) where+ put s = C.put (H.toList $ ids s) >> C.put (names s)+ get = Identifiers <$> (H.fromList <$> C.get) <*> C.get++instance (NFData i, NFData a) => NFData (Identifiers i a) where+ rnf (Identifiers i n) = rnf (i, n)++-- | The empty Identifiers+empty :: Identifiers i a+empty = Identifiers H.empty S.empty++-- | New Identifiers from list+fromList :: (Integral i, Hashable a, Eq a) => [a] -> Identifiers i a+fromList = insertMany empty++-- | Insert item into set (given it a new id)+insert :: (Integral i, Hashable a, Eq a) => Identifiers i a -> a -> Identifiers i a+insert xs v = case H.lookup v (ids xs) of+ Just _ -> xs+ Nothing -> Identifiers (H.insert v next $ ids xs) (names xs |> v)+ where next = fromIntegral $ S.length $ names xs++-- | Insert many items into set+insertMany :: (Integral i, Hashable a, Eq a) => Identifiers i a -> [a] -> Identifiers i a+insertMany = foldl' insert++-- | New List from Identifiers+toList :: Identifiers i a -> [a]+toList = H.keys . ids++-- | Find id for given key+lookupId :: (Hashable a, Eq a) => Identifiers i a -> a -> Maybe i+lookupId = flip H.lookup . ids++size :: Identifiers i a -> Int+size = S.length . names++unsafeLookupId :: (Hashable a, Eq a) => Identifiers i a -> a -> i+unsafeLookupId = (H.!) . ids++-- | Find key for given id+lookupKey :: (Integral i) => Identifiers i a -> i -> Maybe a+lookupKey ident x = let xs = names ident+ in if S.length xs < fromIntegral x+ then Nothing+ else Just $ unsafeLookupKey ident x++-- | Given many ids, return many keys+lookupKeys :: (Integral i) => Identifiers i a -> [i] -> [a]+lookupKeys s = mapMaybe (lookupKey s)++unsafeLookupKey :: Integral i => Identifiers i a -> i -> a+unsafeLookupKey xs x = S.index (names xs) (fromIntegral x)++(!) :: Integral i => Identifiers i a -> i -> a+(!) = unsafeLookupKey++-- | Items inserted are given ids+prop_hasId :: String -> Bool+prop_hasId x = isJust . lookupId (insert (empty :: Identifiers Int String) x) $ x++-- | Inserted items have stable ids+prop_stableId :: String -> Bool+prop_stableId x = isJust a && a == b+ where a = lookupId firstSet x+ b = lookupId secondSet x+ firstSet = insert (empty :: Identifiers Int String) x+ secondSet = insert firstSet x++-- | Given id can be used to fetch inserted item+prop_keyRetrievalUnsafe :: [String] -> Bool+prop_keyRetrievalUnsafe xs = all (\x -> ret x == x) xs+ where ret = unsafeLookupKey s . unsafeLookupId s+ s = insertMany (empty :: Identifiers Int String) xs++-- | Given id can be used to fetch inserted item+prop_keyRetrieval :: [String] -> Bool+prop_keyRetrieval xs = all (\x -> ret x == Just (Just x)) xs+ where ret x = lookupKey s <$> lookupId s x+ s = insertMany (empty :: Identifiers Int String) xs++-- | Inserting something more than once does not change the set+prop_idempotent :: String -> Bool+prop_idempotent x = insert (empty :: Identifiers Int String) x+ == insert (insert empty x) x+
src/Data/TrieMap.hs view
@@ -13,7 +13,6 @@ data TrieNode k v = Node !k !(TrieNode k v) !(TrieNode k v) | Vertical !k !(TrieNode k v)- | Horizontal !k !(TrieNode k v) | ValueVert !k !v !(TrieNode k v) | ValueHoriz !k !v !(TrieNode k v) | ValueNode !k !v !(TrieNode k v) !(TrieNode k v)@@ -29,7 +28,6 @@ instance (NFData k, NFData v) => NFData (TrieNode k v) where rnf (Node a b c) = rnf (a, b, c) rnf (Vertical a b) = rnf (a, b)- rnf (Horizontal a b) = rnf (a, b) rnf (ValueVert a b c) = rnf (a, b, c) rnf (ValueHoriz a b c) = rnf (a, b, c) rnf (ValueNode a b c d) = rnf (a, b, c, d)@@ -70,9 +68,6 @@ lookupNode (Vertical k down) (x:xs) | null xs || x /= k = Nothing | otherwise = lookupNode down xs-lookupNode (Horizontal k right) ks@(x:_)- | x /= k = Nothing- | otherwise = lookupNode right ks lookupNode (ValueVert k v down) (x:xs) | null xs && x == k = Just v | x == k = lookupNode down xs@@ -109,10 +104,6 @@ | null xs && x == k = ValueVert k v down | x == k = Vertical k $ insertNode down xs v | otherwise = Node k down $ createNode ks v-insertNode (Horizontal k right) ks@(x:xs) v- | null xs && x == k = ValueHoriz k v right- | x == k = Node k (createNode xs v) right- | otherwise = Horizontal k $ insertNode right ks v insertNode (ValueVert k w down) ks@(x:xs) v | null xs && x == k = ValueVert k v down | x == k = ValueVert k w $ insertNode down xs v
test/TestAll.hs view
@@ -4,19 +4,19 @@ import Test.Framework (defaultMain, testGroup, Test) import Test.Framework.Providers.QuickCheck2 (testProperty) -import qualified Data.Identifiers as G+import qualified Data.Identifiers.Hashable as H import qualified Data.Identifiers.ListLike as L main :: IO () main = defaultMain tests tests :: [Test]-tests = [ testGroup "QuickCheck Data.Identifiers"- [ testProperty "hasId" G.prop_hasId- , testProperty "stableId" G.prop_stableId- , testProperty "keyRetrieval" G.prop_keyRetrieval- , testProperty "keyRetrievalUnsafe" G.prop_keyRetrievalUnsafe- , testProperty "idempotent" G.prop_idempotent+tests = [ testGroup "QuickCheck Data.Identifiers.Hashable"+ [ testProperty "hasId" H.prop_hasId+ , testProperty "stableId" H.prop_stableId+ , testProperty "keyRetrieval" H.prop_keyRetrieval+ , testProperty "keyRetrievalUnsafe" H.prop_keyRetrievalUnsafe+ , testProperty "idempotent" H.prop_idempotent ] , testGroup "QuickCheck Data.Identifiers.ListLike" [ testProperty "hasId" L.prop_hasId