{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE UndecidableInstances #-}
module Agda.Utils.Benchmark where
import Prelude hiding (null)
import qualified Control.Exception as E (evaluate)
import Control.Monad.Reader
import Control.Monad.State
import Data.Foldable (foldMap)
import Data.Function
import qualified Data.List as List
import Data.Monoid
import Data.Maybe
import qualified Text.PrettyPrint.Boxes as Boxes
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
type Account a = [a]
type CurrentAccount a = Strict.Maybe (Account a, CPUTime)
type Timings a = Trie a CPUTime
data BenchmarkOn a = BenchmarkOff | BenchmarkOn | BenchmarkSome (Account a -> Bool)
isBenchmarkOn :: Account a -> BenchmarkOn a -> Bool
isBenchmarkOn :: Account a -> BenchmarkOn a -> Bool
isBenchmarkOn _ BenchmarkOff = Bool
False
isBenchmarkOn _ BenchmarkOn = Bool
True
isBenchmarkOn a :: Account a
a (BenchmarkSome p :: Account a -> Bool
p) = Account a -> Bool
p Account a
a
data Benchmark a = Benchmark
{ Benchmark a -> BenchmarkOn a
benchmarkOn :: !(BenchmarkOn a)
, Benchmark a -> CurrentAccount a
currentAccount :: !(CurrentAccount a)
, Benchmark a -> Timings a
timings :: !(Timings a)
}
instance Null (Benchmark a) where
empty :: Benchmark a
empty = $WBenchmark :: 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
mapBenchmarkOn :: (BenchmarkOn a -> BenchmarkOn a) -> Benchmark a -> Benchmark a
mapBenchmarkOn :: (BenchmarkOn a -> BenchmarkOn a) -> Benchmark a -> Benchmark a
mapBenchmarkOn f :: BenchmarkOn a -> BenchmarkOn a
f b :: 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 }
mapCurrentAccount ::
(CurrentAccount a -> CurrentAccount a) -> Benchmark a -> Benchmark a
mapCurrentAccount :: (CurrentAccount a -> CurrentAccount a)
-> Benchmark a -> Benchmark a
mapCurrentAccount f :: CurrentAccount a -> CurrentAccount a
f b :: 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) }
mapTimings :: (Timings a -> Timings a) -> Benchmark a -> Benchmark a
mapTimings :: (Timings a -> Timings a) -> Benchmark a -> Benchmark a
mapTimings f :: Timings a -> Timings a
f b :: 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) }
addCPUTime :: Ord a => Account a -> CPUTime -> Benchmark a -> Benchmark a
addCPUTime :: Account a -> CPUTime -> Benchmark a -> Benchmark a
addCPUTime acc :: Account a
acc t :: 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)
instance (Ord a, Pretty a) => Pretty (Benchmark a) where
pretty :: Benchmark a -> Doc
pretty b :: Benchmark a
b = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Box -> String
Boxes.render Box
table
where
trie :: Timings a
trie = Benchmark a -> Timings a
forall a. Benchmark a -> Timings a
timings Benchmark a
b
(accounts :: [[a]]
accounts, times0 :: [(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 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 t :: Trie k b
t = (b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe 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]
a, (t :: CPUTime
t, aggrT :: 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 ""
else String -> Box
Boxes.text (String -> Box) -> String -> Box
forall a b. (a -> b) -> a -> b
$ "(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CPUTime -> String
forall a. Pretty a => a -> String
prettyShow CPUTime
aggrT String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"
table :: Box
table = Int -> Alignment -> [Box] -> Box
forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
Boxes.hsep 1 Alignment
Boxes.left [Box
col1, Box
col2, Box
col3]
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
$
(String -> Box) -> [String] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map String -> Box
Boxes.text ([String] -> [Box]) -> [String] -> [Box]
forall a b. (a -> b) -> a -> b
$
"Total" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ([a] -> String) -> [[a]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> String
forall a. Pretty a => [a] -> String
showAccount [[a]]
accounts
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 (String -> Box
Boxes.text (String -> Box) -> (CPUTime -> String) -> CPUTime -> Box
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CPUTime -> String
forall a. Pretty a => a -> String
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
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]
forall a. a -> [a] -> [a]
: [Box]
aggrTimes
showAccount :: [a] -> String
showAccount [] = "Miscellaneous"
showAccount ks :: [a]
ks = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate "." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Pretty a => a -> String
prettyShow [a]
ks
class (Ord a, Functor m, MonadIO m) => MonadBench a m | m -> a where
getBenchmark :: m (Benchmark a)
getsBenchmark :: (Benchmark a -> c) -> m c
getsBenchmark f :: Benchmark a -> c
f = Benchmark a -> c
f (Benchmark a -> c) -> m (Benchmark a) -> m c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Benchmark a)
forall a (m :: * -> *). MonadBench a m => m (Benchmark a)
getBenchmark
putBenchmark :: Benchmark a -> m ()
putBenchmark b :: Benchmark a
b = (Benchmark a -> Benchmark a) -> m ()
forall a (m :: * -> *).
MonadBench a m =>
(Benchmark a -> Benchmark a) -> m ()
modifyBenchmark ((Benchmark a -> Benchmark a) -> m ())
-> (Benchmark a -> Benchmark a) -> m ()
forall a b. (a -> b) -> a -> b
$ Benchmark a -> Benchmark a -> Benchmark a
forall a b. a -> b -> a
const Benchmark a
b
modifyBenchmark :: (Benchmark a -> Benchmark a) -> m ()
modifyBenchmark f :: Benchmark a -> Benchmark a
f = do
Benchmark a
b <- m (Benchmark a)
forall a (m :: * -> *). MonadBench a m => m (Benchmark a)
getBenchmark
Benchmark a -> m ()
forall a (m :: * -> *). MonadBench a m => Benchmark a -> m ()
putBenchmark (Benchmark a -> m ()) -> Benchmark a -> m ()
forall a b. (a -> b) -> a -> b
$! Benchmark a -> Benchmark a
f Benchmark a
b
finally :: m b -> m c -> m b
instance MonadBench a m => MonadBench a (ReaderT r m) where
getBenchmark :: ReaderT r m (Benchmark a)
getBenchmark = m (Benchmark a) -> ReaderT r m (Benchmark a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Benchmark a) -> ReaderT r m (Benchmark a))
-> m (Benchmark a) -> ReaderT r m (Benchmark a)
forall a b. (a -> b) -> a -> b
$ m (Benchmark a)
forall a (m :: * -> *). MonadBench a m => m (Benchmark a)
getBenchmark
putBenchmark :: Benchmark a -> 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 a -> m ()) -> Benchmark a -> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark a -> m ()
forall a (m :: * -> *). MonadBench a m => Benchmark a -> m ()
putBenchmark
modifyBenchmark :: (Benchmark a -> Benchmark a) -> 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 a -> Benchmark a) -> m ())
-> (Benchmark a -> Benchmark a)
-> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Benchmark a -> Benchmark a) -> m ()
forall a (m :: * -> *).
MonadBench a m =>
(Benchmark a -> Benchmark a) -> m ()
modifyBenchmark
finally :: ReaderT r m b -> ReaderT r m c -> ReaderT r m b
finally m :: ReaderT r m b
m f :: 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
r ->
m b -> m c -> m b
forall a (m :: * -> *) b c. MonadBench a 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 a m => MonadBench a (StateT r m) where
getBenchmark :: StateT r m (Benchmark a)
getBenchmark = m (Benchmark a) -> StateT r m (Benchmark a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Benchmark a) -> StateT r m (Benchmark a))
-> m (Benchmark a) -> StateT r m (Benchmark a)
forall a b. (a -> b) -> a -> b
$ m (Benchmark a)
forall a (m :: * -> *). MonadBench a m => m (Benchmark a)
getBenchmark
putBenchmark :: Benchmark a -> 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 a -> m ()) -> Benchmark a -> StateT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark a -> m ()
forall a (m :: * -> *). MonadBench a m => Benchmark a -> m ()
putBenchmark
modifyBenchmark :: (Benchmark a -> Benchmark a) -> 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 a -> Benchmark a) -> m ())
-> (Benchmark a -> Benchmark a)
-> StateT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Benchmark a -> Benchmark a) -> m ()
forall a (m :: * -> *).
MonadBench a m =>
(Benchmark a -> Benchmark a) -> m ()
modifyBenchmark
finally :: StateT r m b -> StateT r m c -> StateT r m b
finally m :: StateT r m b
m f :: 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
$ \s :: r
s ->
m (b, r) -> m (c, r) -> m (b, r)
forall a (m :: * -> *) b c. MonadBench a 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)
setBenchmarking :: MonadBench a m => BenchmarkOn a -> m ()
setBenchmarking :: BenchmarkOn a -> m ()
setBenchmarking b :: BenchmarkOn a
b = (Benchmark a -> Benchmark a) -> m ()
forall a (m :: * -> *).
MonadBench a m =>
(Benchmark a -> Benchmark a) -> m ()
modifyBenchmark ((Benchmark a -> Benchmark a) -> m ())
-> (Benchmark a -> Benchmark a) -> m ()
forall a b. (a -> b) -> a -> b
$ (BenchmarkOn a -> BenchmarkOn a) -> Benchmark a -> Benchmark a
forall a.
(BenchmarkOn a -> BenchmarkOn a) -> Benchmark a -> Benchmark a
mapBenchmarkOn ((BenchmarkOn a -> BenchmarkOn a) -> Benchmark a -> Benchmark a)
-> (BenchmarkOn a -> BenchmarkOn a) -> Benchmark a -> Benchmark a
forall a b. (a -> b) -> a -> b
$ BenchmarkOn a -> BenchmarkOn a -> BenchmarkOn a
forall a b. a -> b -> a
const BenchmarkOn a
b
switchBenchmarking :: MonadBench a m
=> Strict.Maybe (Account a)
-> m (Strict.Maybe (Account a))
switchBenchmarking :: Maybe (Account a) -> m (Maybe (Account a))
switchBenchmarking newAccount :: Maybe (Account a)
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
CurrentAccount a
oldAccount <- (Benchmark a -> CurrentAccount a) -> m (CurrentAccount a)
forall a (m :: * -> *) c.
MonadBench a m =>
(Benchmark a -> c) -> m c
getsBenchmark Benchmark a -> CurrentAccount a
forall a. Benchmark a -> CurrentAccount a
currentAccount
CurrentAccount a -> ((Account a, CPUTime) -> m ()) -> m ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
Strict.whenJust CurrentAccount a
oldAccount (((Account a, CPUTime) -> m ()) -> m ())
-> ((Account a, CPUTime) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ (acc :: Account a
acc, start :: CPUTime
start) ->
(Benchmark a -> Benchmark a) -> m ()
forall a (m :: * -> *).
MonadBench a m =>
(Benchmark a -> Benchmark a) -> m ()
modifyBenchmark ((Benchmark a -> Benchmark a) -> m ())
-> (Benchmark a -> Benchmark a) -> m ()
forall a b. (a -> b) -> a -> b
$ Account a -> CPUTime -> Benchmark a -> Benchmark a
forall a.
Ord a =>
Account a -> CPUTime -> Benchmark a -> Benchmark a
addCPUTime Account a
acc (CPUTime -> Benchmark a -> Benchmark a)
-> CPUTime -> Benchmark a -> Benchmark a
forall a b. (a -> b) -> a -> b
$ CPUTime
now CPUTime -> CPUTime -> CPUTime
forall a. Num a => a -> a -> a
- CPUTime
start
(Benchmark a -> Benchmark a) -> m ()
forall a (m :: * -> *).
MonadBench a m =>
(Benchmark a -> Benchmark a) -> m ()
modifyBenchmark ((Benchmark a -> Benchmark a) -> m ())
-> (Benchmark a -> Benchmark a) -> m ()
forall a b. (a -> b) -> a -> b
$ (CurrentAccount a -> CurrentAccount a)
-> Benchmark a -> Benchmark a
forall a.
(CurrentAccount a -> CurrentAccount a)
-> Benchmark a -> Benchmark a
mapCurrentAccount ((CurrentAccount a -> CurrentAccount a)
-> Benchmark a -> Benchmark a)
-> (CurrentAccount a -> CurrentAccount a)
-> Benchmark a
-> Benchmark a
forall a b. (a -> b) -> a -> b
$ CurrentAccount a -> CurrentAccount a -> CurrentAccount a
forall a b. a -> b -> a
const (CurrentAccount a -> CurrentAccount a -> CurrentAccount a)
-> CurrentAccount a -> CurrentAccount a -> CurrentAccount a
forall a b. (a -> b) -> a -> b
$ (, CPUTime
now) (Account a -> (Account a, CPUTime))
-> Maybe (Account a) -> CurrentAccount a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Account a)
newAccount
Maybe (Account a) -> m (Maybe (Account a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Account a) -> m (Maybe (Account a)))
-> Maybe (Account a) -> m (Maybe (Account a))
forall a b. (a -> b) -> a -> b
$ (Account a, CPUTime) -> Account a
forall a b. (a, b) -> a
fst ((Account a, CPUTime) -> Account a)
-> CurrentAccount a -> Maybe (Account a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CurrentAccount a
oldAccount
reset :: MonadBench a m => m ()
reset :: m ()
reset = (Benchmark a -> Benchmark a) -> m ()
forall a (m :: * -> *).
MonadBench a m =>
(Benchmark a -> Benchmark a) -> m ()
modifyBenchmark ((Benchmark a -> Benchmark a) -> m ())
-> (Benchmark a -> Benchmark a) -> m ()
forall a b. (a -> b) -> a -> b
$
(CurrentAccount a -> CurrentAccount a)
-> Benchmark a -> Benchmark a
forall a.
(CurrentAccount a -> CurrentAccount a)
-> Benchmark a -> Benchmark a
mapCurrentAccount (CurrentAccount a -> CurrentAccount a -> CurrentAccount a
forall a b. a -> b -> a
const CurrentAccount a
forall a. Maybe a
Strict.Nothing) (Benchmark a -> Benchmark a)
-> (Benchmark a -> Benchmark a) -> Benchmark a -> Benchmark a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Timings a -> Timings a) -> Benchmark a -> Benchmark a
forall a. (Timings a -> Timings a) -> Benchmark a -> Benchmark a
mapTimings (Timings a -> Timings a -> Timings a
forall a b. a -> b -> a
const Timings a
forall a. Null a => a
Trie.empty)
billTo :: MonadBench a m => Account a -> m c -> m c
billTo :: Account a -> m c -> m c
billTo account :: Account a
account m :: 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 a -> BenchmarkOn a -> Bool
forall a. Account a -> BenchmarkOn a -> Bool
isBenchmarkOn Account a
account (BenchmarkOn a -> Bool) -> m (BenchmarkOn a) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Benchmark a -> BenchmarkOn a) -> m (BenchmarkOn a)
forall a (m :: * -> *) c.
MonadBench a m =>
(Benchmark a -> c) -> m c
getsBenchmark Benchmark a -> BenchmarkOn a
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
Maybe (Account a)
old <- Maybe (Account a) -> m (Maybe (Account a))
forall a (m :: * -> *).
MonadBench a m =>
Maybe (Account a) -> m (Maybe (Account a))
switchBenchmarking (Maybe (Account a) -> m (Maybe (Account a)))
-> Maybe (Account a) -> m (Maybe (Account a))
forall a b. (a -> b) -> a -> b
$ Account a -> Maybe (Account a)
forall a. a -> Maybe a
Strict.Just Account a
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 a)) -> m c
forall a (m :: * -> *) b c. MonadBench a m => m b -> m c -> m b
`finally` Maybe (Account a) -> m (Maybe (Account a))
forall a (m :: * -> *).
MonadBench a m =>
Maybe (Account a) -> m (Maybe (Account a))
switchBenchmarking Maybe (Account a)
old
billToCPS :: MonadBench a m => Account a -> ((b -> m c) -> m c) -> (b -> m c) -> m c
billToCPS :: Account a -> ((b -> m c) -> m c) -> (b -> m c) -> m c
billToCPS account :: Account a
account f :: (b -> m c) -> m c
f k :: 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 a -> BenchmarkOn a -> Bool
forall a. Account a -> BenchmarkOn a -> Bool
isBenchmarkOn Account a
account (BenchmarkOn a -> Bool) -> m (BenchmarkOn a) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Benchmark a -> BenchmarkOn a) -> m (BenchmarkOn a)
forall a (m :: * -> *) c.
MonadBench a m =>
(Benchmark a -> c) -> m c
getsBenchmark Benchmark a -> BenchmarkOn a
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
Maybe (Account a)
old <- Maybe (Account a) -> m (Maybe (Account a))
forall a (m :: * -> *).
MonadBench a m =>
Maybe (Account a) -> m (Maybe (Account a))
switchBenchmarking (Maybe (Account a) -> m (Maybe (Account a)))
-> Maybe (Account a) -> m (Maybe (Account a))
forall a b. (a -> b) -> a -> b
$ Account a -> Maybe (Account a)
forall a. a -> Maybe a
Strict.Just Account a
account
(b -> m c) -> m c
f ((b -> m c) -> m c) -> (b -> m c) -> m c
forall a b. (a -> b) -> a -> b
$ \ x :: b
x -> b
x b -> m c -> m c
forall a b. a -> b -> b
`seq` do
Maybe (Account a)
_ <- Maybe (Account a) -> m (Maybe (Account a))
forall a (m :: * -> *).
MonadBench a m =>
Maybe (Account a) -> m (Maybe (Account a))
switchBenchmarking Maybe (Account a)
old
b -> m c
k b
x
billPureTo :: MonadBench a m => Account a -> c -> m c
billPureTo :: Account a -> c -> m c
billPureTo account :: Account a
account = Account a -> m c -> m c
forall a (m :: * -> *) c. MonadBench a m => Account a -> m c -> m c
billTo Account a
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