hemokit-0.5: bench/ConduitRollingBufferBench.hs

{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import           Criterion.Main
import           Control.Monad.Identity
import           Data.Conduit
import qualified Data.Conduit.List as CL



main :: IO ()
main = defaultMain
  [ bench "rollingBuffer"          $ nf (benchBuf rollingBuffer 1000)               [1..10000::Int]
  , bench "rollingBuffer DL"       $ nf (benchBuf rollingBufferDL 1000)             [1..10000::Int]
  , bench "last rollingBuffer"     $ nf (last . benchBuf rollingBuffer 1000)        [1..10000::Int]
  , bench "last rollingBuffer DL"  $ nf (last . benchBuf rollingBufferDL 1000)      [1..10000::Int]
  , bench "5th rollingBuffer"      $ nf (every5th . benchBuf rollingBuffer 1000)    [1..10000::Int]
  , bench "5th rollingBuffer DL"   $ nf (every5th . benchBuf rollingBufferDL 1000)  [1..10000::Int]
  ]
  where
    benchBuf bufFn bufSize inputList = runIdentity (CL.sourceList inputList $= bufFn bufSize $$ CL.consume)


every5th :: [a] -> [a]
every5th (x:_:_:_:_:xs) = x : every5th xs
every5th _              = []


-- Implemented with lists + reverse.
rollingBuffer :: (Monad m) => Int -> Conduit a m [ a ]
rollingBuffer 0 = return ()
rollingBuffer n = fillup 0 []
  where
    -- Consume until buffer is filled with n elements.
    fillup have buf
      | have < n  = await >>= maybe (return ()) (\x -> fillup (have+1) (x:buf))
      | otherwise = roll buf
    -- Then keep kicking one element out, taking a new element in, yielding the buffer each time.
    roll buf = do yield (reverse buf)
                  await >>= maybe (return ()) (\x -> roll (x : init buf))


-- Implemented with a Difference List.
rollingBufferDL :: (Monad m) => Int -> Conduit a m [ a ]
rollingBufferDL 0 = return ()
rollingBufferDL n = fillup 0 id
  where
    -- Consume until buffer is filled with n elements.
    fillup have front
      | have < n  = await >>= maybe (return ()) (\x -> fillup (have+1) (front . (x:)))
      | otherwise = roll front
    -- Then keep kicking one element out, taking a new element in, yielding the buffer each time.
    roll front = do yield (front [])
                    await >>= maybe (return ()) (\x -> roll (tail . front . (x:)))