random-access-file-0.1.0.0: benchmark/Main.hs

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad
import Control.Concurrent
import qualified Data.ByteString as B
import qualified Data.Vector as V
import Data.Vector ((!))
import System.Random
import System.Random.MWC
import System.IO
import Criterion.Main

import System.IO.RandomAccessFile

mkRandomOffsets :: Int -> (Offset, Offset) -> IO (V.Vector Offset)
mkRandomOffsets n (from, to) =
  withSystemRandom . asGenIO $ \gen -> V.fromList `fmap` replicateM n (uniformR (from, to) gen)

createFile :: FilePath -> IO ()
createFile path = do
  h <- openFile path ReadWriteMode
  B.hPut h $ B.replicate (100*1024*1024) 0
  hClose h

concurrently :: Int -> (Int -> IO ()) -> IO ()
concurrently n action = do
  vars <- replicateM n newEmptyMVar
  forM_ (zip [0..] vars) $ \(i, var) -> forkIO $ do
    action i
    putMVar var ()
  forM_ vars takeMVar

execute :: FileAccess a => AccessParams a -> FilePath -> Bool -> IO ()
execute params path doClose = do

  h <- initFile params path
  -- writeZeros h (1024*1024)
  offsets <- mkRandomOffsets (40*(500+1000)) (100, 100*900*1024)

  concurrently 40 $ \threadId -> do
      forM_ [0..499] $ \i -> do
        let offset = offsets ! (threadId*(500+1000) + i)
        writeBytes h offset "abdefgh0123456789ABCDEFGIJK"
        return ()

      forM_ [0.. 999] $ \i ->  do
        let offset = offsets ! (threadId*(500+1000) + 500 + i)
        readBytes h offset 512
        return ()

  when doClose $
    closeFile h

benchList name list benchmarks = bgroup name
  [bgroup (name ++ ":" ++ show param) [fn param | fn <- benchmarks] 
   | param <- list]

main :: IO ()
main = defaultMain [
  env (createFile "test.data") $ \_ -> bgroup "main" [
        bench "simple" $ whnfIO $ execute SimpleParams "test.data" True,
        benchList "raw" [1024, 4*1024, 16*1024] [
          \pageSize -> bench "threaded" $ whnfIO $ execute (ThreadedParams pageSize) "test.data" True,
          \pageSize -> bench "mmaped" $ whnfIO $ execute (MMapedParams pageSize False) "test.data" True
        ],
        benchList "cached" [1024, 4*1024, 16*1024] [
          \pageSize -> bench "threaded" $ whnfIO $ execute ((dfltCached (ThreadedParams pageSize)) {cachePageSize = pageSize}) "test.data" True,
          \pageSize -> bench "mmaped" $ whnfIO $ execute ((dfltCached (MMapedParams pageSize False)) {cachePageSize = pageSize}) "test.data" True
        ]
    ]
  ]