encodeOctal Benchmark

encodeOctal.hs

{-# LANGUAGE BangPatterns  #-}
{-# LANGUAGE DeriveGeneric #-}
module Main where

import           Control.Monad.Catch
import           Criterion.Main
import           Data.ByteString         (ByteString)
import qualified Data.ByteString         as S
import           Data.ByteString.Builder
import           Data.Monoid
import           GHC.Generics
import           Numeric

data OverflowException = OverflowException String deriving (Show, Generic)

instance Exception OverflowException

main :: IO ()
main = defaultMain $ map (makeGroup baseInt) [7, 11]
                  ++ map (makeGroup baseInteger) [100, 1000]
  where
    baseInt = 8 :: Int
    baseInteger = 8 :: Integer
    makeGroup base size =
      bgroup
        (show size)
        [ bgroup
            "small num"
            [ bench "ByteString/unfoldrN" $
              nfIO (toLazyByteString <$> encodeOctal size base)
            , bench "Builder/monoid" $ nfIO (toLazyByteString <$> encodeOctal' size base)
            , bench "Numeric" $ nfIO (toLazyByteString <$> encodeOctal'' size base)
            ]
        , bgroup
            "big num"
            [ bench "ByteString/unfoldrN" $
              nfIO (toLazyByteString <$> encodeOctal size (base ^ size - 1))
            , bench "Builder/monoid" $
              nfIO (toLazyByteString <$> encodeOctal' size (base ^ size - 1))
            , bench "Numeric" $
              nfIO (toLazyByteString <$> encodeOctal'' size (base ^ size - 1))
            ]
        ]

encodeOctal :: (Show a, Integral a, MonadThrow m) => Int -> a -> m Builder
encodeOctal !len !val = do
    enc <- case S.unfoldrN len toOctal val of
        (valStr, Just 0) -> return valStr
        over -> throwM $ OverflowException $ "<encodeOctal>: Tar value overflow: " ++ show over
    return (byteString $ S.reverse enc)
  where
    toOctal 0 = Just (0, 0)
    toOctal x =
        let !(q, r) = x `quotRem` 8
        in Just (fromIntegral r + 48, q)


encodeOctal' :: (Show a, Integral a, MonadThrow m) => Int -> a -> m Builder
encodeOctal' !len !val = go 0 val mempty
  where
    go !n !cur !acc
      | cur == 0 =
        if n < len
          then return $ byteString (S.replicate (len - n) 48) <> acc
          else return acc
      | n < len =
        let !(q, r) = cur `quotRem` 8
        in go (n + 1) q (word8 (fromIntegral r + 48) <> acc)
      | otherwise =
        throwM $
        OverflowException $
        "<encodeOctal>: Tar value overflow (for maxLen " ++ show len ++ "): " ++ show val


encodeOctal'' :: (Show a, Integral a, MonadThrow m) => Int -> a -> m Builder
encodeOctal'' !len !val = return $ byteString (S.replicate (len - length enc) 48) <> string7 enc
  where enc = showOct val ""

Adding the short circuit to unfoldrN approach speeds it up for large zero padded numbers:

encodeOctal :: (Show a, Integral a, MonadThrow m) => Int -> a -> m Builder
encodeOctal !len !val = do
  case S.unfoldrN len toOctal val of
    (valStr, Nothing) ->
      return $ byteString (S.replicate (len - S.length valStr) 48) <> byteString (S.reverse valStr)
    (valStr, Just 0) -> return $ byteString $ S.reverse valStr
    over -> throwM $ OverflowException $ "<encodeOctal>: Tar value overflow: " ++ show over
  where
    toOctal 0 = Nothing
    toOctal x =
      let !(q, r) = x `quotRem` 8
      in Just (fromIntegral r + 48, q)