gistfile1.hs

module Main where

import Criterion.Main

import qualified Data.ByteString as S
import           Data.ByteString (ByteString)
import           Data.ByteString.Char8 (unpack)

--------------------------------------------------------------------------------
-- Apua's
--------------------------------------------------------------------------------

type Chunk = String
type Chunks = [String]
type Length = Int

toChunk :: String -> Length -> Chunks
toChunk   ""       _      = []
toChunk   s        c      = chunk : toChunk s' c where (s', chunk) = split s c

split :: String -> Length -> (String, Chunk)
split   s        0      = (s,      "")
split   ""       c      = (s',     '0':chunk) where (s', chunk) = split "" (c-1)
split   (v:w)    c      = (s',      v :chunk) where (s', chunk) = split w  (c-1)

--------------------------------------------------------------------------------
-- Banacorn's
--------------------------------------------------------------------------------

-- ByteString version
toChunkBS :: ByteString -> Length -> [ByteString]
toChunkBS xs len
    | chunkLen == len = x : toChunkBS xs' len
    | otherwise       = [x `S.append` rest]
    where   x = S.take len xs
            xs' = S.drop len xs
            chunkLen = S.length x
            rest = S.replicate (len - chunkLen) 0

--------------------------------------------------------------------------------
-- Benchmark
--------------------------------------------------------------------------------

generateFile :: Int -> IO ()
generateFile n = S.writeFile path (S.replicate size 0)
    where   size = 1000000 * n
            path = "data/" ++ show n ++ "M"

-- the benchmark harness
main :: IO ()
main = do
    bs1m <- S.readFile "data/1M"
    bs10m <- S.readFile "data/10M"
    bs100m <- S.readFile "data/100M"
    let s1m  = unpack bs1m
    let s10m  = unpack bs10m
    let s100m = unpack bs100m

    defaultMain [
            bgroup "apua"
                [   bench "1M"  $ nf (toChunk s1m) 1000
                ,   bench "10M"  $ nf (toChunk s10m) 1000
                ,   bench "100M" $ nf (toChunk s100m) 1000
                ]
        ,   bgroup "banacorn"
                [   bench "1M"  $ nf (toChunkBS bs1m) 1000
                ,   bench "10M"  $ nf (toChunkBS bs10m) 1000
                ,   bench "100M" $ nf (toChunkBS bs100m) 1000
                ]
        ]