{-# LANGUAGE Trustworthy #-}
-- |
-- Module      : Criterion.Monad
-- Copyright   : (c) 2009 Neil Brown
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- The environment in which most criterion code executes.
module Criterion.Monad
    (
      Criterion
    , withConfig
    , getGen
    ) where

import Control.Monad.Reader (asks, runReaderT)
import Control.Monad.Trans (liftIO)
import Criterion.Monad.Internal (Criterion(..), Crit(..))
import Criterion.Types hiding (measure)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import System.IO.CodePage (withCP65001)
import System.Random.MWC (GenIO, createSystemRandom)

-- | Run a 'Criterion' action with the given 'Config'.
withConfig :: Config -> Criterion a -> IO a
withConfig :: forall a. Config -> Criterion a -> IO a
withConfig Config
cfg (Criterion ReaderT Crit IO a
act) = forall a. IO a -> IO a
withCP65001 forall a b. (a -> b) -> a -> b
$ do
  IORef (Maybe (Gen RealWorld))
g <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
  forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Crit IO a
act (Config -> IORef (Maybe GenIO) -> Crit
Crit Config
cfg IORef (Maybe (Gen RealWorld))
g)

-- | Return a random number generator, creating one if necessary.
--
-- This is not currently thread-safe, but in a harmless way (we might
-- call 'createSystemRandom' more than once if multiple threads race).
getGen :: Criterion GenIO
getGen :: Criterion GenIO
getGen = forall a. (Crit -> IORef (Maybe a)) -> IO a -> Criterion a
memoise Crit -> IORef (Maybe GenIO)
gen IO GenIO
createSystemRandom

-- | Memoise the result of an 'IO' action.
--
-- This is not currently thread-safe, but hopefully in a harmless way.
-- We might call the given action more than once if multiple threads
-- race, so our caller's job is to write actions that can be run
-- multiple times safely.
memoise :: (Crit -> IORef (Maybe a)) -> IO a -> Criterion a
memoise :: forall a. (Crit -> IORef (Maybe a)) -> IO a -> Criterion a
memoise Crit -> IORef (Maybe a)
ref IO a
generate = do
  IORef (Maybe a)
r <- forall a. ReaderT Crit IO a -> Criterion a
Criterion forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Crit -> IORef (Maybe a)
ref
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Maybe a
mv <- forall a. IORef a -> IO a
readIORef IORef (Maybe a)
r
    case Maybe a
mv of
      Just a
rv -> forall (m :: * -> *) a. Monad m => a -> m a
return a
rv
      Maybe a
Nothing -> do
        a
rv <- IO a
generate
        forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe a)
r (forall a. a -> Maybe a
Just a
rv)
        forall (m :: * -> *) a. Monad m => a -> m a
return a
rv