1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
{-# LANGUAGE OverloadedStrings #-}
module Main
( main
)
where
import qualified Scanner
import qualified Redis.Reply as Redis
import qualified Redis.Atto
import qualified Redis.Zepto
import qualified Redis.Scanner
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.Attoparsec.ByteString as Atto
import qualified Data.Attoparsec.Zepto as Zepto
import qualified Data.Serialize.Get as Cereal
import Criterion
import Criterion.Main
main :: IO ()
main = do
let smallStringInput = "+OK\r\n"
longStringInput = "+11111111111111111111111111122222222222222222222233333333333333333333333444444444444444444445555555555555555555555666666666666666666677777777777777777777888888888888888888888999999999999999999000000000000000000\r\n"
intInput = ":123\r\n"
bulkInput = "$10\r\n0123456789\r\n"
multiInput = "*3\r\n+A\r\n+B\r\n+C\r\n"
binaryInput = ByteString.pack [5, 65, 66, 67, 68, 69]
print (stringAtto smallStringInput)
print (stringScanner smallStringInput)
print (stringWordScanner smallStringInput)
print (redisByteStringReply smallStringInput)
print (redisAttoReply smallStringInput)
print (redisZeptoReply smallStringInput)
print (redisScannerReply smallStringInput)
print (redisAttoReply intInput)
print (redisZeptoReply intInput)
print (redisScannerReply intInput)
print (redisAttoReply bulkInput)
print (redisZeptoReply bulkInput)
print (redisScannerReply bulkInput)
print (redisAttoReply multiInput)
print (redisZeptoReply multiInput)
print (redisScannerReply multiInput)
defaultMain
[ bgroup "scanner"
[ bgroup "string"
[ bench "Atto" $ whnf stringAtto smallStringInput
, bench "Scanner" $ whnf stringScanner smallStringInput
, bench "WordScanner" $ whnf stringWordScanner smallStringInput
]
]
, bgroup "redis"
[ bgroup "small string"
[ bench "Atto" $ whnf redisAttoReply smallStringInput
, bench "Zepto" $ whnf redisZeptoReply smallStringInput
, bench "Scanner" $ whnf redisScannerReply smallStringInput
, bench "ByteString" $ whnf redisByteStringReply smallStringInput
]
, bgroup "long string"
[ bench "Atto" $ whnf redisAttoReply longStringInput
, bench "Zepto" $ whnf redisZeptoReply longStringInput
, bench "Scanner" $ whnf redisScannerReply longStringInput
, bench "ByteString" $ whnf redisByteStringReply longStringInput
]
, bgroup "integer"
[ bench "Atto" $ whnf redisAttoReply intInput
, bench "Zepto" $ whnf redisZeptoReply intInput
, bench "Scanner" $ whnf redisScannerReply intInput
]
, bgroup "bulk"
[ bench "Atto" $ whnf redisAttoReply bulkInput
, bench "Zepto" $ whnf redisZeptoReply bulkInput
, bench "Scanner" $ whnf redisScannerReply bulkInput
]
, bgroup "multi"
[ bench "Atto" $ whnf redisAttoReply multiInput
, bench "Zepto" $ whnf redisZeptoReply multiInput
, bench "Scanner" $ whnf redisScannerReply multiInput
]
]
, bgroup "cereal"
[ bench "Cereal" $ whnf binaryCereal binaryInput
, bench "Scanner" $ whnf binaryScanner binaryInput
]
]
{-# NOINLINE stringAtto #-}
stringAtto :: ByteString -> Either String ()
stringAtto bs = case Atto.parse (Atto.string "+OK\r\n") bs of
Atto.Done _ _ -> Right ()
Atto.Fail _ _ err -> Left err
Atto.Partial _ -> Left "Not enough input"
{-# NOINLINE stringScanner #-}
stringScanner :: ByteString -> Either String ()
stringScanner bs = case Scanner.scan (Scanner.string "+OK\r\n") bs of
Scanner.Done _ _ -> Right ()
Scanner.Fail _ err -> Left err
Scanner.More _ -> Left "Not enought input"
{-# NOINLINE stringWordScanner #-}
stringWordScanner :: ByteString -> Either String ()
stringWordScanner bs = case Scanner.scan s bs of
Scanner.Done _ _ -> Right ()
Scanner.Fail _ err -> Left err
Scanner.More _ -> Left "Not enought input"
where
s = do
Scanner.char8 '+'
Scanner.char8 'O'
Scanner.char8 'K'
Scanner.char8 '\r'
Scanner.char8 '\n'
{-# NOINLINE redisAttoReply #-}
redisAttoReply :: ByteString -> Either String Redis.Reply
redisAttoReply bs = case Atto.parse Redis.Atto.reply bs of
Atto.Done _ r -> Right r
Atto.Fail _ _ err -> Left err
Atto.Partial _ -> Left "Not enough input"
{-# NOINLINE redisZeptoReply #-}
redisZeptoReply :: ByteString -> Either String Redis.Reply
redisZeptoReply = Zepto.parse Redis.Zepto.reply
{-# NOINLINE redisScannerReply #-}
redisScannerReply :: ByteString -> Either String Redis.Reply
redisScannerReply bs = case Scanner.scan Redis.Scanner.reply bs of
Scanner.Done _ r -> Right r
Scanner.Fail _ err -> Left err
Scanner.More _ -> Left "Not enought input"
{-# NOINLINE redisByteStringReply #-}
redisByteStringReply :: ByteString -> Either String Redis.Reply
redisByteStringReply bs = case ByteString.uncons bs of
Just (c, bs') -> case c of
43 -> let (l, r) = ByteString.span (/= 13) bs'
in case ByteString.uncons r of
Just (c', bs'') -> case c' of
13 -> case ByteString.uncons bs'' of
Just (c'', _) -> case c'' of
10 -> Right (Redis.String l)
_ -> Left "Unexpected input"
Nothing -> Left "Not enough input"
_ -> Left "Unexpected input"
Nothing -> Left "Not enought input"
_ -> Left "Unknown type"
Nothing -> Left "Not enought input"
binaryScanner :: ByteString -> Either String ByteString
binaryScanner bs = case Scanner.scan p bs of
Scanner.Done _ r -> Right r
Scanner.Fail _ err -> Left err
Scanner.More _ -> Left "Not enought input"
where
p = do
n <- fromIntegral <$> Scanner.anyWord8
Scanner.take n
binaryCereal :: ByteString -> Either String ByteString
binaryCereal bs = Cereal.runGet g bs
where
g = do
n <- fromIntegral <$> Cereal.getWord8
Cereal.getBytes n
|
