    -- | 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
    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.Utils.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
    $cto :: forall a x. Rep (BenchmarkOn a) x -> BenchmarkOn a
    $cfrom :: forall a x. BenchmarkOn a -> Rep (BenchmarkOn a) x
    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
    $cto :: forall a x. Rep (Benchmark a) x -> Benchmark a
    $cfrom :: forall a x. Benchmark a -> Rep (Benchmark a) x
    Generic

    -- | Initial benchmark structure (empty).
    instance Null (Benchmark a) where
      empty :: Benchmark a
    empty = Benchmark :: forall a.
    BenchmarkOn a -> CurrentAccount a -> Timings a -> Benchmark a
    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 :: BenchmarkOn a
    benchmarkOn = BenchmarkOn a -> BenchmarkOn a
    f (BenchmarkOn a -> BenchmarkOn a) -> BenchmarkOn a -> BenchmarkOn a
    forall a b. (a -> b) -> a -> b
    $ Benchmark a -> BenchmarkOn a
    forall a. Benchmark a -> BenchmarkOn a
    benchmarkOn Benchmark a
    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 :: CurrentAccount a
    currentAccount = CurrentAccount a -> CurrentAccount a
    f (Benchmark a -> CurrentAccount a
    forall a. Benchmark a -> CurrentAccount a
    currentAccount Benchmark a
    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 :: Timings a
    timings = Timings a -> Timings a
    f (Benchmark a -> Timings a
    forall a. Benchmark a -> Timings a
    timings Benchmark a
    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
    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 (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 (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 (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 m))
    -> ReaderT r m (Benchmark (BenchPhase m))
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m (Benchmark (BenchPhase m))
     -> ReaderT r m (Benchmark (BenchPhase m)))
    -> m (Benchmark (BenchPhase m))
    -> ReaderT r m (Benchmark (BenchPhase m))
    forall a b. (a -> b) -> a -> b
    $ m (Benchmark (BenchPhase 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 (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 (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 (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 m))
    -> WriterT w m (Benchmark (BenchPhase m))
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m (Benchmark (BenchPhase m))
     -> WriterT w m (Benchmark (BenchPhase m)))
    -> m (Benchmark (BenchPhase m))
    -> WriterT w m (Benchmark (BenchPhase m))
    forall a b. (a -> b) -> a -> b
    $ m (Benchmark (BenchPhase 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 (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 (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 (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 m))
    -> StateT r m (Benchmark (BenchPhase m))
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m (Benchmark (BenchPhase m))
     -> StateT r m (Benchmark (BenchPhase m)))
    -> m (Benchmark (BenchPhase m))
    -> StateT r m (Benchmark (BenchPhase m))
    forall a b. (a -> b) -> a -> b
    $ m (Benchmark (BenchPhase 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 (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 (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 (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 m))
    -> ExceptT e m (Benchmark (BenchPhase m))
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m (Benchmark (BenchPhase m))
     -> ExceptT e m (Benchmark (BenchPhase m)))
    -> m (Benchmark (BenchPhase m))
    -> ExceptT e m (Benchmark (BenchPhase m))
    forall a b. (a -> b) -> a -> b
    $ m (Benchmark (BenchPhase 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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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
    `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 (m :: * -> *) a. Monad m => a -> m a
    return

    -- NFData instances.

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