{-# 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) = IO a -> IO a
forall a. IO a -> IO a
withCP65001 (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
  g <- Maybe (Gen RealWorld) -> IO (IORef (Maybe (Gen RealWorld)))
forall a. a -> IO (IORef a)
newIORef Maybe (Gen RealWorld)
forall a. Maybe a
Nothing
  runReaderT act (Crit cfg 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 = (Crit -> IORef (Maybe (Gen RealWorld)))
-> IO (Gen RealWorld) -> Criterion (Gen RealWorld)
forall a. (Crit -> IORef (Maybe a)) -> IO a -> Criterion a
memoise Crit -> IORef (Maybe (Gen RealWorld))
Crit -> IORef (Maybe GenIO)
gen IO (Gen RealWorld)
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
  r <- ReaderT Crit IO (IORef (Maybe a)) -> Criterion (IORef (Maybe a))
forall a. ReaderT Crit IO a -> Criterion a
Criterion (ReaderT Crit IO (IORef (Maybe a)) -> Criterion (IORef (Maybe a)))
-> ReaderT Crit IO (IORef (Maybe a)) -> Criterion (IORef (Maybe a))
forall a b. (a -> b) -> a -> b
$ (Crit -> IORef (Maybe a)) -> ReaderT Crit IO (IORef (Maybe a))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Crit -> IORef (Maybe a)
ref
  liftIO $ do
    mv <- readIORef r
    case mv of
      Just a
rv -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
rv
      Maybe a
Nothing -> do
        rv <- IO a
generate
        writeIORef r (Just rv)
        return rv