-- | Tools for benchmarking and accumulating results.
--   Nothing Agda-specific in here.

module Agda.Utils.Benchmark where

import Prelude hiding (null)

import Control.DeepSeq
import qualified Control.Exception as E (evaluate)
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.IO.Class ( MonadIO(..) )


import Data.Function (on)
import qualified Data.List as List
import Data.Monoid
import Data.Maybe

import GHC.Generics (Generic)

import qualified Text.PrettyPrint.Boxes as Boxes

import Agda.Utils.ListT
import Agda.Utils.Null
import Agda.Utils.Monad hiding (finally)
import qualified Agda.Utils.Maybe.Strict as Strict
import Agda.Syntax.Common.Pretty
import Agda.Utils.Time
import Agda.Utils.Trie (Trie)
import qualified Agda.Utils.Trie as Trie


-- * Benchmark trie

-- | Account we can bill computation time to.
type Account a = [a]

-- | Record when we started billing the current account.
type CurrentAccount a = Strict.Maybe (Account a, CPUTime)

type Timings        a = Trie a CPUTime

data BenchmarkOn a = BenchmarkOff | BenchmarkOn | BenchmarkSome (Account a -> Bool)
  deriving (forall x. BenchmarkOn a -> Rep (BenchmarkOn a) x)
-> (forall x. Rep (BenchmarkOn a) x -> BenchmarkOn a)
-> Generic (BenchmarkOn a)
forall x. Rep (BenchmarkOn a) x -> BenchmarkOn a
forall x. BenchmarkOn a -> Rep (BenchmarkOn a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BenchmarkOn a) x -> BenchmarkOn a
forall a x. BenchmarkOn a -> Rep (BenchmarkOn a) x
$cfrom :: forall a x. BenchmarkOn a -> Rep (BenchmarkOn a) x
from :: forall x. BenchmarkOn a -> Rep (BenchmarkOn a) x
$cto :: forall a x. Rep (BenchmarkOn a) x -> BenchmarkOn a
to :: forall x. Rep (BenchmarkOn a) x -> BenchmarkOn a
Generic

isBenchmarkOn :: Account a -> BenchmarkOn a -> Bool
isBenchmarkOn :: forall a. Account a -> BenchmarkOn a -> Bool
isBenchmarkOn Account a
_ BenchmarkOn a
BenchmarkOff      = Bool
False
isBenchmarkOn Account a
_ BenchmarkOn a
BenchmarkOn       = Bool
True
isBenchmarkOn Account a
a (BenchmarkSome Account a -> Bool
p) = Account a -> Bool
p Account a
a

-- | Benchmark structure is a trie, mapping accounts (phases and subphases)
--   to CPU time spent on their performance.
data Benchmark a = Benchmark
  { forall a. Benchmark a -> BenchmarkOn a
benchmarkOn    :: !(BenchmarkOn a)
    -- ^ Are we benchmarking at all?
  , forall a. Benchmark a -> CurrentAccount a
currentAccount :: !(CurrentAccount a)
    -- ^ What are we billing to currently?
  , forall a. Benchmark a -> Timings a
timings        :: !(Timings a)
    -- ^ The accounts and their accumulated timing bill.
  }
  deriving (forall x. Benchmark a -> Rep (Benchmark a) x)
-> (forall x. Rep (Benchmark a) x -> Benchmark a)
-> Generic (Benchmark a)
forall x. Rep (Benchmark a) x -> Benchmark a
forall x. Benchmark a -> Rep (Benchmark a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Benchmark a) x -> Benchmark a
forall a x. Benchmark a -> Rep (Benchmark a) x
$cfrom :: forall a x. Benchmark a -> Rep (Benchmark a) x
from :: forall x. Benchmark a -> Rep (Benchmark a) x
$cto :: forall a x. Rep (Benchmark a) x -> Benchmark a
to :: forall x. Rep (Benchmark a) x -> Benchmark a
Generic

-- | Initial benchmark structure (empty).
instance Null (Benchmark a) where
  empty :: Benchmark a
empty = Benchmark
    { benchmarkOn :: BenchmarkOn a
benchmarkOn = BenchmarkOn a
forall a. BenchmarkOn a
BenchmarkOff
    , currentAccount :: CurrentAccount a
currentAccount = CurrentAccount a
forall a. Maybe a
Strict.Nothing
    , timings :: Timings a
timings = Timings a
forall a. Null a => a
empty
    }
  null :: Benchmark a -> Bool
null = Timings a -> Bool
forall a. Null a => a -> Bool
null (Timings a -> Bool)
-> (Benchmark a -> Timings a) -> Benchmark a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark a -> Timings a
forall a. Benchmark a -> Timings a
timings

-- | Semantic editor combinator.
mapBenchmarkOn :: (BenchmarkOn a -> BenchmarkOn a) -> Benchmark a -> Benchmark a
mapBenchmarkOn :: forall a.
(BenchmarkOn a -> BenchmarkOn a) -> Benchmark a -> Benchmark a
mapBenchmarkOn BenchmarkOn a -> BenchmarkOn a
f Benchmark a
b = Benchmark a
b { benchmarkOn = f $ benchmarkOn b }

-- | Semantic editor combinator.
mapCurrentAccount ::
  (CurrentAccount a -> CurrentAccount a) -> Benchmark a -> Benchmark a
mapCurrentAccount :: forall a.
(CurrentAccount a -> CurrentAccount a)
-> Benchmark a -> Benchmark a
mapCurrentAccount CurrentAccount a -> CurrentAccount a
f Benchmark a
b = Benchmark a
b { currentAccount = f (currentAccount b) }

-- | Semantic editor combinator.
mapTimings :: (Timings a -> Timings a) -> Benchmark a -> Benchmark a
mapTimings :: forall a. (Timings a -> Timings a) -> Benchmark a -> Benchmark a
mapTimings Timings a -> Timings a
f Benchmark a
b = Benchmark a
b { timings = f (timings b) }

-- | Add to specified CPU time account.
addCPUTime :: Ord a => Account a -> CPUTime -> Benchmark a -> Benchmark a
addCPUTime :: forall a.
Ord a =>
Account a -> CPUTime -> Benchmark a -> Benchmark a
addCPUTime Account a
acc CPUTime
t = (Timings a -> Timings a) -> Benchmark a -> Benchmark a
forall a. (Timings a -> Timings a) -> Benchmark a -> Benchmark a
mapTimings ((CPUTime -> CPUTime -> CPUTime)
-> Account a -> CPUTime -> Timings a -> Timings a
forall k v.
Ord k =>
(v -> v -> v) -> [k] -> v -> Trie k v -> Trie k v
Trie.insertWith CPUTime -> CPUTime -> CPUTime
forall a. Num a => a -> a -> a
(+) Account a
acc CPUTime
t)

-- | Print benchmark as three-column table with totals.
instance (Ord a, Pretty a) => Pretty (Benchmark a) where
  pretty :: Benchmark a -> Doc
pretty Benchmark a
b = [Char] -> Doc
forall a. [Char] -> Doc a
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ Box -> [Char]
Boxes.render Box
table
    where
    trie :: Timings a
trie = Benchmark a -> Timings a
forall a. Benchmark a -> Timings a
timings Benchmark a
b
    ([[a]]
accounts, [(CPUTime, CPUTime)]
times0) = [([a], (CPUTime, CPUTime))] -> ([[a]], [(CPUTime, CPUTime)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([a], (CPUTime, CPUTime))] -> ([[a]], [(CPUTime, CPUTime)]))
-> [([a], (CPUTime, CPUTime))] -> ([[a]], [(CPUTime, CPUTime)])
forall a b. (a -> b) -> a -> b
$ ((CPUTime, CPUTime) -> (CPUTime, CPUTime) -> Ordering)
-> Trie a (CPUTime, CPUTime) -> [([a], (CPUTime, CPUTime))]
forall k v. Ord k => (v -> v -> Ordering) -> Trie k v -> [([k], v)]
Trie.toListOrderedBy ((CPUTime -> CPUTime -> Ordering) -> CPUTime -> CPUTime -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip CPUTime -> CPUTime -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (CPUTime -> CPUTime -> Ordering)
-> ((CPUTime, CPUTime) -> CPUTime)
-> (CPUTime, CPUTime)
-> (CPUTime, CPUTime)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (CPUTime, CPUTime) -> CPUTime
forall a b. (a, b) -> b
snd)
                               (Trie a (CPUTime, CPUTime) -> [([a], (CPUTime, CPUTime))])
-> Trie a (CPUTime, CPUTime) -> [([a], (CPUTime, CPUTime))]
forall a b. (a -> b) -> a -> b
$ ((CPUTime, CPUTime) -> Bool)
-> Trie a (CPUTime, CPUTime) -> Trie a (CPUTime, CPUTime)
forall k v. Ord k => (v -> Bool) -> Trie k v -> Trie k v
Trie.filter ((CPUTime -> CPUTime -> Bool
forall a. Ord a => a -> a -> Bool
> Integer -> CPUTime
fromMilliseconds Integer
10) (CPUTime -> Bool)
-> ((CPUTime, CPUTime) -> CPUTime) -> (CPUTime, CPUTime) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CPUTime, CPUTime) -> CPUTime
forall a b. (a, b) -> b
snd)
                               (Trie a (CPUTime, CPUTime) -> Trie a (CPUTime, CPUTime))
-> Trie a (CPUTime, CPUTime) -> Trie a (CPUTime, CPUTime)
forall a b. (a -> b) -> a -> b
$ (Timings a -> Maybe (CPUTime, CPUTime))
-> Timings a -> Trie a (CPUTime, CPUTime)
forall k u v.
Ord k =>
(Trie k u -> Maybe v) -> Trie k u -> Trie k v
Trie.mapSubTries ((CPUTime, CPUTime) -> Maybe (CPUTime, CPUTime)
forall a. a -> Maybe a
Just ((CPUTime, CPUTime) -> Maybe (CPUTime, CPUTime))
-> (Timings a -> (CPUTime, CPUTime))
-> Timings a
-> Maybe (CPUTime, CPUTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timings a -> (CPUTime, CPUTime)
forall {b} {k}. (Num b, Ord k) => Trie k b -> (b, b)
aggr) Timings a
trie
    times :: [CPUTime]
times = ((CPUTime, CPUTime) -> CPUTime)
-> [(CPUTime, CPUTime)] -> [CPUTime]
forall a b. (a -> b) -> [a] -> [b]
map (CPUTime, CPUTime) -> CPUTime
forall a b. (a, b) -> a
fst [(CPUTime, CPUTime)]
times0
    aggr :: Trie k b -> (b, b)
aggr Trie k b
t = (b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
0 (Maybe b -> b) -> Maybe b -> b
forall a b. (a -> b) -> a -> b
$ [k] -> Trie k b -> Maybe b
forall k v. Ord k => [k] -> Trie k v -> Maybe v
Trie.lookup [] Trie k b
t, Sum b -> b
forall a. Sum a -> a
getSum (Sum b -> b) -> Sum b -> b
forall a b. (a -> b) -> a -> b
$ (b -> Sum b) -> Trie k b -> Sum b
forall m a. Monoid m => (a -> m) -> Trie k a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> Sum b
forall a. a -> Sum a
Sum Trie k b
t)
    aggrTimes :: [Box]
aggrTimes = do
      ([a]
a, (CPUTime
t, CPUTime
aggrT)) <- [[a]] -> [(CPUTime, CPUTime)] -> [([a], (CPUTime, CPUTime))]
forall a b. [a] -> [b] -> [(a, b)]
zip [[a]]
accounts [(CPUTime, CPUTime)]
times0
      Box -> [Box]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Box -> [Box]) -> Box -> [Box]
forall a b. (a -> b) -> a -> b
$ if CPUTime
t CPUTime -> CPUTime -> Bool
forall a. Eq a => a -> a -> Bool
== CPUTime
aggrT Bool -> Bool -> Bool
|| [a] -> Bool
forall a. Null a => a -> Bool
null [a]
a
               then Box
""
               else [Char] -> Box
Boxes.text ([Char] -> Box) -> [Char] -> Box
forall a b. (a -> b) -> a -> b
$ [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CPUTime -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow CPUTime
aggrT [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"

    -- Generate a table.
    table :: Box
table = Int -> Alignment -> [Box] -> Box
forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
Boxes.hsep Int
1 Alignment
Boxes.left [Box
col1, Box
col2, Box
col3]

    -- First column: Accounts.
    col1 :: Box
col1 = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Boxes.vcat Alignment
Boxes.left ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$
           ([Char] -> Box) -> [[Char]] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Box
Boxes.text ([[Char]] -> [Box]) -> [[Char]] -> [Box]
forall a b. (a -> b) -> a -> b
$
           [Char]
"Total" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ([a] -> [Char]) -> [[a]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [Char]
forall {a}. Pretty a => [a] -> [Char]
showAccount [[a]]
accounts
    -- Second column: Times.
    col2 :: Box
col2 = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Boxes.vcat Alignment
Boxes.right ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$
           (CPUTime -> Box) -> [CPUTime] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Box
Boxes.text ([Char] -> Box) -> (CPUTime -> [Char]) -> CPUTime -> Box
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CPUTime -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow) ([CPUTime] -> [Box]) -> [CPUTime] -> [Box]
forall a b. (a -> b) -> a -> b
$
           [CPUTime] -> CPUTime
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [CPUTime]
times CPUTime -> [CPUTime] -> [CPUTime]
forall a. a -> [a] -> [a]
: [CPUTime]
times
    -- Thid column: Aggregate times.
    col3 :: Box
col3 = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Boxes.vcat Alignment
Boxes.right ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$
           Box
"" Box -> [Box] -> [Box]
forall a. a -> [a] -> [a]
: [Box]
aggrTimes

    showAccount :: [a] -> [Char]
showAccount [] = [Char]
"Miscellaneous"
    showAccount [a]
ks = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"." ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (a -> [Char]) -> [a] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow [a]
ks


-- * Benchmarking monad.

-- | Monad with access to benchmarking data.

class (Ord (BenchPhase m), Functor m, MonadIO m) => MonadBench m where
  type BenchPhase m
  getBenchmark :: m (Benchmark (BenchPhase m))

  putBenchmark :: Benchmark (BenchPhase m) -> m ()
  putBenchmark Benchmark (BenchPhase m)
b = (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark ((Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ())
-> (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall a b. (a -> b) -> a -> b
$ Benchmark (BenchPhase m)
-> Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)
forall a b. a -> b -> a
const Benchmark (BenchPhase m)
b

  modifyBenchmark :: (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
  modifyBenchmark Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)
f = do
    Benchmark (BenchPhase m)
b <- m (Benchmark (BenchPhase m))
forall (m :: * -> *). MonadBench m => m (Benchmark (BenchPhase m))
getBenchmark
    Benchmark (BenchPhase m) -> m ()
forall (m :: * -> *).
MonadBench m =>
Benchmark (BenchPhase m) -> m ()
putBenchmark (Benchmark (BenchPhase m) -> m ())
-> Benchmark (BenchPhase m) -> m ()
forall a b. (a -> b) -> a -> b
$! Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)
f Benchmark (BenchPhase m)
b

  -- | We need to be able to terminate benchmarking in case of an exception.
  finally :: m b -> m c -> m b

getsBenchmark :: MonadBench m => (Benchmark (BenchPhase m) -> c) -> m c
getsBenchmark :: forall (m :: * -> *) c.
MonadBench m =>
(Benchmark (BenchPhase m) -> c) -> m c
getsBenchmark Benchmark (BenchPhase m) -> c
f = Benchmark (BenchPhase m) -> c
f (Benchmark (BenchPhase m) -> c)
-> m (Benchmark (BenchPhase m)) -> m c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Benchmark (BenchPhase m))
forall (m :: * -> *). MonadBench m => m (Benchmark (BenchPhase m))
getBenchmark

instance MonadBench m => MonadBench (ReaderT r m) where
  type BenchPhase (ReaderT r m) = BenchPhase m
  getBenchmark :: ReaderT r m (Benchmark (BenchPhase (ReaderT r m)))
getBenchmark    = m (Benchmark (BenchPhase (ReaderT r m)))
-> ReaderT r m (Benchmark (BenchPhase (ReaderT r m)))
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Benchmark (BenchPhase (ReaderT r m)))
 -> ReaderT r m (Benchmark (BenchPhase (ReaderT r m))))
-> m (Benchmark (BenchPhase (ReaderT r m)))
-> ReaderT r m (Benchmark (BenchPhase (ReaderT r m)))
forall a b. (a -> b) -> a -> b
$ m (Benchmark (BenchPhase m))
m (Benchmark (BenchPhase (ReaderT r m)))
forall (m :: * -> *). MonadBench m => m (Benchmark (BenchPhase m))
getBenchmark
  putBenchmark :: Benchmark (BenchPhase (ReaderT r m)) -> ReaderT r m ()
putBenchmark    = m () -> ReaderT r m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ())
-> (Benchmark (BenchPhase m) -> m ())
-> Benchmark (BenchPhase m)
-> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark (BenchPhase m) -> m ()
forall (m :: * -> *).
MonadBench m =>
Benchmark (BenchPhase m) -> m ()
putBenchmark
  modifyBenchmark :: (Benchmark (BenchPhase (ReaderT r m))
 -> Benchmark (BenchPhase (ReaderT r m)))
-> ReaderT r m ()
modifyBenchmark = m () -> ReaderT r m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ())
-> ((Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ())
-> (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m))
-> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark
  finally :: forall b c. ReaderT r m b -> ReaderT r m c -> ReaderT r m b
finally ReaderT r m b
m ReaderT r m c
f = (r -> m b) -> ReaderT r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m b) -> ReaderT r m b) -> (r -> m b) -> ReaderT r m b
forall a b. (a -> b) -> a -> b
$ \ r
r ->
    m b -> m c -> m b
forall b c. m b -> m c -> m b
forall (m :: * -> *) b c. MonadBench m => m b -> m c -> m b
finally (ReaderT r m b
m ReaderT r m b -> r -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` r
r) (ReaderT r m c
f ReaderT r m c -> r -> m c
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` r
r)

instance (MonadBench m, Monoid w) => MonadBench (WriterT w m) where
  type BenchPhase (WriterT w m) = BenchPhase m
  getBenchmark :: WriterT w m (Benchmark (BenchPhase (WriterT w m)))
getBenchmark    = m (Benchmark (BenchPhase (WriterT w m)))
-> WriterT w m (Benchmark (BenchPhase (WriterT w m)))
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Benchmark (BenchPhase (WriterT w m)))
 -> WriterT w m (Benchmark (BenchPhase (WriterT w m))))
-> m (Benchmark (BenchPhase (WriterT w m)))
-> WriterT w m (Benchmark (BenchPhase (WriterT w m)))
forall a b. (a -> b) -> a -> b
$ m (Benchmark (BenchPhase m))
m (Benchmark (BenchPhase (WriterT w m)))
forall (m :: * -> *). MonadBench m => m (Benchmark (BenchPhase m))
getBenchmark
  putBenchmark :: Benchmark (BenchPhase (WriterT w m)) -> WriterT w m ()
putBenchmark    = m () -> WriterT w m ()
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ())
-> (Benchmark (BenchPhase m) -> m ())
-> Benchmark (BenchPhase m)
-> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark (BenchPhase m) -> m ()
forall (m :: * -> *).
MonadBench m =>
Benchmark (BenchPhase m) -> m ()
putBenchmark
  modifyBenchmark :: (Benchmark (BenchPhase (WriterT w m))
 -> Benchmark (BenchPhase (WriterT w m)))
-> WriterT w m ()
modifyBenchmark = m () -> WriterT w m ()
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ())
-> ((Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ())
-> (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m))
-> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark
  finally :: forall b c. WriterT w m b -> WriterT w m c -> WriterT w m b
finally WriterT w m b
m WriterT w m c
f = m (b, w) -> WriterT w m b
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (b, w) -> WriterT w m b) -> m (b, w) -> WriterT w m b
forall a b. (a -> b) -> a -> b
$ m (b, w) -> m (c, w) -> m (b, w)
forall b c. m b -> m c -> m b
forall (m :: * -> *) b c. MonadBench m => m b -> m c -> m b
finally (WriterT w m b -> m (b, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT w m b
m) (WriterT w m c -> m (c, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT w m c
f)

instance MonadBench m => MonadBench (StateT r m) where
  type BenchPhase (StateT r m) = BenchPhase m

  getBenchmark :: StateT r m (Benchmark (BenchPhase (StateT r m)))
getBenchmark    = m (Benchmark (BenchPhase (StateT r m)))
-> StateT r m (Benchmark (BenchPhase (StateT r m)))
forall (m :: * -> *) a. Monad m => m a -> StateT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Benchmark (BenchPhase (StateT r m)))
 -> StateT r m (Benchmark (BenchPhase (StateT r m))))
-> m (Benchmark (BenchPhase (StateT r m)))
-> StateT r m (Benchmark (BenchPhase (StateT r m)))
forall a b. (a -> b) -> a -> b
$ m (Benchmark (BenchPhase m))
m (Benchmark (BenchPhase (StateT r m)))
forall (m :: * -> *). MonadBench m => m (Benchmark (BenchPhase m))
getBenchmark
  putBenchmark :: Benchmark (BenchPhase (StateT r m)) -> StateT r m ()
putBenchmark    = m () -> StateT r m ()
forall (m :: * -> *) a. Monad m => m a -> StateT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT r m ())
-> (Benchmark (BenchPhase m) -> m ())
-> Benchmark (BenchPhase m)
-> StateT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark (BenchPhase m) -> m ()
forall (m :: * -> *).
MonadBench m =>
Benchmark (BenchPhase m) -> m ()
putBenchmark
  modifyBenchmark :: (Benchmark (BenchPhase (StateT r m))
 -> Benchmark (BenchPhase (StateT r m)))
-> StateT r m ()
modifyBenchmark = m () -> StateT r m ()
forall (m :: * -> *) a. Monad m => m a -> StateT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT r m ())
-> ((Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ())
-> (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m))
-> StateT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark
  finally :: forall b c. StateT r m b -> StateT r m c -> StateT r m b
finally StateT r m b
m StateT r m c
f = (r -> m (b, r)) -> StateT r m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((r -> m (b, r)) -> StateT r m b)
-> (r -> m (b, r)) -> StateT r m b
forall a b. (a -> b) -> a -> b
$ \r
s ->
    m (b, r) -> m (c, r) -> m (b, r)
forall b c. m b -> m c -> m b
forall (m :: * -> *) b c. MonadBench m => m b -> m c -> m b
finally (StateT r m b
m StateT r m b -> r -> m (b, r)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
`runStateT` r
s) (StateT r m c
f StateT r m c -> r -> m (c, r)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
`runStateT` r
s)

instance MonadBench m => MonadBench (ExceptT e m) where
  type BenchPhase (ExceptT e m) = BenchPhase m

  getBenchmark :: ExceptT e m (Benchmark (BenchPhase (ExceptT e m)))
getBenchmark    = m (Benchmark (BenchPhase (ExceptT e m)))
-> ExceptT e m (Benchmark (BenchPhase (ExceptT e m)))
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Benchmark (BenchPhase (ExceptT e m)))
 -> ExceptT e m (Benchmark (BenchPhase (ExceptT e m))))
-> m (Benchmark (BenchPhase (ExceptT e m)))
-> ExceptT e m (Benchmark (BenchPhase (ExceptT e m)))
forall a b. (a -> b) -> a -> b
$ m (Benchmark (BenchPhase m))
m (Benchmark (BenchPhase (ExceptT e m)))
forall (m :: * -> *). MonadBench m => m (Benchmark (BenchPhase m))
getBenchmark
  putBenchmark :: Benchmark (BenchPhase (ExceptT e m)) -> ExceptT e m ()
putBenchmark    = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ())
-> (Benchmark (BenchPhase m) -> m ())
-> Benchmark (BenchPhase m)
-> ExceptT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark (BenchPhase m) -> m ()
forall (m :: * -> *).
MonadBench m =>
Benchmark (BenchPhase m) -> m ()
putBenchmark
  modifyBenchmark :: (Benchmark (BenchPhase (ExceptT e m))
 -> Benchmark (BenchPhase (ExceptT e m)))
-> ExceptT e m ()
modifyBenchmark = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ())
-> ((Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ())
-> (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m))
-> ExceptT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark
  finally :: forall b c. ExceptT e m b -> ExceptT e m c -> ExceptT e m b
finally ExceptT e m b
m ExceptT e m c
f = m (Either e b) -> ExceptT e m b
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e b) -> ExceptT e m b)
-> m (Either e b) -> ExceptT e m b
forall a b. (a -> b) -> a -> b
$ m (Either e b) -> m (Either e c) -> m (Either e b)
forall b c. m b -> m c -> m b
forall (m :: * -> *) b c. MonadBench m => m b -> m c -> m b
finally (ExceptT e m b -> m (Either e b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m b
m) (ExceptT e m c -> m (Either e c)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m c
f)

instance MonadBench m => MonadBench (ListT m) where
  type BenchPhase (ListT m) = BenchPhase m

  getBenchmark :: ListT m (Benchmark (BenchPhase (ListT m)))
getBenchmark    = m (Benchmark (BenchPhase m)) -> ListT m (Benchmark (BenchPhase m))
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Benchmark (BenchPhase m))
forall (m :: * -> *). MonadBench m => m (Benchmark (BenchPhase m))
getBenchmark
  putBenchmark :: Benchmark (BenchPhase (ListT m)) -> ListT m ()
putBenchmark    = m () -> ListT m ()
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ListT m ())
-> (Benchmark (BenchPhase m) -> m ())
-> Benchmark (BenchPhase m)
-> ListT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark (BenchPhase m) -> m ()
forall (m :: * -> *).
MonadBench m =>
Benchmark (BenchPhase m) -> m ()
putBenchmark
  modifyBenchmark :: (Benchmark (BenchPhase (ListT m))
 -> Benchmark (BenchPhase (ListT m)))
-> ListT m ()
modifyBenchmark = m () -> ListT m ()
forall (m :: * -> *) a. Monad m => m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ListT m ())
-> ((Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ())
-> (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m))
-> ListT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark
  finally :: forall b c. ListT m b -> ListT m c -> ListT m b
finally ListT m b
m ListT m c
f = m (Maybe (b, ListT m b)) -> ListT m b
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (m (Maybe (b, ListT m b)) -> ListT m b)
-> m (Maybe (b, ListT m b)) -> ListT m b
forall a b. (a -> b) -> a -> b
$ m (Maybe (b, ListT m b))
-> m (Maybe (c, ListT m c)) -> m (Maybe (b, ListT m b))
forall b c. m b -> m c -> m b
forall (m :: * -> *) b c. MonadBench m => m b -> m c -> m b
finally (ListT m b -> m (Maybe (b, ListT m b))
forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
runListT ListT m b
m) (ListT m c -> m (Maybe (c, ListT m c))
forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
runListT ListT m c
f)

-- | Turn benchmarking on/off.

setBenchmarking :: MonadBench m => BenchmarkOn (BenchPhase m) -> m ()
setBenchmarking :: forall (m :: * -> *).
MonadBench m =>
BenchmarkOn (BenchPhase m) -> m ()
setBenchmarking BenchmarkOn (BenchPhase m)
b = (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark ((Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ())
-> (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall a b. (a -> b) -> a -> b
$ (BenchmarkOn (BenchPhase m) -> BenchmarkOn (BenchPhase m))
-> Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)
forall a.
(BenchmarkOn a -> BenchmarkOn a) -> Benchmark a -> Benchmark a
mapBenchmarkOn ((BenchmarkOn (BenchPhase m) -> BenchmarkOn (BenchPhase m))
 -> Benchmark (BenchPhase m) -> Benchmark (BenchPhase m))
-> (BenchmarkOn (BenchPhase m) -> BenchmarkOn (BenchPhase m))
-> Benchmark (BenchPhase m)
-> Benchmark (BenchPhase m)
forall a b. (a -> b) -> a -> b
$ BenchmarkOn (BenchPhase m)
-> BenchmarkOn (BenchPhase m) -> BenchmarkOn (BenchPhase m)
forall a b. a -> b -> a
const BenchmarkOn (BenchPhase m)
b

-- | Bill current account with time up to now.
--   Switch to new account.
--   Return old account (if any).

switchBenchmarking :: MonadBench m
  => Strict.Maybe (Account (BenchPhase m))      -- ^ Maybe new account.
  -> m (Strict.Maybe (Account (BenchPhase m)))  -- ^ Maybe old account.
switchBenchmarking :: forall (m :: * -> *).
MonadBench m =>
Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
switchBenchmarking Maybe (Account (BenchPhase m))
newAccount = do
  CPUTime
now <- IO CPUTime -> m CPUTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CPUTime -> m CPUTime) -> IO CPUTime -> m CPUTime
forall a b. (a -> b) -> a -> b
$ IO CPUTime
forall (m :: * -> *). MonadIO m => m CPUTime
getCPUTime
  -- Stop and bill current benchmarking.
  CurrentAccount (BenchPhase m)
oldAccount <- (Benchmark (BenchPhase m) -> CurrentAccount (BenchPhase m))
-> m (CurrentAccount (BenchPhase m))
forall (m :: * -> *) c.
MonadBench m =>
(Benchmark (BenchPhase m) -> c) -> m c
getsBenchmark Benchmark (BenchPhase m) -> CurrentAccount (BenchPhase m)
forall a. Benchmark a -> CurrentAccount a
currentAccount
  CurrentAccount (BenchPhase m)
-> ((Account (BenchPhase m), CPUTime) -> m ()) -> m ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
Strict.whenJust CurrentAccount (BenchPhase m)
oldAccount (((Account (BenchPhase m), CPUTime) -> m ()) -> m ())
-> ((Account (BenchPhase m), CPUTime) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ (Account (BenchPhase m)
acc, CPUTime
start) ->
    (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark ((Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ())
-> (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall a b. (a -> b) -> a -> b
$ Account (BenchPhase m)
-> CPUTime -> Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)
forall a.
Ord a =>
Account a -> CPUTime -> Benchmark a -> Benchmark a
addCPUTime Account (BenchPhase m)
acc (CPUTime -> Benchmark (BenchPhase m) -> Benchmark (BenchPhase m))
-> CPUTime -> Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)
forall a b. (a -> b) -> a -> b
$ CPUTime
now CPUTime -> CPUTime -> CPUTime
forall a. Num a => a -> a -> a
- CPUTime
start
  -- Switch to new account.
  (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark ((Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ())
-> (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall a b. (a -> b) -> a -> b
$ (CurrentAccount (BenchPhase m) -> CurrentAccount (BenchPhase m))
-> Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)
forall a.
(CurrentAccount a -> CurrentAccount a)
-> Benchmark a -> Benchmark a
mapCurrentAccount ((CurrentAccount (BenchPhase m) -> CurrentAccount (BenchPhase m))
 -> Benchmark (BenchPhase m) -> Benchmark (BenchPhase m))
-> (CurrentAccount (BenchPhase m) -> CurrentAccount (BenchPhase m))
-> Benchmark (BenchPhase m)
-> Benchmark (BenchPhase m)
forall a b. (a -> b) -> a -> b
$ CurrentAccount (BenchPhase m)
-> CurrentAccount (BenchPhase m) -> CurrentAccount (BenchPhase m)
forall a b. a -> b -> a
const (CurrentAccount (BenchPhase m)
 -> CurrentAccount (BenchPhase m) -> CurrentAccount (BenchPhase m))
-> CurrentAccount (BenchPhase m)
-> CurrentAccount (BenchPhase m)
-> CurrentAccount (BenchPhase m)
forall a b. (a -> b) -> a -> b
$ (, CPUTime
now) (Account (BenchPhase m) -> (Account (BenchPhase m), CPUTime))
-> Maybe (Account (BenchPhase m)) -> CurrentAccount (BenchPhase m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Account (BenchPhase m))
newAccount
  Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Account (BenchPhase m))
 -> m (Maybe (Account (BenchPhase m))))
-> Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
forall a b. (a -> b) -> a -> b
$ (Account (BenchPhase m), CPUTime) -> Account (BenchPhase m)
forall a b. (a, b) -> a
fst ((Account (BenchPhase m), CPUTime) -> Account (BenchPhase m))
-> CurrentAccount (BenchPhase m) -> Maybe (Account (BenchPhase m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CurrentAccount (BenchPhase m)
oldAccount

-- | Resets the account and the timing information.

reset :: MonadBench m => m ()
reset :: forall (m :: * -> *). MonadBench m => m ()
reset = (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark ((Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ())
-> (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
forall a b. (a -> b) -> a -> b
$
  (CurrentAccount (BenchPhase m) -> CurrentAccount (BenchPhase m))
-> Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)
forall a.
(CurrentAccount a -> CurrentAccount a)
-> Benchmark a -> Benchmark a
mapCurrentAccount (CurrentAccount (BenchPhase m)
-> CurrentAccount (BenchPhase m) -> CurrentAccount (BenchPhase m)
forall a b. a -> b -> a
const CurrentAccount (BenchPhase m)
forall a. Maybe a
Strict.Nothing) (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m))
-> (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m))
-> Benchmark (BenchPhase m)
-> Benchmark (BenchPhase m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Timings (BenchPhase m) -> Timings (BenchPhase m))
-> Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)
forall a. (Timings a -> Timings a) -> Benchmark a -> Benchmark a
mapTimings (Timings (BenchPhase m)
-> Timings (BenchPhase m) -> Timings (BenchPhase m)
forall a b. a -> b -> a
const Timings (BenchPhase m)
forall a. Null a => a
Trie.empty)

-- | Bill a computation to a specific account.
--   Works even if the computation is aborted by an exception.

billTo :: MonadBench m => Account (BenchPhase m) -> m c -> m c
billTo :: forall (m :: * -> *) c.
MonadBench m =>
Account (BenchPhase m) -> m c -> m c
billTo Account (BenchPhase m)
account m c
m = m Bool -> m c -> m c -> m c
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifNotM (Account (BenchPhase m) -> BenchmarkOn (BenchPhase m) -> Bool
forall a. Account a -> BenchmarkOn a -> Bool
isBenchmarkOn Account (BenchPhase m)
account (BenchmarkOn (BenchPhase m) -> Bool)
-> m (BenchmarkOn (BenchPhase m)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Benchmark (BenchPhase m) -> BenchmarkOn (BenchPhase m))
-> m (BenchmarkOn (BenchPhase m))
forall (m :: * -> *) c.
MonadBench m =>
(Benchmark (BenchPhase m) -> c) -> m c
getsBenchmark Benchmark (BenchPhase m) -> BenchmarkOn (BenchPhase m)
forall a. Benchmark a -> BenchmarkOn a
benchmarkOn) m c
m (m c -> m c) -> m c -> m c
forall a b. (a -> b) -> a -> b
$ do
  -- Switch to new account.
  Maybe (Account (BenchPhase m))
old <- Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
forall (m :: * -> *).
MonadBench m =>
Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
switchBenchmarking (Maybe (Account (BenchPhase m))
 -> m (Maybe (Account (BenchPhase m))))
-> Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
forall a b. (a -> b) -> a -> b
$ Account (BenchPhase m) -> Maybe (Account (BenchPhase m))
forall a. a -> Maybe a
Strict.Just Account (BenchPhase m)
account
  -- Compute and switch back to old account.
  (IO c -> m c
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO c -> m c) -> (c -> IO c) -> c -> m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> IO c
forall a. a -> IO a
E.evaluate (c -> m c) -> m c -> m c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m c
m) m c -> m (Maybe (Account (BenchPhase m))) -> m c
forall b c. m b -> m c -> m b
forall (m :: * -> *) b c. MonadBench m => m b -> m c -> m b
`finally` Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
forall (m :: * -> *).
MonadBench m =>
Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
switchBenchmarking Maybe (Account (BenchPhase m))
old

-- | Bill a CPS function to an account. Can't handle exceptions.
billToCPS :: MonadBench m => Account (BenchPhase m) -> ((b -> m c) -> m c) -> (b -> m c) -> m c
billToCPS :: forall (m :: * -> *) b c.
MonadBench m =>
Account (BenchPhase m) -> ((b -> m c) -> m c) -> (b -> m c) -> m c
billToCPS Account (BenchPhase m)
account (b -> m c) -> m c
f b -> m c
k = m Bool -> m c -> m c -> m c
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifNotM (Account (BenchPhase m) -> BenchmarkOn (BenchPhase m) -> Bool
forall a. Account a -> BenchmarkOn a -> Bool
isBenchmarkOn Account (BenchPhase m)
account (BenchmarkOn (BenchPhase m) -> Bool)
-> m (BenchmarkOn (BenchPhase m)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Benchmark (BenchPhase m) -> BenchmarkOn (BenchPhase m))
-> m (BenchmarkOn (BenchPhase m))
forall (m :: * -> *) c.
MonadBench m =>
(Benchmark (BenchPhase m) -> c) -> m c
getsBenchmark Benchmark (BenchPhase m) -> BenchmarkOn (BenchPhase m)
forall a. Benchmark a -> BenchmarkOn a
benchmarkOn) ((b -> m c) -> m c
f b -> m c
k) (m c -> m c) -> m c -> m c
forall a b. (a -> b) -> a -> b
$ do
  -- Switch to new account.
  Maybe (Account (BenchPhase m))
old <- Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
forall (m :: * -> *).
MonadBench m =>
Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
switchBenchmarking (Maybe (Account (BenchPhase m))
 -> m (Maybe (Account (BenchPhase m))))
-> Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
forall a b. (a -> b) -> a -> b
$ Account (BenchPhase m) -> Maybe (Account (BenchPhase m))
forall a. a -> Maybe a
Strict.Just Account (BenchPhase m)
account
  (b -> m c) -> m c
f ((b -> m c) -> m c) -> (b -> m c) -> m c
forall a b. (a -> b) -> a -> b
$ \ b
x -> b
x b -> m c -> m c
forall a b. a -> b -> b
`seq` do
    Maybe (Account (BenchPhase m))
_ <- Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
forall (m :: * -> *).
MonadBench m =>
Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
switchBenchmarking Maybe (Account (BenchPhase m))
old
    b -> m c
k b
x

-- | Bill a pure computation to a specific account.
billPureTo :: MonadBench m  => Account (BenchPhase m) -> c -> m c
billPureTo :: forall (m :: * -> *) c.
MonadBench m =>
Account (BenchPhase m) -> c -> m c
billPureTo Account (BenchPhase m)
account = Account (BenchPhase m) -> m c -> m c
forall (m :: * -> *) c.
MonadBench m =>
Account (BenchPhase m) -> m c -> m c
billTo Account (BenchPhase m)
account (m c -> m c) -> (c -> m c) -> c -> m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> m c
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- NFData instances.

instance NFData a => NFData (BenchmarkOn a)
instance NFData a => NFData (Benchmark a)