{-# 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 {
      Criterion a -> ReaderT Crit IO a
runCriterion :: ReaderT Crit IO a
    } deriving ( a -> Criterion b -> Criterion a
(a -> b) -> Criterion a -> Criterion b
(forall a b. (a -> b) -> Criterion a -> Criterion b)
-> (forall a b. a -> Criterion b -> Criterion a)
-> Functor Criterion
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
<$ :: a -> Criterion b -> Criterion a
$c<$ :: forall a b. a -> Criterion b -> Criterion a
fmap :: (a -> b) -> Criterion a -> Criterion b
$cfmap :: forall a b. (a -> b) -> Criterion a -> Criterion b
Functor, Functor Criterion
a -> Criterion a
Functor Criterion
-> (forall a. a -> Criterion a)
-> (forall a b. Criterion (a -> b) -> Criterion a -> Criterion b)
-> (forall a b c.
    (a -> b -> c) -> Criterion a -> Criterion b -> Criterion c)
-> (forall a b. Criterion a -> Criterion b -> Criterion b)
-> (forall a b. Criterion a -> Criterion b -> Criterion a)
-> Applicative Criterion
Criterion a -> Criterion b -> Criterion b
Criterion a -> Criterion b -> Criterion a
Criterion (a -> b) -> Criterion a -> Criterion b
(a -> b -> c) -> Criterion a -> Criterion b -> Criterion c
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
<* :: Criterion a -> Criterion b -> Criterion a
$c<* :: forall a b. Criterion a -> Criterion b -> Criterion a
*> :: Criterion a -> Criterion b -> Criterion b
$c*> :: forall a b. Criterion a -> Criterion b -> Criterion b
liftA2 :: (a -> b -> c) -> Criterion a -> Criterion b -> Criterion c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Criterion a -> Criterion b -> Criterion c
<*> :: Criterion (a -> b) -> Criterion a -> Criterion b
$c<*> :: forall a b. Criterion (a -> b) -> Criterion a -> Criterion b
pure :: a -> Criterion a
$cpure :: forall a. a -> Criterion a
$cp1Applicative :: Functor Criterion
Applicative, Applicative Criterion
a -> Criterion a
Applicative Criterion
-> (forall a b. Criterion a -> (a -> Criterion b) -> Criterion b)
-> (forall a b. Criterion a -> Criterion b -> Criterion b)
-> (forall a. a -> Criterion a)
-> Monad Criterion
Criterion a -> (a -> Criterion b) -> Criterion b
Criterion a -> Criterion b -> Criterion b
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 :: a -> Criterion a
$creturn :: forall a. a -> Criterion a
>> :: Criterion a -> Criterion b -> Criterion b
$c>> :: forall a b. Criterion a -> Criterion b -> Criterion b
>>= :: Criterion a -> (a -> Criterion b) -> Criterion b
$c>>= :: forall a b. Criterion a -> (a -> Criterion b) -> Criterion b
$cp1Monad :: Applicative Criterion
Monad, Monad Criterion
Monad Criterion
-> (forall a. String -> Criterion a) -> MonadFail Criterion
String -> Criterion a
forall a. String -> Criterion a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Criterion a
$cfail :: forall a. String -> Criterion a
$cp1MonadFail :: Monad Criterion
Fail.MonadFail, Monad Criterion
Monad Criterion
-> (forall a. IO a -> Criterion a) -> MonadIO Criterion
IO a -> Criterion a
forall a. IO a -> Criterion a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Criterion a
$cliftIO :: forall a. IO a -> Criterion a
$cp1MonadIO :: Monad Criterion
MonadIO
               , Monad Criterion
e -> Criterion a
Monad Criterion
-> (forall e a. Exception e => e -> Criterion a)
-> MonadThrow Criterion
forall e a. Exception e => e -> Criterion a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> Criterion a
$cthrowM :: forall e a. Exception e => e -> Criterion a
$cp1MonadThrow :: Monad Criterion
MonadThrow, MonadThrow Criterion
MonadThrow Criterion
-> (forall e a.
    Exception e =>
    Criterion a -> (e -> Criterion a) -> Criterion a)
-> MonadCatch Criterion
Criterion a -> (e -> Criterion a) -> Criterion a
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 :: Criterion a -> (e -> Criterion a) -> Criterion a
$ccatch :: forall e a.
Exception e =>
Criterion a -> (e -> Criterion a) -> Criterion a
$cp1MonadCatch :: MonadThrow Criterion
MonadCatch, MonadCatch Criterion
MonadCatch Criterion
-> (forall b.
    ((forall a. Criterion a -> Criterion a) -> Criterion b)
    -> Criterion b)
-> (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))
-> MonadMask Criterion
Criterion a
-> (a -> ExitCase b -> Criterion c)
-> (a -> Criterion b)
-> Criterion (b, c)
((forall a. Criterion a -> Criterion a) -> Criterion b)
-> Criterion b
((forall a. Criterion a -> Criterion a) -> Criterion b)
-> Criterion b
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 :: 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 a. Criterion a -> Criterion a) -> Criterion b)
-> Criterion b
$cuninterruptibleMask :: forall b.
((forall a. Criterion a -> Criterion a) -> Criterion b)
-> Criterion b
mask :: ((forall a. Criterion a -> Criterion a) -> Criterion b)
-> Criterion b
$cmask :: forall b.
((forall a. Criterion a -> Criterion a) -> Criterion b)
-> Criterion b
$cp1MonadMask :: MonadCatch Criterion
MonadMask )

instance MonadReader Config Criterion where
    ask :: Criterion Config
ask     = Crit -> Config
config (Crit -> Config) -> Criterion Crit -> Criterion Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ReaderT Crit IO Crit -> Criterion Crit
forall a. ReaderT Crit IO a -> Criterion a
Criterion ReaderT Crit IO Crit
forall r (m :: * -> *). MonadReader r m => m r
ask
    local :: (Config -> Config) -> Criterion a -> Criterion a
local Config -> Config
f = ReaderT Crit IO a -> Criterion a
forall a. ReaderT Crit IO a -> Criterion a
Criterion (ReaderT Crit IO a -> Criterion a)
-> (Criterion a -> ReaderT Crit IO a) -> Criterion a -> Criterion a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Crit -> Crit) -> ReaderT Crit IO a -> ReaderT Crit IO a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Crit -> Crit
fconfig (ReaderT Crit IO a -> ReaderT Crit IO a)
-> (Criterion a -> ReaderT Crit IO a)
-> Criterion a
-> ReaderT Crit IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Criterion a -> ReaderT Crit IO a
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) }