@@ -0,0 +1,97 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+-- Copyright : Erik de Castro Lopo <erikd@mega-nerd.com>
4+-- License : BSD3
5+
6+-- A program to QuickCheck and benchmark a function used in the Warp web server
7+-- and elsewhere to read the Content-Length field of HTTP headers.
8+--
9+-- Compile and run as:
10+-- ghc -Wall -O3 --make readInt.hs -o readInt && ./readInt
11+
12+import Criterion.Main
13+import Data.ByteString (ByteString)
14+import Data.Int (Int64)
15+
16+import qualified Data.ByteString as S
17+import qualified Data.ByteString.Char8 as B
18+import qualified Data.Char as C
19+import qualified Numeric as N
20+import qualified Test.QuickCheck as QC
21+
22+
23+-- This is the absolute mimimal solution. It will return garbage if the
24+-- imput string contains anything other than ASCI digits.
25+readIntOrig :: ByteString -> Integer
26+readIntOrig =
27+ S.foldl' (\x w -> x * 10 + fromIntegral w - 48) 0
28+
29+
30+-- Using Numeric.readDec which works on String, so the ByteString has to be
31+-- unpacked first.
32+readDec :: ByteString -> Integer
33+readDec s =
34+ case N.readDec (B.unpack s) of
35+ [] -> 0
36+ (x, _):_ -> x
37+
38+
39+-- No checking for non-digits. Will overflow at 2^31 on 32 bit CPUs.
40+readIntRaw :: ByteString -> Int
41+readIntRaw =
42+ B.foldl' (\i c -> i * 10 + C.digitToInt c) 0
43+
44+
45+-- The best solution.
46+readIntTC :: Integral a => ByteString -> a
47+readIntTC bs = fromIntegral
48+ $ B.foldl' (\i c -> i * 10 + C.digitToInt c) 0 $ B.takeWhile C.isDigit bs
49+
50+
51+-- Three specialisations of readIntTC.
52+readInt :: ByteString -> Int
53+readInt = readIntTC
54+
55+readInt64 :: ByteString -> Int64
56+readInt64 = readIntTC
57+
58+readInteger :: ByteString -> Integer
59+readInteger = readIntTC
60+
61+-- A QuickCheck property. Test that for a number >= 0, converting it to
62+-- a string using show and then reading the value back with the function
63+-- under test returns the original value.
64+-- The functions under test only work on Natural numbers (the Conent-Length
65+-- field in a HTTP header is always >= 0) so we check the absolute value of
66+-- the value that QuickCheck generates for us.
67+prop_read_show_idempotent :: Integral a => (ByteString -> a) -> a -> Bool
68+prop_read_show_idempotent freader x =
69+ let px = abs x
70+ in px == freader (B.pack $ show px)
71+
72+
73+runQuickCheckTests :: IO ()
74+runQuickCheckTests = do
75+ QC.quickCheck (prop_read_show_idempotent readInt)
76+ QC.quickCheck (prop_read_show_idempotent readInt64)
77+ QC.quickCheck (prop_read_show_idempotent readInteger)
78+
79+
80+runCriterionTests :: ByteString -> IO ()
81+runCriterionTests number =
82+ defaultMain
83+ [ bench "readIntOrig" $ nf readIntOrig number
84+ , bench "readDec" $ nf readDec number
85+ , bench "readRaw" $ nf readIntRaw number
86+ , bench "readInt" $ nf readInt number
87+ , bench "readInt64" $ nf readInt64 number
88+ , bench "readInteger" $ nf readInteger number
89+ ]
90+
91+
92+main :: IO ()
93+main = do
94+ putStrLn "Quickcheck tests."
95+ runQuickCheckTests
96+ putStrLn "Criterion tests."
97+ runCriterionTests "1234567898765432178979128361238162386182"