Haskell Benchmark

test.hs

{-# LANGUAGE BangPatterns #-}
-- https://stackoverflow.com/questions/49080119/why-is-statet-faster-in-this-example

module Main where

import Control.Applicative
import Control.Monad.State.Strict
import Criterion.Main
import Data.IORef
import System.Environment
import System.Exit

data Record = Record
    { ra :: Int
    , rb :: String
    , rc :: Int
    , rd :: Int
    } deriving (Show)

updateRecordPure :: Int -> Record -> Record
updateRecordPure 0 r = r
updateRecordPure n !r = updateRecordPure (n - 1) r { ra = ra r + 1 }

updateRecordIORef :: Int -> Record -> IO Record
updateRecordIORef n r = do
  ref <- newIORef r
  replicateM_ n $ do
    r <- readIORef ref
    writeIORef ref $ r { ra = ra r + 1 }
  readIORef ref

modifyRecordIORef :: Int -> Record -> IO Record
modifyRecordIORef n r = do
  ref <- newIORef r
  replicateM_ n . modifyIORef' ref $ \r -> r { ra = ra r + 1 }
  readIORef ref

modifyRecordStateIdentity :: Int -> Record -> Record
modifyRecordStateIdentity n r = snd $ runState op r
  where op = replicateM_ n . modify' $ \r -> r { ra = ra r + 1 }

modifyRecordStateIO :: Int -> Record -> IO Record
modifyRecordStateIO n r = snd <$> runStateT op r
  where op = replicateM_ n . modify' $ \r -> r { ra = ra r + 1 }

main = do
  (n:remaining) <- getArgs
  n <- readIO n
  withArgs remaining $ defaultMain
    [ bgroup "Pure"
        [ bench "update" $ whnf (updateRecordPure n) rec
        ]
    , bgroup "IORef record"
        [ bench "update" $ whnfIO $ updateRecordIORef n rec
        , bench "modify" $ whnfIO $ modifyRecordIORef n rec
        ]
    , bgroup "MyStateT"
        [ bench "identity" $ whnf (modifyRecordStateIO n) rec
        , bench "io" $ whnfIO $ modifyRecordStateIO n rec
        ]
    ]
  where
    rec = Record
        { ra = 0
        , rb = "string"
        , rc = 20
        , rd = 30
        }