{-# LANGUAGE OverloadedStrings #-}
module Perf.Types
(
Measure (..),
repeated,
StepMeasure (..),
toMeasure,
toMeasureN,
step,
stepM,
multi,
multiM,
fap,
afap,
ffap,
fan,
fam,
(|$|),
($|),
(|+|),
PerfT (..),
Perf,
runPerfT,
evalPerfT,
execPerfT,
outer,
slop,
slops,
)
where
import Control.DeepSeq
import Control.Monad
import Control.Monad.State.Lazy
import Data.Bifunctor
import Data.Functor.Identity
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Prelude
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)
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)
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 #-}
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)
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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)
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
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
(|$|) :: (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 (|$|) #-}
($|) :: (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 ($|) #-}
(|+|) :: (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 (|+|) #-}
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 #-}
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 #-}
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 #-}
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)
)
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)
)
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)
)