content: -- | 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)
  