{-# LANGUAGE OverloadedStrings #-}

-- | Unification of the various different performance measure types, mostly to unify reporting and data management.
module Perf.Measure
  ( MeasureType (..),
    parseMeasure,
    measureDs,
    measureLabels,
    measureFinalStat,
  )
where

import Data.Text (Text)
import Options.Applicative
import Options.Applicative.Help.Pretty qualified as OA
import Perf.Count
import Perf.Space
import Perf.Stats
import Perf.Time
import Perf.Types
import System.Clock
import Prelude hiding (cycle)

-- | Command-line measurement options.
data MeasureType = MeasureTime | MeasureNTime | MeasureSpace | MeasureSpaceTime | MeasureAllocation | MeasureCount deriving (MeasureType -> MeasureType -> Bool
(MeasureType -> MeasureType -> Bool)
-> (MeasureType -> MeasureType -> Bool) -> Eq MeasureType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MeasureType -> MeasureType -> Bool
== :: MeasureType -> MeasureType -> Bool
$c/= :: MeasureType -> MeasureType -> Bool
/= :: MeasureType -> MeasureType -> Bool
Eq, Int -> MeasureType -> ShowS
[MeasureType] -> ShowS
MeasureType -> String
(Int -> MeasureType -> ShowS)
-> (MeasureType -> String)
-> ([MeasureType] -> ShowS)
-> Show MeasureType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MeasureType -> ShowS
showsPrec :: Int -> MeasureType -> ShowS
$cshow :: MeasureType -> String
show :: MeasureType -> String
$cshowList :: [MeasureType] -> ShowS
showList :: [MeasureType] -> ShowS
Show)

-- | Parse command-line 'MeasureType' options.
parseMeasure :: Parser MeasureType
parseMeasure :: Parser MeasureType
parseMeasure =
  MeasureType -> Mod FlagFields MeasureType -> Parser MeasureType
forall a. a -> Mod FlagFields a -> Parser a
flag' MeasureType
MeasureTime (String -> Mod FlagFields MeasureType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"time" Mod FlagFields MeasureType
-> Mod FlagFields MeasureType -> Mod FlagFields MeasureType
forall a. Semigroup a => a -> a -> a
<> (Doc -> Doc) -> Mod FlagFields MeasureType
forall (f :: * -> *) a. (Doc -> Doc) -> Mod f a
style (AnsiStyle -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
OA.annotate AnsiStyle
OA.bold) Mod FlagFields MeasureType
-> Mod FlagFields MeasureType -> Mod FlagFields MeasureType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields MeasureType
forall (f :: * -> *) a. String -> Mod f a
help String
"measure time performance")
    Parser MeasureType -> Parser MeasureType -> Parser MeasureType
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MeasureType -> Mod FlagFields MeasureType -> Parser MeasureType
forall a. a -> Mod FlagFields a -> Parser a
flag' MeasureType
MeasureNTime (String -> Mod FlagFields MeasureType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ntime" Mod FlagFields MeasureType
-> Mod FlagFields MeasureType -> Mod FlagFields MeasureType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields MeasureType
forall (f :: * -> *) a. String -> Mod f a
help String
"measure n*time performance")
    Parser MeasureType -> Parser MeasureType -> Parser MeasureType
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MeasureType -> Mod FlagFields MeasureType -> Parser MeasureType
forall a. a -> Mod FlagFields a -> Parser a
flag' MeasureType
MeasureSpace (String -> Mod FlagFields MeasureType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"space" Mod FlagFields MeasureType
-> Mod FlagFields MeasureType -> Mod FlagFields MeasureType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields MeasureType
forall (f :: * -> *) a. String -> Mod f a
help String
"measure space performance")
    Parser MeasureType -> Parser MeasureType -> Parser MeasureType
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MeasureType -> Mod FlagFields MeasureType -> Parser MeasureType
forall a. a -> Mod FlagFields a -> Parser a
flag' MeasureType
MeasureSpaceTime (String -> Mod FlagFields MeasureType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"spacetime" Mod FlagFields MeasureType
-> Mod FlagFields MeasureType -> Mod FlagFields MeasureType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields MeasureType
forall (f :: * -> *) a. String -> Mod f a
help String
"measure both space and time performance")
    Parser MeasureType -> Parser MeasureType -> Parser MeasureType
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MeasureType -> Mod FlagFields MeasureType -> Parser MeasureType
forall a. a -> Mod FlagFields a -> Parser a
flag' MeasureType
MeasureAllocation (String -> Mod FlagFields MeasureType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"allocation" Mod FlagFields MeasureType
-> Mod FlagFields MeasureType -> Mod FlagFields MeasureType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields MeasureType
forall (f :: * -> *) a. String -> Mod f a
help String
"measure bytes allocated")
    Parser MeasureType -> Parser MeasureType -> Parser MeasureType
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MeasureType -> Mod FlagFields MeasureType -> Parser MeasureType
forall a. a -> Mod FlagFields a -> Parser a
flag' MeasureType
MeasureCount (String -> Mod FlagFields MeasureType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"count" Mod FlagFields MeasureType
-> Mod FlagFields MeasureType -> Mod FlagFields MeasureType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields MeasureType
forall (f :: * -> *) a. String -> Mod f a
help String
"measure count")
    Parser MeasureType -> Parser MeasureType -> Parser MeasureType
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MeasureType -> Parser MeasureType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MeasureType
MeasureTime

-- | unification of the different measurements to being a list of doubles.
measureDs :: MeasureType -> Clock -> Int -> Measure IO [[Double]]
measureDs :: MeasureType -> Clock -> Int -> Measure IO [[Double]]
measureDs MeasureType
mt Clock
c Int
n =
  case MeasureType
mt of
    MeasureType
MeasureTime -> (Nanos -> [Double]) -> [Nanos] -> [[Double]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: []) (Double -> [Double]) -> (Nanos -> Double) -> Nanos -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nanos -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Nanos] -> [[Double]])
-> Measure IO [Nanos] -> Measure IO [[Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Clock -> Int -> Measure IO [Nanos]
timesWith Clock
c Int
n
    MeasureType
MeasureNTime -> [Double] -> [[Double]]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Double] -> [[Double]])
-> (Nanos -> [Double]) -> Nanos -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [Double]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> [Double]) -> (Nanos -> Double) -> Nanos -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nanos -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Nanos -> [[Double]]) -> Measure IO Nanos -> Measure IO [[Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Clock -> Int -> Measure IO Nanos
timesNWith Clock
c Int
n
    MeasureType
MeasureSpace -> Int -> StepMeasure IO [Double] -> Measure IO [[Double]]
forall (m :: * -> *) t.
Monad m =>
Int -> StepMeasure m t -> Measure m [t]
toMeasureN Int
n (SpaceStats -> [Double]
forall a. Num a => SpaceStats -> [a]
ssToList (SpaceStats -> [Double])
-> StepMeasure IO SpaceStats -> StepMeasure IO [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> StepMeasure IO SpaceStats
space Bool
False)
    MeasureType
MeasureSpaceTime -> Int -> StepMeasure IO [Double] -> Measure IO [[Double]]
forall (m :: * -> *) t.
Monad m =>
Int -> StepMeasure m t -> Measure m [t]
toMeasureN Int
n ((\SpaceStats
x Nanos
y -> SpaceStats -> [Double]
forall a. Num a => SpaceStats -> [a]
ssToList SpaceStats
x [Double] -> [Double] -> [Double]
forall a. Semigroup a => a -> a -> a
<> [Nanos -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nanos
y]) (SpaceStats -> Nanos -> [Double])
-> StepMeasure IO SpaceStats -> StepMeasure IO (Nanos -> [Double])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> StepMeasure IO SpaceStats
space Bool
False StepMeasure IO (Nanos -> [Double])
-> StepMeasure IO Nanos -> StepMeasure IO [Double]
forall a b.
StepMeasure IO (a -> b) -> StepMeasure IO a -> StepMeasure IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StepMeasure IO Nanos
stepTime)
    MeasureType
MeasureAllocation -> (Bytes -> [Double]) -> [Bytes] -> [[Double]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: []) (Double -> [Double]) -> (Bytes -> Double) -> Bytes -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Bytes] -> [[Double]])
-> Measure IO [Bytes] -> Measure IO [[Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StepMeasure IO Bytes -> Measure IO [Bytes]
forall (m :: * -> *) t.
Monad m =>
Int -> StepMeasure m t -> Measure m [t]
toMeasureN Int
n (Bool -> StepMeasure IO Bytes
allocation Bool
False)
    MeasureType
MeasureCount -> ([Double] -> [[Double]] -> [[Double]]
forall a. a -> [a] -> [a]
: []) ([Double] -> [[Double]])
-> ([Int] -> [Double]) -> [Int] -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [[Double]]) -> Measure IO [Int] -> Measure IO [[Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StepMeasure IO Int -> Measure IO [Int]
forall (m :: * -> *) t.
Monad m =>
Int -> StepMeasure m t -> Measure m [t]
toMeasureN Int
n StepMeasure IO Int
forall (m :: * -> *). Applicative m => StepMeasure m Int
count

-- | unification of measurement labels
measureLabels :: MeasureType -> [Text]
measureLabels :: MeasureType -> [Text]
measureLabels MeasureType
mt =
  case MeasureType
mt of
    MeasureType
MeasureTime -> [Text
"time"]
    MeasureType
MeasureNTime -> [Text
"ntime"]
    MeasureType
MeasureSpace -> [Text]
spaceLabels
    MeasureType
MeasureSpaceTime -> [Text]
spaceLabels [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"time"]
    MeasureType
MeasureAllocation -> [Text
"allocation"]
    MeasureType
MeasureCount -> [Text
"count"]

-- | How to fold the list of performance measures.
measureFinalStat :: MeasureType -> Int -> [Double] -> Double
measureFinalStat :: MeasureType -> Int -> [Double] -> Double
measureFinalStat MeasureType
mt Int
n =
  case MeasureType
mt of
    MeasureType
MeasureTime -> [Double] -> Double
average
    MeasureType
MeasureNTime -> (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Double -> Double) -> ([Double] -> Double) -> [Double] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
    MeasureType
MeasureSpace -> [Double] -> Double
average
    MeasureType
MeasureSpaceTime -> [Double] -> Double
average
    MeasureType
MeasureAllocation -> [Double] -> Double
average
    MeasureType
MeasureCount -> [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum