{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}

-- | Abstract types of performance measurement.
module Perf.Types
  ( Measure (..),
    repeated,
    StepMeasure (..),
    toMeasure,
    toMeasureN,
    step,
    stepM,
    multi,
    multiM,

    -- * function application
    fap,
    afap,
    ffap,
    fan,
    fam,
    (|$|),
    ($|),
    (|+|),

    -- * PerfT monad
    PerfT (..),
    Perf,
    runPerfT,
    evalPerfT,
    execPerfT,
    outer,
    slop,
    slops,
  )
where

import Control.DeepSeq
import Control.Monad.State.Lazy
import Data.Bifunctor
import Data.Functor.Identity
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import Prelude

-- | Abstraction of a performance measurement within a monadic context.
--
-- - measure applies a function to a value, returning a tuple of the performance measure, and the computation result.
-- - measureM evaluates a monadic value and returns a performance-result tuple.
data Measure m t = Measure
  { forall (m :: * -> *) t.
Measure m t -> forall a b. (a -> b) -> a -> m (t, b)
measure :: forall a b. (a -> b) -> a -> m (t, b),
    forall (m :: * -> *) t. Measure m t -> forall a. m a -> m (t, a)
measureM :: forall a. m a -> m (t, a)
  }

instance (Functor m) => Functor (Measure m) where
  fmap :: forall a b. (a -> b) -> Measure m a -> Measure m b
fmap a -> b
f (Measure forall a b. (a -> b) -> a -> m (a, b)
m forall a. m a -> m (a, a)
n) =
    forall (m :: * -> *) t.
(forall a b. (a -> b) -> a -> m (t, b))
-> (forall a. m a -> m (t, a)) -> Measure m t
Measure
      (\a -> b
f' a
a' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) (forall a b. (a -> b) -> a -> m (a, b)
m a -> b
f' a
a'))
      (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> m (a, a)
n)

-- | An inefficient application that runs the inner action twice.
instance (Applicative m) => Applicative (Measure m) where
  pure :: forall a. a -> Measure m a
pure a
t = forall (m :: * -> *) t.
(forall a b. (a -> b) -> a -> m (t, b))
-> (forall a. m a -> m (t, a)) -> Measure m t
Measure (\a -> b
f a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
t, a -> b
f a
a)) (\m a
a -> (a
t,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
a)
  (Measure forall a b. (a -> b) -> a -> m (a -> b, b)
mf forall a. m a -> m (a -> b, a)
nf) <*> :: forall a b. Measure m (a -> b) -> Measure m a -> Measure m b
<*> (Measure forall a b. (a -> b) -> a -> m (a, b)
mt forall a. m a -> m (a, a)
nt) =
    forall (m :: * -> *) t.
(forall a b. (a -> b) -> a -> m (t, b))
-> (forall a. m a -> m (t, a)) -> Measure m t
Measure
      (\a -> b
f a
a -> (\(a -> b
nf', b
fa') (a
t', b
_) -> (a -> b
nf' a
t', b
fa')) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> b) -> a -> m (a -> b, b)
mf a -> b
f a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (a -> b) -> a -> m (a, b)
mt a -> b
f a
a)
      (\m a
a -> (\(a -> b
nf', a
a') (a
t', a
_) -> (a -> b
nf' a
t', a
a')) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. m a -> m (a -> b, a)
nf m a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. m a -> m (a, a)
nt m a
a)

-- | Convert a Measure into a multi measure.
repeated :: (Applicative m) => Int -> Measure m t -> Measure m [t]
repeated :: forall (m :: * -> *) t.
Applicative m =>
Int -> Measure m t -> Measure m [t]
repeated Int
n (Measure forall a b. (a -> b) -> a -> m (t, b)
p forall a. m a -> m (t, a)
m) =
  forall (m :: * -> *) t.
(forall a b. (a -> b) -> a -> m (t, b))
-> (forall a. m a -> m (t, a)) -> Measure m t
Measure
    (\a -> b
f a
a -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[(t, b)]
xs -> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(t, b)]
xs, forall a b. (a, b) -> b
snd (forall a. [a] -> a
head [(t, b)]
xs))) (forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (forall a b. (a -> b) -> a -> m (t, b)
p a -> b
f a
a)))
    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[(t, a)]
xs -> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(t, a)]
xs, forall a b. (a, b) -> b
snd (forall a. [a] -> a
head [(t, a)]
xs))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> m (t, a)
m)
{-# INLINEABLE repeated #-}

-- | Abstraction of a performance measurement with a pre and a post step wrapping the computation.
data StepMeasure m t = forall i. StepMeasure {()
pre :: m i, ()
post :: i -> m t}

instance (Functor m) => Functor (StepMeasure m) where
  fmap :: forall a b. (a -> b) -> StepMeasure m a -> StepMeasure m b
fmap a -> b
f (StepMeasure m i
start i -> m a
stop) = forall (m :: * -> *) t i. m i -> (i -> m t) -> StepMeasure m t
StepMeasure m i
start (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> m a
stop)

instance (Applicative m) => Applicative (StepMeasure m) where
  pure :: forall a. a -> StepMeasure m a
pure a
t = forall (m :: * -> *) t i. m i -> (i -> m t) -> StepMeasure m t
StepMeasure (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
t))
  <*> :: forall a b.
StepMeasure m (a -> b) -> StepMeasure m a -> StepMeasure m b
(<*>) (StepMeasure m i
fstart i -> m (a -> b)
fstop) (StepMeasure m i
start i -> m a
stop) =
    forall (m :: * -> *) t i. m i -> (i -> m t) -> StepMeasure m t
StepMeasure ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m i
fstart forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m i
start) (\(i
fi, i
i) -> i -> m (a -> b)
fstop i
fi forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> i -> m a
stop i
i)

-- | Convert a StepMeasure into a Measure
toMeasure :: (Monad m) => StepMeasure m t -> Measure m t
toMeasure :: forall (m :: * -> *) t. Monad m => StepMeasure m t -> Measure m t
toMeasure (StepMeasure m i
pre' i -> m t
post') = forall (m :: * -> *) t.
(forall a b. (a -> b) -> a -> m (t, b))
-> (forall a. m a -> m (t, a)) -> Measure m t
Measure (forall (m :: * -> *) i t a b.
Monad m =>
m i -> (i -> m t) -> (a -> b) -> a -> m (t, b)
step m i
pre' i -> m t
post') (forall (m :: * -> *) i t a.
Monad m =>
m i -> (i -> m t) -> m a -> m (t, a)
stepM m i
pre' i -> m t
post')
{-# INLINEABLE toMeasure #-}

-- | Convert a StepMeasure into a Measure running the computation multiple times.
toMeasureN :: (Monad m) => Int -> StepMeasure m t -> Measure m [t]
toMeasureN :: forall (m :: * -> *) t.
Monad m =>
Int -> StepMeasure m t -> Measure m [t]
toMeasureN Int
n (StepMeasure m i
pre' i -> m t
post') = forall (m :: * -> *) t.
(forall a b. (a -> b) -> a -> m (t, b))
-> (forall a. m a -> m (t, a)) -> Measure m t
Measure (forall (m :: * -> *) a b t.
Monad m =>
((a -> b) -> a -> m (t, b)) -> Int -> (a -> b) -> a -> m ([t], b)
multi (forall (m :: * -> *) i t a b.
Monad m =>
m i -> (i -> m t) -> (a -> b) -> a -> m (t, b)
step m i
pre' i -> m t
post') Int
n) (forall (m :: * -> *) a t.
Monad m =>
(m a -> m (t, a)) -> Int -> m a -> m ([t], a)
multiM (forall (m :: * -> *) i t a.
Monad m =>
m i -> (i -> m t) -> m a -> m (t, a)
stepM m i
pre' i -> m t
post') Int
n)
{-# INLINEABLE toMeasureN #-}

-- | A single step measurement.
step :: (Monad m) => m i -> (i -> m t) -> (a -> b) -> a -> m (t, b)
step :: forall (m :: * -> *) i t a b.
Monad m =>
m i -> (i -> m t) -> (a -> b) -> a -> m (t, b)
step m i
pre' i -> m t
post' !a -> b
f !a
a = do
  !i
p <- m i
pre'
  !b
b <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! a -> b
f a
a
  !t
t <- i -> m t
post' i
p
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (t
t, b
b)
{-# INLINEABLE step #-}

-- | A single step measurement.
stepM :: (Monad m) => m i -> (i -> m t) -> m a -> m (t, a)
stepM :: forall (m :: * -> *) i t a.
Monad m =>
m i -> (i -> m t) -> m a -> m (t, a)
stepM m i
pre' i -> m t
post' m a
a = do
  !i
p <- m i
pre'
  !a
ma <- m a
a
  !t
t <- i -> m t
post' i
p
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (t
t, a
ma)
{-# INLINEABLE stepM #-}

-- | Multiple measurement
multi :: (Monad m) => ((a -> b) -> a -> m (t, b)) -> Int -> (a -> b) -> a -> m ([t], b)
multi :: forall (m :: * -> *) a b t.
Monad m =>
((a -> b) -> a -> m (t, b)) -> Int -> (a -> b) -> a -> m ([t], b)
multi (a -> b) -> a -> m (t, b)
action Int
n !a -> b
f !a
a =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[(t, b)]
xs -> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(t, b)]
xs, forall a b. (a, b) -> b
snd (forall a. [a] -> a
head [(t, b)]
xs))) (forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n ((a -> b) -> a -> m (t, b)
action a -> b
f a
a))
{-# INLINEABLE multi #-}

-- | Multiple measurements
multiM :: (Monad m) => (m a -> m (t, a)) -> Int -> m a -> m ([t], a)
multiM :: forall (m :: * -> *) a t.
Monad m =>
(m a -> m (t, a)) -> Int -> m a -> m ([t], a)
multiM m a -> m (t, a)
action Int
n m a
a =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[(t, a)]
xs -> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(t, a)]
xs, forall a b. (a, b) -> b
snd (forall a. [a] -> a
head [(t, a)]
xs))) (forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (m a -> m (t, a)
action m a
a))
{-# INLINEABLE multiM #-}

-- | Performance measurement transformer storing a 'Measure' and a map of named results.
newtype PerfT m t a = PerfT
  { forall (m :: * -> *) t a.
PerfT m t a -> StateT (Measure m t, Map Text t) m a
measurePerf :: StateT (Measure m t, Map.Map Text t) m a
  }
  deriving (forall a b. a -> PerfT m t b -> PerfT m t a
forall a b. (a -> b) -> PerfT m t a -> PerfT m t b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) t a b.
Functor m =>
a -> PerfT m t b -> PerfT m t a
forall (m :: * -> *) t a b.
Functor m =>
(a -> b) -> PerfT m t a -> PerfT m t b
<$ :: forall a b. a -> PerfT m t b -> PerfT m t a
$c<$ :: forall (m :: * -> *) t a b.
Functor m =>
a -> PerfT m t b -> PerfT m t a
fmap :: forall a b. (a -> b) -> PerfT m t a -> PerfT m t b
$cfmap :: forall (m :: * -> *) t a b.
Functor m =>
(a -> b) -> PerfT m t a -> PerfT m t b
Functor, forall a. a -> PerfT m t a
forall a b. PerfT m t a -> PerfT m t b -> PerfT m t a
forall a b. PerfT m t a -> PerfT m t b -> PerfT m t b
forall a b. PerfT m t (a -> b) -> PerfT m t a -> PerfT m t b
forall a b c.
(a -> b -> c) -> PerfT m t a -> PerfT m t b -> PerfT m t c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *} {t}. Monad m => Functor (PerfT m t)
forall (m :: * -> *) t a. Monad m => a -> PerfT m t a
forall (m :: * -> *) t a b.
Monad m =>
PerfT m t a -> PerfT m t b -> PerfT m t a
forall (m :: * -> *) t a b.
Monad m =>
PerfT m t a -> PerfT m t b -> PerfT m t b
forall (m :: * -> *) t a b.
Monad m =>
PerfT m t (a -> b) -> PerfT m t a -> PerfT m t b
forall (m :: * -> *) t a b c.
Monad m =>
(a -> b -> c) -> PerfT m t a -> PerfT m t b -> PerfT m t c
<* :: forall a b. PerfT m t a -> PerfT m t b -> PerfT m t a
$c<* :: forall (m :: * -> *) t a b.
Monad m =>
PerfT m t a -> PerfT m t b -> PerfT m t a
*> :: forall a b. PerfT m t a -> PerfT m t b -> PerfT m t b
$c*> :: forall (m :: * -> *) t a b.
Monad m =>
PerfT m t a -> PerfT m t b -> PerfT m t b
liftA2 :: forall a b c.
(a -> b -> c) -> PerfT m t a -> PerfT m t b -> PerfT m t c
$cliftA2 :: forall (m :: * -> *) t a b c.
Monad m =>
(a -> b -> c) -> PerfT m t a -> PerfT m t b -> PerfT m t c
<*> :: forall a b. PerfT m t (a -> b) -> PerfT m t a -> PerfT m t b
$c<*> :: forall (m :: * -> *) t a b.
Monad m =>
PerfT m t (a -> b) -> PerfT m t a -> PerfT m t b
pure :: forall a. a -> PerfT m t a
$cpure :: forall (m :: * -> *) t a. Monad m => a -> PerfT m t a
Applicative, forall a. a -> PerfT m t a
forall a b. PerfT m t a -> PerfT m t b -> PerfT m t b
forall a b. PerfT m t a -> (a -> PerfT m t b) -> PerfT m t b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (m :: * -> *) t. Monad m => Applicative (PerfT m t)
forall (m :: * -> *) t a. Monad m => a -> PerfT m t a
forall (m :: * -> *) t a b.
Monad m =>
PerfT m t a -> PerfT m t b -> PerfT m t b
forall (m :: * -> *) t a b.
Monad m =>
PerfT m t a -> (a -> PerfT m t b) -> PerfT m t b
return :: forall a. a -> PerfT m t a
$creturn :: forall (m :: * -> *) t a. Monad m => a -> PerfT m t a
>> :: forall a b. PerfT m t a -> PerfT m t b -> PerfT m t b
$c>> :: forall (m :: * -> *) t a b.
Monad m =>
PerfT m t a -> PerfT m t b -> PerfT m t b
>>= :: forall a b. PerfT m t a -> (a -> PerfT m t b) -> PerfT m t b
$c>>= :: forall (m :: * -> *) t a b.
Monad m =>
PerfT m t a -> (a -> PerfT m t b) -> PerfT m t b
Monad)

-- | The transformer over Identity
type Perf t a = PerfT Identity t a

instance (MonadIO m) => MonadIO (PerfT m t) where
  liftIO :: forall a. IO a -> PerfT m t a
liftIO = forall (m :: * -> *) t a.
StateT (Measure m t, Map Text t) m a -> PerfT m t a
PerfT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | Lift an application to a PerfT m, providing a label and a 'Measure'.
--
-- Measurements with the same label will be mappended
fap :: (MonadIO m, Semigroup t) => Text -> (a -> b) -> a -> PerfT m t b
fap :: forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label a -> b
f a
a =
  forall (m :: * -> *) t a.
StateT (Measure m t, Map Text t) m a -> PerfT m t a
PerfT forall a b. (a -> b) -> a -> b
$ do
    Measure m t
m <- forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
    (t
t, b
fa) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) t.
Measure m t -> forall a b. (a -> b) -> a -> m (t, b)
measure Measure m t
m a -> b
f a
a
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Semigroup a => a -> a -> a
(<>) Text
label t
t)
    forall (m :: * -> *) a. Monad m => a -> m a
return b
fa
{-# INLINEABLE fap #-}

-- | Lift an application to a PerfT m, forcing the argument.
afap :: (NFData a, MonadIO m, Semigroup t) => Text -> (a -> b) -> a -> PerfT m t b
afap :: forall a (m :: * -> *) t b.
(NFData a, MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
afap Text
label a -> b
f a
a = forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label a -> b
f (forall a. NFData a => a -> a
force a
a)
{-# INLINEABLE afap #-}

-- | Lift an application to a PerfT m, forcing argument and result.
ffap :: (NFData a, NFData b, MonadIO m, Semigroup t) => Text -> (a -> b) -> a -> PerfT m t b
ffap :: forall a b (m :: * -> *) t.
(NFData a, NFData b, MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
ffap Text
label a -> b
f a
a = forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label (forall a. NFData a => a -> a
force forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (forall a. NFData a => a -> a
force a
a)
{-# INLINEABLE ffap #-}

-- | Lift a number to a PerfT m, providing a label, function, and input.
--
-- Measurements with the same label will be added
fan :: (MonadIO m, Num t) => Text -> (a -> b) -> a -> PerfT m t b
fan :: forall (m :: * -> *) t a b.
(MonadIO m, Num t) =>
Text -> (a -> b) -> a -> PerfT m t b
fan Text
label a -> b
f a
a =
  forall (m :: * -> *) t a.
StateT (Measure m t, Map Text t) m a -> PerfT m t a
PerfT forall a b. (a -> b) -> a -> b
$ do
    Measure m t
m <- forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
    (t
t, b
fa) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) t.
Measure m t -> forall a b. (a -> b) -> a -> m (t, b)
measure Measure m t
m a -> b
f a
a
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Num a => a -> a -> a
(+) Text
label t
t)
    forall (m :: * -> *) a. Monad m => a -> m a
return b
fa
{-# INLINEABLE fan #-}

-- | Lift a monadic value to a PerfT m, providing a label and a 'Measure'.
--
-- Measurements with the same label will be added
fam :: (MonadIO m, Semigroup t) => Text -> m a -> PerfT m t a
fam :: forall (m :: * -> *) t a.
(MonadIO m, Semigroup t) =>
Text -> m a -> PerfT m t a
fam Text
label m a
a =
  forall (m :: * -> *) t a.
StateT (Measure m t, Map Text t) m a -> PerfT m t a
PerfT forall a b. (a -> b) -> a -> b
$ do
    Measure m t
m <- forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
    (t
t, a
ma) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) t. Measure m t -> forall a. m a -> m (t, a)
measureM Measure m t
m m a
a
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Semigroup a => a -> a -> a
(<>) Text
label t
t)
    forall (m :: * -> *) a. Monad m => a -> m a
return a
ma
{-# INLINEABLE fam #-}

-- | lift a pure, unnamed function application to PerfT
(|$|) :: (Semigroup t) => (a -> b) -> a -> PerfT IO t b
|$| :: forall t a b. Semigroup t => (a -> b) -> a -> PerfT IO t b
(|$|) a -> b
f a
a = forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
"" a -> b
f a
a
{-# INLINEABLE (|$|) #-}

-- | lift a monadic, unnamed function application to PerfT
($|) :: (Semigroup t) => IO a -> PerfT IO t a
$| :: forall t a. Semigroup t => IO a -> PerfT IO t a
($|) IO a
a = forall (m :: * -> *) t a.
(MonadIO m, Semigroup t) =>
Text -> m a -> PerfT m t a
fam Text
"" IO a
a
{-# INLINEABLE ($|) #-}

-- | lift an unnamed numeric measure to PerfT
(|+|) :: (Num t) => (a -> b) -> a -> PerfT IO t b
|+| :: forall t a b. Num t => (a -> b) -> a -> PerfT IO t b
(|+|) a -> b
f a
a = forall (m :: * -> *) t a b.
(MonadIO m, Num t) =>
Text -> (a -> b) -> a -> PerfT m t b
fan Text
"" a -> b
f a
a
{-# INLINEABLE (|+|) #-}

-- | Run the performance measure, returning (computational result, measurement).
runPerfT :: (Functor m) => Measure m t -> PerfT m t a -> m (a, Map.Map Text t)
runPerfT :: forall (m :: * -> *) t a.
Functor m =>
Measure m t -> PerfT m t a -> m (a, Map Text t)
runPerfT Measure m t
m PerfT m t a
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a b. (a, b) -> b
snd) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Measure m t
m, forall k a. Map k a
Map.empty) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) t a.
PerfT m t a -> StateT (Measure m t, Map Text t) m a
measurePerf PerfT m t a
p
{-# INLINEABLE runPerfT #-}

-- | Consume the PerfT layer and return the original monadic result.
-- Fingers crossed, PerfT structure should be completely compiled away.
evalPerfT :: (Monad m) => Measure m t -> PerfT m t a -> m a
evalPerfT :: forall (m :: * -> *) t a.
Monad m =>
Measure m t -> PerfT m t a -> m a
evalPerfT Measure m t
m PerfT m t a
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Measure m t
m, forall k a. Map k a
Map.empty) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) t a.
PerfT m t a -> StateT (Measure m t, Map Text t) m a
measurePerf PerfT m t a
p
{-# INLINEABLE evalPerfT #-}

-- | Consume a PerfT layer and return the measurement.
execPerfT :: (Monad m) => Measure m t -> PerfT m t a -> m (Map.Map Text t)
execPerfT :: forall (m :: * -> *) t a.
Monad m =>
Measure m t -> PerfT m t a -> m (Map Text t)
execPerfT Measure m t
m PerfT m t a
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (Measure m t
m, forall k a. Map k a
Map.empty) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) t a.
PerfT m t a -> StateT (Measure m t, Map Text t) m a
measurePerf PerfT m t a
p
{-# INLINEABLE execPerfT #-}

-- | run a PerfT and also calculate performance over the entire computation
outer :: (MonadIO m, Semigroup s) => Text -> Measure m s -> Measure m t -> PerfT m t a -> m (a, (Map.Map Text s, Map.Map Text t))
outer :: forall (m :: * -> *) s t a.
(MonadIO m, Semigroup s) =>
Text
-> Measure m s
-> Measure m t
-> PerfT m t a
-> m (a, (Map Text s, Map Text t))
outer Text
label Measure m s
outerm Measure m t
meas PerfT m t a
p =
  (\((a
a, Map Text t
m), Map Text s
m') -> (a
a, (Map Text s
m', Map Text t
m)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) t a.
Functor m =>
Measure m t -> PerfT m t a -> m (a, Map Text t)
runPerfT
      Measure m s
outerm
      ( forall (m :: * -> *) t a.
(MonadIO m, Semigroup t) =>
Text -> m a -> PerfT m t a
fam Text
label (forall (m :: * -> *) t a.
Functor m =>
Measure m t -> PerfT m t a -> m (a, Map Text t)
runPerfT Measure m t
meas PerfT m t a
p)
      )

-- | run a PerfT and calculate excess performance over the entire computation
slop :: (MonadIO m, Num t, Semigroup t) => Text -> Measure m t -> PerfT m t a -> m (a, Map.Map Text t)
slop :: forall (m :: * -> *) t a.
(MonadIO m, Num t, Semigroup t) =>
Text -> Measure m t -> PerfT m t a -> m (a, Map Text t)
slop Text
l Measure m t
meas PerfT m t a
p =
  (\((a
a, Map Text t
m), Map Text t
m') -> (a
a, Map Text t
m forall a. Semigroup a => a -> a -> a
<> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"slop" (Map Text t
m' forall k a. Ord k => Map k a -> k -> a
Map.! Text
l forall a. Num a => a -> a -> a
- forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall a. Num a => a -> a -> a
(+) t
0 Map Text t
m) Map Text t
m'))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) t a.
Functor m =>
Measure m t -> PerfT m t a -> m (a, Map Text t)
runPerfT
      Measure m t
meas
      ( forall (m :: * -> *) t a.
(MonadIO m, Semigroup t) =>
Text -> m a -> PerfT m t a
fam Text
l (forall (m :: * -> *) t a.
Functor m =>
Measure m t -> PerfT m t a -> m (a, Map Text t)
runPerfT Measure m t
meas PerfT m t a
p)
      )

-- | run a multi PerfT and calculate excess performance over the entire computation
slops :: (MonadIO m, Num t, Semigroup t) => Int -> Measure m t -> PerfT m [t] a -> m (a, (Map.Map Text t, Map.Map Text [t]))
slops :: forall (m :: * -> *) t a.
(MonadIO m, Num t, Semigroup t) =>
Int
-> Measure m t
-> PerfT m [t] a
-> m (a, (Map Text t, Map Text [t]))
slops Int
n Measure m t
meas PerfT m [t] a
p =
  (\((a
a, Map Text [t]
ms), Map Text t
m') -> (a
a, (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"slop" (Map Text t
m' forall k a. Ord k => Map k a -> k -> a
Map.! Text
"outer" forall a. Num a => a -> a -> a
- forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall a. Num a => a -> a -> a
(+) t
0 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Map Text [t]
ms)) Map Text t
m', Map Text [t]
ms)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) t a.
Functor m =>
Measure m t -> PerfT m t a -> m (a, Map Text t)
runPerfT
      Measure m t
meas
      ( forall (m :: * -> *) t a.
(MonadIO m, Semigroup t) =>
Text -> m a -> PerfT m t a
fam Text
"outer" (forall (m :: * -> *) t a.
Functor m =>
Measure m t -> PerfT m t a -> m (a, Map Text t)
runPerfT (forall (m :: * -> *) t.
Applicative m =>
Int -> Measure m t -> Measure m [t]
repeated Int
n Measure m t
meas) PerfT m [t] a
p)
      )