@@ -0,0 +1,97 @@
1+{-# LANGUAGE OverloadedStrings #-}
3+-- Copyright : Erik de Castro Lopo <erikd@mega-nerd.com>
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.
10+-- ghc -Wall -O3 --make readInt.hs -o readInt && ./readInt
13+import Data.ByteString (ByteString)
14+import Data.Int (Int64)
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
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
27+ S.foldl' (\x w -> x * 10 + fromIntegral w - 48) 0
30+-- Using Numeric.readDec which works on String, so the ByteString has to be
32+readDec :: ByteString -> Integer
34+ case N.readDec (B.unpack s) of
39+-- No checking for non-digits. Will overflow at 2^31 on 32 bit CPUs.
40+readIntRaw :: ByteString -> Int
42+ B.foldl' (\i c -> i * 10 + C.digitToInt c) 0
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
51+-- Three specialisations of readIntTC.
52+readInt :: ByteString -> Int
55+readInt64 :: ByteString -> Int64
58+readInteger :: ByteString -> Integer
59+readInteger = readIntTC
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 =
70+ in px == freader (B.pack $ show px)
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)
80+runCriterionTests :: ByteString -> IO ()
81+runCriterionTests number =
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
94+ putStrLn "Quickcheck tests."
96+ putStrLn "Criterion tests."
97+ runCriterionTests "1234567898765432178979128361238162386182"