identifiers (empty) → 0.2.0.1
raw patch · 6 files changed
+305/−0 lines, 6 filesdep +QuickCheckdep +basedep +binarysetup-changed
Dependencies added: QuickCheck, base, binary, bytestring, containers, criterion, deepseq, hashable, identifiers, test-framework, test-framework-quickcheck2, unordered-containers
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- bench/BenchAll.hs +58/−0
- identifiers.cabal +55/−0
- src/Data/Identifiers.hs +139/−0
- test/TestAll.hs +21/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Adam Wagner++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Adam Wagner nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/BenchAll.hs view
@@ -0,0 +1,58 @@+{-# 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+ ]+ ]+
+ identifiers.cabal view
@@ -0,0 +1,55 @@+name: identifiers+version: 0.2.0.1+synopsis: Numeric identifiers for values.+description: Useful for situations where repeated-storage requirements+ of values become too costly.+license: BSD3+license-file: LICENSE+author: Adam Wagner+maintainer: awagner83@gmail.com+category: Data+build-type: Simple+cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/awagner83/identifiers.git++library+ exposed-modules: Data.Identifiers+ build-depends: base >=4.6 && <4.7,+ binary ==0.7.*,+ containers ==0.5.*,+ deepseq ==1.3.*,+ hashable ==1.2.*,+ unordered-containers ==0.2.3.*+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall++benchmark bench-builder-all+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: BenchAll.hs+ build-depends: base >=4.6 && <4.7,+ criterion,+ binary ==0.7.*,+ deepseq ==1.3.*,+ bytestring ==0.10.*,+ identifiers+ default-language: Haskell2010+ ghc-options: -Wall -rtsopts -with-rtsopts=-t+ +test-suite main+ type: exitcode-stdio-1.0+ main-is: TestAll.hs+ ghc-options: -Wall+ build-depends: base >=4.6 && <4.7,+ identifiers,+ QuickCheck ==2.6.*,+ test-framework ==0.8.*,+ test-framework-quickcheck2 ==0.3.0.*+ default-language: Haskell2010+ hs-source-dirs: test+ ghc-options: -Wall+
+ src/Data/Identifiers.hs view
@@ -0,0 +1,139 @@+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 qualified Data.HashMap.Lazy as H+import qualified Data.Sequence as S+++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 (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+
+ test/TestAll.hs view
@@ -0,0 +1,21 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Main where++import Test.Framework (defaultMain, testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Data.Identifiers++main :: IO ()+main = defaultMain tests++tests :: [Test]+tests = [ testGroup "QuickCheck PowerMap.Data.IdSet"+ [ testProperty "hasId" prop_hasId+ , testProperty "stableId" prop_stableId+ , testProperty "keyRetrieval" prop_keyRetrieval+ , testProperty "keyRetrievalUnsafe" prop_keyRetrievalUnsafe+ , testProperty "idempotent" prop_idempotent+ ]+ ]+