git.iko.soy/typeable/uuid
on 07a7190 help sign in
typeable/uuid/tests/BenchByteString.hs
82 lines 2.8 kB history raw
1import Control.Applicative ((<*>))
2import Data.Functor ((<$>))
4import Data.ByteString (ByteString)
5import qualified Data.ByteString.Char8 as BC8
6import System.Random
7import Test.QuickCheck
9import Criterion
10import Criterion.Main
12import Data.UUID
14instance Arbitrary UUID where
15 arbitrary =
16 fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
18-- Testing what we do in the codebase
19fromASCIIBytes_naive :: ByteString -> Maybe UUID
20fromASCIIBytes_naive = fromString . BC8.unpack
22toASCIIBytes_naive :: UUID -> ByteString
23toASCIIBytes_naive = BC8.pack . toString
25randomUUIDs :: IO [UUID]
26randomUUIDs = sample' arbitrary
28randomCorrect :: IO [String]
29randomCorrect = map toString <$> randomUUIDs
31randomSlightlyWrong :: IO [String]
32randomSlightlyWrong = 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)
38randomVeryWrong :: IO [String]
39randomVeryWrong = sample' arbitrary
41main :: IO ()
42main = 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
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 ]