Benchmarking bytestring to hex conversion

gistfile1.hs

-- Copyright   : (c) 2012 Michael Snoyman, Simon Meier
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Simon Meier <iridcode@gmail.com>
-- Stability   : experimental
-- Portability : tested on GHC only
--
-- Benchmark hexadecimal encoding speed. Use the preview repository of the new
-- bytestring builder to test this code:
--
--    https://github.com/meiersi/bytestring-builder
--
module Main (main) where

import           Control.Monad  (forM_)
import           Data.Foldable  (foldMap)
import           Data.Monoid    (mappend)

import qualified Data.ByteString      as S
import qualified Data.ByteString.Lazy as L
import           Data.ByteString.Lazy.Builder
import           Data.ByteString.Lazy.Builder.ASCII

import           System.IO
import           System.Environment

import qualified Data.ByteString.Char8 as S8
import Data.Bits
import System.Environment (getArgs)
import qualified Numeric
import Test.QuickCheck (quickCheck)
import Test.QuickCheck.Arbitrary (Arbitrary (..))
import Criterion.Main

main :: IO ()
main = do
    args <- getArgs
    case args of
        ["test"] -> test
        [] -> bench'
        _ -> error "Usage: hex [test]"

test :: IO ()
test = quickCheck $ \bs -> simple bs == unfoldrN_MS1 bs &&
                           L.fromChunks [simple bs] == viaBuilder bs

instance Arbitrary S.ByteString where
    arbitrary = fmap S.pack arbitrary

bench' :: IO ()
bench' = defaultMain
    [ bgroup ("size " ++ show (S.length sample))
      [ bench "simple" $ whnf simple sample
      , bench "unfoldrN_MS1" $ whnf unfoldrN_MS1 sample
      , bench "byteStringHexFixed" $ whnf (L.length . viaBuilder) sample
      ]
    ]
  where
    sample = S.replicate 5000 29

viaBuilder :: S.ByteString -> L.ByteString
viaBuilder = toLazyByteString . byteStringHexFixed

simple :: S.ByteString -> S.ByteString
simple =
    S.concatMap $ \c -> S8.pack $ pad $ Numeric.showHex c []
  where
    pad [x] = ['0', x]
    pad s = s

unfoldrN_MS1 :: S.ByteString -> S.ByteString
unfoldrN_MS1 bs0 =
    fst $ S.unfoldrN (S.length bs0 * 2) go (Left bs0)
  where
    go (Left bs) =
        case S.uncons bs of
            Nothing -> Nothing
            Just (w, bs') ->
                let w1 = w `shiftR` 4
                    w2 = w .&. 15
                    c1 = toC w1
                    c2 = toC w2
                 in Just (c1, Right (c2, bs'))
    go (Right (c, bs)) = Just (c, Left bs)

    toC w
        | w < 10 = w + 48
        | otherwise = w + 87