Stats.hs

-- | A quickly done module that exports utility functions used to collect various
-- statistics. All statistics are stored in a MVar holding a HashMap.
--
-- This is not accurate in the presence of lazy evaluation. Nothing is forced.
module Puppet.Runner.Stats
  ( measure,
    newStats,
    getStats,
    StatsPoint (..),
    MStats,
  )
where

import qualified Data.HashMap.Strict as Map
import Data.Time.Clock.POSIX (getPOSIXTime)
import XPrelude

data StatsPoint = StatsPoint
  { -- | Total number of calls to a computation
    _statspointCount :: !Int,
    -- | Total time spent during this computation
    _statspointTotal :: !Double,
    -- | Minimum execution time
    _statspointMin :: !Double,
    -- | Maximum execution time
    _statspointMax :: !Double
  }
  deriving (Show)

-- | A table where keys are the names of the computations, and values are
-- 'StatsPoint's.
type StatsTable = HashMap Text StatsPoint

newtype MStats = MStats {unMStats :: MVar StatsTable}

-- | Returns the actual statistical values.
getStats :: MStats -> IO StatsTable
getStats = readMVar . unMStats

-- | Create a new statistical container.
newStats :: IO MStats
newStats = MStats `fmap` newMVar Map.empty

-- | Wraps a computation, and measures related execution statistics.
measure ::
  -- | Statistics container
  MStats ->
  -- | Action identifier
  Text ->
  -- | Computation
  IO a ->
  IO a
measure (MStats mtable) statsname action = do
  (!tm, !out) <- time action
  !stats <- takeMVar mtable
  let nstats :: StatsTable
      !nstats = case stats ^. at statsname of
        Nothing -> stats & at statsname ?~ StatsPoint 1 tm tm tm
        Just (StatsPoint sc st smi sma) ->
          let !nmax = max tm sma
              !nmin = min tm smi
           in stats & at statsname ?~ StatsPoint (sc + 1) (st + tm) nmin nmax
  putMVar mtable nstats
  return $! out

getTime :: IO Double
getTime = realToFrac `fmap` getPOSIXTime

time :: IO a -> IO (Double, a)
time action = do
  start <- getTime
  !result <- action
  end <- getTime
  let !delta = end - start
  return (delta, result)