bs-bench.hs

import qualified Data.ByteString.Lazy               as L
import           Data.ByteString.Builder
import           Data.Monoid
import           Data.Foldable                        (foldMap)
import           Data.List                            (intersperse)
import Criterion.Main     -- add this import to the ones above

data Cell = StringC String
          | IntC Int
          deriving( Eq, Ord, Show )

type Row   = [Cell]
type Table = [Row]

encodeUtf8CSV :: Table -> L.ByteString
encodeUtf8CSV = toLazyByteString . renderTable

encodeUtf8CSV10 :: Table -> L.ByteString
encodeUtf8CSV10 = toLazyByteString . renderTable10

renderTable :: Table -> Builder
renderTable rs = mconcat [renderRow r <> charUtf8 '\n' | r <- rs]

renderTable10 :: Table -> Builder
renderTable10 rs = mconcat [renderRow10 r <> charUtf8 '\n' | r <- rs]

-- Fast renderRow
renderRow :: Row -> Builder
renderRow []     = mempty
renderRow (c:cs) = renderCell c <> mconcat [ charUtf8 ',' <> renderCell c' | c' <- cs ]

-- Slow renderRow
renderRow10 :: Row -> Builder
renderRow10 = mconcat . intersperse (charUtf8 ',') . map renderCell

renderCell :: Cell -> Builder
renderCell (StringC cs) = renderString cs
renderCell (IntC i)   = intDec i

-- Fast renderString
renderString :: String -> Builder
renderString cs = charUtf8 '"' <> foldMap escape cs <> charUtf8 '"'
  where
    escape '\\' = charUtf8 '\\' <> charUtf8 '\\'
    escape '\"' = charUtf8 '\\' <> charUtf8 '\"'
    escape c    = charUtf8 c

----------------------------
-- Slow renderString variant

-- Slow renderString
renderString_1 :: String -> Builder
renderString_1 cs = stringUtf8 $ "\"" ++ concatMap escape cs ++ "\""
  where
    escape '\\' = "\\"
    escape '\"' = "\\\""
    escape c    = return c

encodeUtf8CSV01 :: Table -> L.ByteString
encodeUtf8CSV01 = toLazyByteString . renderTable01

encodeUtf8CSV11 :: Table -> L.ByteString
encodeUtf8CSV11 = toLazyByteString . renderTable11

renderTable01 :: Table -> Builder
renderTable01 rs = mconcat [renderRow01 r <> charUtf8 '\n' | r <- rs]

renderTable11 :: Table -> Builder
renderTable11 rs = mconcat [renderRow10 r <> charUtf8 '\n' | r <- rs]

renderRow01 :: Row -> Builder
renderRow01 []     = mempty
renderRow01 (c:cs) = renderCell_1 c <> mconcat [ charUtf8 ',' <> renderCell_1 c' | c' <- cs ]

renderRow11 :: Row -> Builder
renderRow11 = mconcat . intersperse (charUtf8 ',') . map renderCell_1

renderCell_1 :: Cell -> Builder
renderCell_1 (StringC cs) = renderString_1 cs
renderCell_1 (IntC i)   = intDec i

--------------------------

strings :: [String]
strings =  ["hello", "\"1\"", "λ-wörld"]

table :: Table
table = [map StringC strings, map IntC [-3..3]]

maxiTable :: Table
maxiTable = take 1000 $ cycle table

main :: IO ()
main = do
 -- sanity check
 -- mapM_ (\f -> print (L.length (f maxiTable)))
 --   [encodeUtf8CSV, encodeUtf8CSV10, encodeUtf8CSV01, encodeUtf8CSV11]
 defaultMain
  [ bench "original" $
      whnf (L.length . encodeUtf8CSV) maxiTable
  , bench "10" $
      whnf (L.length . encodeUtf8CSV10) maxiTable
  , bench "01" $
      whnf (L.length . encodeUtf8CSV01) maxiTable
  , bench "11" $
      whnf (L.length . encodeUtf8CSV11) maxiTable
  ]

cmd+out

$ stack ghc -- --version
The Glorious Glasgow Haskell Compilation System, version 8.0.2
$ stack ghc bs-bench.hs -- -O0 -fforce-recomp && ./bs-bench && stack ghc bs-bench.hs -- -O2 -fforce-recomp && ./bs-bench
[1 of 1] Compiling Main             ( bs-bench.hs, bs-bench.o )
Linking bs-bench ...
benchmarking original
time                 7.028 ms   (6.990 ms .. 7.066 ms)
                     1.000 R²   (0.999 R² .. 1.000 R²)
mean                 7.076 ms   (7.049 ms .. 7.128 ms)
std dev              104.9 μs   (66.22 μs .. 195.2 μs)

benchmarking 10
time                 7.393 ms   (7.324 ms .. 7.485 ms)
                     0.999 R²   (0.998 R² .. 1.000 R²)
mean                 7.414 ms   (7.379 ms .. 7.472 ms)
std dev              119.9 μs   (82.82 μs .. 192.5 μs)

benchmarking 01
time                 6.807 ms   (6.280 ms .. 7.455 ms)
                     0.951 R²   (0.919 R² .. 0.989 R²)
mean                 6.396 ms   (6.195 ms .. 6.719 ms)
std dev              729.9 μs   (470.1 μs .. 1.099 ms)
variance introduced by outliers: 66% (severely inflated)

benchmarking 11
time                 9.391 ms   (8.440 ms .. 10.34 ms)
                     0.943 R²   (0.908 R² .. 0.977 R²)
mean                 7.954 ms   (7.634 ms .. 8.513 ms)
std dev              1.123 ms   (787.3 μs .. 1.571 ms)
variance introduced by outliers: 71% (severely inflated)

[1 of 1] Compiling Main             ( bs-bench.hs, bs-bench.o )
Linking bs-bench ...
benchmarking original
time                 489.2 μs   (478.7 μs .. 504.8 μs)
                     0.994 R²   (0.990 R² .. 0.997 R²)
mean                 500.5 μs   (488.6 μs .. 521.8 μs)
std dev              48.93 μs   (28.17 μs .. 72.97 μs)
variance introduced by outliers: 75% (severely inflated)

benchmarking 10
time                 1.645 ms   (1.637 ms .. 1.654 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 1.650 ms   (1.645 ms .. 1.656 ms)
std dev              17.05 μs   (13.04 μs .. 24.59 μs)

benchmarking 01
time                 1.830 ms   (1.816 ms .. 1.842 ms)
                     0.993 R²   (0.976 R² .. 1.000 R²)
mean                 1.876 ms   (1.846 ms .. 1.975 ms)
std dev              164.0 μs   (47.76 μs .. 361.5 μs)
variance introduced by outliers: 63% (severely inflated)

benchmarking 11
time                 1.579 ms   (1.573 ms .. 1.587 ms)
                     1.000 R²   (0.999 R² .. 1.000 R²)
mean                 1.588 ms   (1.582 ms .. 1.598 ms)
std dev              24.62 μs   (15.76 μs .. 42.92 μs)