git.iko.soy/typeable/uuid
on master help sign in
add benchmarks for the ByteString functions
03598d6Francesco Mazzoli
tests/BenchByteString.hsnew file+82
compare with master
unifiedsplit
@@ -0,0 +1,82 @@
1+import Control.Applicative ((<*>))
2+import Data.Functor ((<$>))
3+
4+import Data.ByteString (ByteString)
5+import qualified Data.ByteString.Char8 as BC8
6+import System.Random
7+import Test.QuickCheck
8+
9+import Criterion
10+import Criterion.Main
11+
12+import Data.UUID
13+
14+instance Arbitrary UUID where
15+ arbitrary =
16+ fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
17+
18+-- Testing what we do in the codebase
19+fromASCIIBytes_naive :: ByteString -> Maybe UUID
20+fromASCIIBytes_naive = fromString . BC8.unpack
21+
22+toASCIIBytes_naive :: UUID -> ByteString
23+toASCIIBytes_naive = BC8.pack . toString
24+
25+randomUUIDs :: IO [UUID]
26+randomUUIDs = sample' arbitrary
27+
28+randomCorrect :: IO [String]
29+randomCorrect = map toString <$> randomUUIDs
30+
31+randomSlightlyWrong :: IO [String]
32+randomSlightlyWrong = mapM screw =<< randomCorrect
33+ where
34+ screw s = do
35+ ix <- randomRIO (0, length s - 1)
36+ return (take ix s ++ "x" ++ drop (ix + 1) s)
37+
38+randomVeryWrong :: IO [String]
39+randomVeryWrong = sample' arbitrary
40+
41+main :: IO ()
42+main = do
43+ uuids <- randomUUIDs
44+ correct <- randomCorrect
45+ let correctBytes = map BC8.pack correct
46+ slightlyWrong <- randomSlightlyWrong
47+ let slightlyWrongBytes = map BC8.pack slightlyWrong
48+ veryWrong <- randomVeryWrong
49+ let veryWrongBytes = map BC8.pack veryWrong
50+
51+ defaultMain
52+ [ bgroup "decoding"
53+ [ bcompare
54+ [ bgroup "correct"
55+ [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) correctBytes)
56+ , bench "fromString" (nf (map fromString) correct)
57+ , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) correctBytes)
58+ ]
59+ ]
60+ , bcompare
61+ [ bgroup "slightly wrong"
62+ [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) slightlyWrongBytes)
63+ , bench "fromString" (nf (map fromString) slightlyWrong)
64+ , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) slightlyWrongBytes)
65+ ]
66+ ]
67+ , bcompare
68+ [ bgroup "very wrong"
69+ [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) veryWrongBytes)
70+ , bench "fromString" (nf (map fromString) veryWrong)
71+ , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) veryWrongBytes)
72+ ]
73+ ]
74+ ]
75+ , bcompare
76+ [ bgroup "encoding"
77+ [ bench "toASCIIBytes" (nf (map toASCIIBytes) uuids)
78+ , bench "toString" (nf (map toString) uuids)
79+ , bench "toASCIIBytes_naive" (nf (map toASCIIBytes_naive) uuids)
80+ ]
81+ ]
82+ ]
uuid.cabal+12
@@ -86,3 +86,15 @@ Test-Suite testuuid
86 test-framework == 0.8.*,
86 test-framework == 0.8.*,
87 test-framework-hunit == 0.3.*,
87 test-framework-hunit == 0.3.*,
88 test-framework-quickcheck2 == 0.3.*
88 test-framework-quickcheck2 == 0.3.*
89+
90+benchmark benchbytestring
91+ type: exitcode-stdio-1.0
92+ hs-source-dirs: tests
93+ main-is: BenchByteString.hs
94+ build-depends: base >= 4 && < 5
95+ , uuid >= 1.2
96+ , bytestring >= 0.10
97+ , criterion >= 0.8
98+ , random >= 1.0
99+ , QuickCheck >= 2
100+ ghc-options: -threaded -rtsopts -Wall -O2