BS -> Hex

hexbench.hs

{-# LANGUAGE OverloadedStrings #-}

module Main(main, toHexNice) where

import Control.Monad
import Criterion.Main
import Data.Bits
import Data.Monoid
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.ByteString.Base16
import Data.ByteString.Internal
import Data.ByteString.Unsafe
import Data.ByteString.Lazy.Builder.ASCII
import Data.MonoTraversable
import qualified Data.Vector as V
import Foreign

toHexNice :: BS.ByteString -> BS.ByteString
toHexNice = LBS.toStrict . toLazyByteString . ofoldMap word8HexFixed

bs :: Int -> BS.ByteString
bs n = BS.pack $ take n $ cycle [0x00..0xff]

lengths :: [ Int ]
lengths = [ 1, 16, 32, 64, 128, 256, 1024, 2048 ]

hexNib :: BS.ByteString
hexNib = "0123456789abcdef"

hex :: V.Vector Builder
hex = V.generate 256 genByte
  where
    genByte n = highNib `seq` lowNib `seq` (word8 highNib <> word8 lowNib)
      where
        highNib = BS.index hexNib (n `shiftR` 4)
        lowNib = BS.index hexNib (n .&. 0xF)

toHexNice' :: BS.ByteString -> BS.ByteString
toHexNice' = LBS.toStrict . toLazyByteString . ofoldMap ((hex V.!) . fromIntegral)

-- should only get evaluated once as it is top-level
allHex :: BS.ByteString
allHex = BS.pack $ concatMap genByte [0..255]
  where
    genByte n = [ highNib, lowNib ]
      where
        highNib = BS.index hexNib (n `shiftR` 4)
        lowNib = BS.index hexNib (n .&. 0xF)

toHexLessNice :: BS.ByteString -> BS.ByteString
toHexLessNice bs = unsafeCreate (BS.length bs * 2) $ \ptr -> do
  forM_ [0..BS.length bs - 1] $ \i -> do
    let b = fromIntegral $ unsafeIndex bs i
    poke (ptr `plusPtr` (i * 2)) (unsafeIndex allHex (b * 2))
    poke (ptr `plusPtr` (i * 2 + 1)) (unsafeIndex allHex (b * 2 + 1))

method :: String -> (BS.ByteString -> BS.ByteString) -> Benchmark
method name f = bgroup name [ bench (show n) $ nf f (bs n) | n <- lengths ]

main :: IO ()
main = defaultMain
  [ method "bos" encode
  , method "lessNice" toHexLessNice
  ]