exitcode-0.3.0.0: benchmarks/Main.hs

{-# OPTIONS_GHC -Wall -Werror #-}

module Main (main) where

import Control.Exitcode (Exitcode', mkExitFailure1', mkExitSuccess', runExitcode)
import Data.Functor.Identity (runIdentity)
import Test.Tasty.Bench (bench, bgroup, defaultMain, whnf)

n :: Int
n = 1000

bindChain :: Int -> Exitcode' () Int
bindChain depth = iterate (\acc -> acc >>= \x -> mkExitSuccess' (x + 1)) (mkExitSuccess' 0) !! depth
{-# NOINLINE bindChain #-}

failShortCircuit :: Int -> Exitcode' () Int
failShortCircuit depth = iterate (\acc -> acc >>= \x -> mkExitSuccess' (x + 1)) (mkExitFailure1' () >> mkExitSuccess' 0) !! depth
{-# NOINLINE failShortCircuit #-}

failPropagation :: Int -> Exitcode' Int Int
failPropagation depth = iterate (\acc -> acc >>= \_ -> mkExitFailure1' 0) (mkExitSuccess' 0) !! depth
{-# NOINLINE failPropagation #-}

main :: IO ()
main =
  defaultMain
    [ bgroup
        "Exitcode"
        [ bgroup
            "bind"
            [ bench "success-chain" $ whnf (runIdentity . runExitcode . bindChain) n,
              bench "fail-short-circuit" $ whnf (runIdentity . runExitcode . failShortCircuit) n,
              bench "fail-propagation" $ whnf (runIdentity . runExitcode . failPropagation) n
            ]
        ]
    ]