{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

-- |
-- Module      : Criterion.Monad.Internal
-- 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.Internal
    (
      Criterion(..)
    , Crit(..)
    ) where

import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
import qualified Control.Monad.Fail as Fail (MonadFail(..))
import Control.Monad.Reader (MonadReader(..), ReaderT)
import Control.Monad.Trans (MonadIO)
import Control.Monad.Trans.Instances ()
import Criterion.Types (Config)
import Data.IORef (IORef)
import Prelude ()
import Prelude.Compat
import System.Random.MWC (GenIO)

data Crit = Crit {
    Crit -> Config
config   :: !Config
  , Crit -> IORef (Maybe GenIO)
gen      :: !(IORef (Maybe GenIO))
  }

-- | The monad in which most criterion code executes.
newtype Criterion a = Criterion {
      forall a. Criterion a -> ReaderT Crit IO a
runCriterion :: ReaderT Crit IO a
    } deriving ( forall a b. a -> Criterion b -> Criterion a
forall a b. (a -> b) -> Criterion a -> Criterion b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Criterion b -> Criterion a
$c<$ :: forall a b. a -> Criterion b -> Criterion a
fmap :: forall a b. (a -> b) -> Criterion a -> Criterion b
$cfmap :: forall a b. (a -> b) -> Criterion a -> Criterion b
Functor, Functor Criterion
forall a. a -> Criterion a
forall a b. Criterion a -> Criterion b -> Criterion a
forall a b. Criterion a -> Criterion b -> Criterion b
forall a b. Criterion (a -> b) -> Criterion a -> Criterion b
forall a b c.
(a -> b -> c) -> Criterion a -> Criterion b -> Criterion c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Criterion a -> Criterion b -> Criterion a
$c<* :: forall a b. Criterion a -> Criterion b -> Criterion a
*> :: forall a b. Criterion a -> Criterion b -> Criterion b
$c*> :: forall a b. Criterion a -> Criterion b -> Criterion b
liftA2 :: forall a b c.
(a -> b -> c) -> Criterion a -> Criterion b -> Criterion c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Criterion a -> Criterion b -> Criterion c
<*> :: forall a b. Criterion (a -> b) -> Criterion a -> Criterion b
$c<*> :: forall a b. Criterion (a -> b) -> Criterion a -> Criterion b
pure :: forall a. a -> Criterion a
$cpure :: forall a. a -> Criterion a
Applicative, Applicative Criterion
forall a. a -> Criterion a
forall a b. Criterion a -> Criterion b -> Criterion b
forall a b. Criterion a -> (a -> Criterion b) -> Criterion b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Criterion a
$creturn :: forall a. a -> Criterion a
>> :: forall a b. Criterion a -> Criterion b -> Criterion b
$c>> :: forall a b. Criterion a -> Criterion b -> Criterion b
>>= :: forall a b. Criterion a -> (a -> Criterion b) -> Criterion b
$c>>= :: forall a b. Criterion a -> (a -> Criterion b) -> Criterion b
Monad, Monad Criterion
forall a. String -> Criterion a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> Criterion a
$cfail :: forall a. String -> Criterion a
Fail.MonadFail, Monad Criterion
forall a. IO a -> Criterion a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Criterion a
$cliftIO :: forall a. IO a -> Criterion a
MonadIO
               , Monad Criterion
forall e a. Exception e => e -> Criterion a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> Criterion a
$cthrowM :: forall e a. Exception e => e -> Criterion a
MonadThrow, MonadThrow Criterion
forall e a.
Exception e =>
Criterion a -> (e -> Criterion a) -> Criterion a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
Criterion a -> (e -> Criterion a) -> Criterion a
$ccatch :: forall e a.
Exception e =>
Criterion a -> (e -> Criterion a) -> Criterion a
MonadCatch, MonadCatch Criterion
forall b.
((forall a. Criterion a -> Criterion a) -> Criterion b)
-> Criterion b
forall a b c.
Criterion a
-> (a -> ExitCase b -> Criterion c)
-> (a -> Criterion b)
-> Criterion (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
Criterion a
-> (a -> ExitCase b -> Criterion c)
-> (a -> Criterion b)
-> Criterion (b, c)
$cgeneralBracket :: forall a b c.
Criterion a
-> (a -> ExitCase b -> Criterion c)
-> (a -> Criterion b)
-> Criterion (b, c)
uninterruptibleMask :: forall b.
((forall a. Criterion a -> Criterion a) -> Criterion b)
-> Criterion b
$cuninterruptibleMask :: forall b.
((forall a. Criterion a -> Criterion a) -> Criterion b)
-> Criterion b
mask :: forall b.
((forall a. Criterion a -> Criterion a) -> Criterion b)
-> Criterion b
$cmask :: forall b.
((forall a. Criterion a -> Criterion a) -> Criterion b)
-> Criterion b
MonadMask )

instance MonadReader Config Criterion where
    ask :: Criterion Config
ask     = Crit -> Config
config forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. ReaderT Crit IO a -> Criterion a
Criterion forall r (m :: * -> *). MonadReader r m => m r
ask
    local :: forall a. (Config -> Config) -> Criterion a -> Criterion a
local Config -> Config
f = forall a. ReaderT Crit IO a -> Criterion a
Criterion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Crit -> Crit
fconfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Criterion a -> ReaderT Crit IO a
runCriterion
      where fconfig :: Crit -> Crit
fconfig Crit
c = Crit
c { config :: Config
config = Config -> Config
f (Crit -> Config
config Crit
c) }