{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- Module      : Test.Hspec.BenchGolden
-- Description : Golden testing for performance benchmarks
-- Copyright   : (c) 2026
-- License     : MIT
-- Maintainer  : @ocramz
--
-- = Overview
--
-- @golds-gym@ is a framework for golden testing of performance benchmarks.
-- It integrates with hspec and uses benchpress for lightweight timing measurements.
--
-- Benchmarks can use robust statistics to mitigate the impact of outliers.
--
-- The library can be used both to assert that performance does not regress, and to set expectations
-- for improvements across project versions (see `benchGoldenWithExpectation`).
--
-- = Quick Start
--
-- @
-- import Test.Hspec
-- import Test.Hspec.BenchGolden
-- import Data.List (sort)
--
-- main :: IO ()
-- main = hspec $ do
--   describe \"Performance\" $ do
--     -- Pure function with normal form evaluation
--     `benchGolden` "list sorting" $
--       `nf` sort [1000, 999..1]
--
--     -- Weak head normal form (lazy evaluation)
--     `benchGolden` "replicate" $
--       `whnf` (replicate 1000) 42
--
--     -- IO action with result forced to normal form
--     `benchGolden` "file read" $
--       `nfIO` (readFile "data.txt")
-- @
--
-- __Evaluation strategies__ control how values are forced:
--
-- * 'nf' - Force to normal form (deep evaluation, use for most cases)
-- * 'whnf' - Force to weak head normal form (only outermost constructor is evaluated)
-- * 'nfIO', 'whnfIO' - Variants for IO actions
-- * 'nfAppIO', 'whnfAppIO' - For functions returning IO
-- * 'io' - Plain IO action without forcing
--
-- Without proper evaluation strategies, GHC may optimize away computations
-- or share results across iterations, making benchmarks meaningless.
--
-- = Best Practices: Avoiding Shared Thunks
--
-- __CRITICAL:__ When benchmarking with data structures, ensure the data is
-- reconstructed on each iteration to avoid measuring shared, cached results.
--
-- ❌ __Anti-pattern__ (shared list across iterations):
--
-- @
-- benchGolden "sum" $ nf sum [1..1000000]
-- @
--
-- The list @[1..1000000]@ is constructed once and shared across all iterations.
-- This allocates the entire list in memory, creates GC pressure, and prevents
-- list fusion. The first iteration evaluates the shared thunk, and subsequent
-- iterations measure cached results.
--
-- ✅ __Correct pattern__ (list reconstructed per iteration):
--
-- @
-- benchGolden "sum" $ nf (\\n -> sum [1..n]) 1000000
-- @
--
-- The lambda wrapper ensures the list is reconstructed on every iteration,
-- measuring the true cost of both construction and computation.
--
-- __Other considerations:__
--
-- * Ensure return types are inhabited enough to depend on all computations
--   (avoid @b ~ ()@ where GHC might optimize away the payload)
-- * For inlinable functions, ensure full saturation: prefer @nf (\\n -> f n) x@
--   over @nf f x@ to guarantee inlining and rewrite rules fire
-- * Use 'NFData' constraints where applicable to ensure deep evaluation
--
-- = How It Works
--
-- 1. On first run, the benchmark is executed and results are saved to a
--    golden file as the baseline.
--
-- 2. On subsequent runs, the benchmark is executed and compared against
--    the baseline using a configurable tolerance or expectation combinators.
--
-- = Architecture-Specific Baselines
--
-- Golden files are stored per-architecture to ensure benchmarks are only
-- compared against equivalent hardware. The architecture identifier includes
-- CPU type, OS, and CPU model.
--
-- = Configuration
--
-- Use 'benchGoldenWith' or 'benchGoldenWithExpectation' with a custom 'BenchConfig':
--
-- == Tolerance Configuration
--
-- The framework supports two tolerance mechanisms that work together:
--
-- 1. __Percentage tolerance__ ('tolerancePercent'): Checks if the mean time
--    change is within ±X% of the baseline. This is the traditional approach
--    and works well for operations that take more than a few milliseconds.
--
-- 2. __Absolute tolerance__ ('absoluteToleranceMs'): Checks if the absolute
--    time difference is within X milliseconds. This prevents false failures
--    for extremely fast operations (< 1ms) where measurement noise causes
--    large percentage variations despite negligible absolute differences.
--
-- By default, benchmarks pass if __EITHER__ tolerance is satisfied:
--
-- @
-- pass = (percentChange <= 15%) OR (absTimeDiff <= 0.01 ms)
-- @
--
-- This hybrid strategy combines the benefits of both approaches:
--
-- * For fast operations (< 1ms): Absolute tolerance dominates, preventing noise
-- * For slow operations (> 1ms): Percentage tolerance dominates, catching real regressions
--
-- To disable absolute tolerance and use percentage-only comparison:
--
-- @
-- benchGoldenWith defaultBenchConfig
--   { absoluteToleranceMs = Nothing
--   }
--   \"benchmark\" $ ...
-- @
--
-- To adjust the absolute tolerance threshold:
--
-- @
-- benchGoldenWith defaultBenchConfig
--   { absoluteToleranceMs = Just 0.001  -- 1 microsecond (very strict)
--   }
--   \"benchmark\" $ ...
-- @
---- = Lens-Based Expectations (Advanced)
--
-- For custom performance expectations, use lens-based combinators:
--
-- @
-- import Test.Hspec.BenchGolden.Lenses
--
-- -- Median-based comparison instead of mean
-- benchGoldenWithExpectation "median test" defaultBenchConfig
--   [expect _statsMedian (Percent 10.0)]
--   (nf myAlgorithm input)
--
-- -- Compose multiple expectations
-- benchGoldenWithExpectation "strict test" defaultBenchConfig
--   [ expect _statsMean (Percent 15.0) &&~
--     expect _statsMAD (Percent 50.0)
--   ]
--   (nf criticalFunction data)
--
-- -- Expect improvement (must be faster)
-- benchGoldenWithExpectation "optimization" defaultBenchConfig
--   [expect _statsMean (MustImprove 10.0)]  -- Must be ≥10% faster
--   (nf optimizedVersion input)
-- @
---- = Environment Variables
--
-- * @GOLDS_GYM_ACCEPT=1@ - Regenerate all golden files
-- * @GOLDS_GYM_SKIP=1@ - Skip all benchmark tests
-- * @GOLDS_GYM_ARCH=custom-id@ - Override architecture detection

module Test.Hspec.BenchGolden
  ( -- * Spec Combinators
    benchGolden
  , benchGoldenWith
  , benchGoldenWithExpectation

    -- * Configuration
  , BenchConfig(..)
  , defaultBenchConfig

    -- * Types
  , BenchGolden(..)
  , BenchAction(..)
  , GoldenStats(..)
  , BenchResult(..)
  , Warning(..)
  , ArchConfig(..)

    -- * Benchmarkable Constructors
  , nf
  , whnf
  , nfIO
  , whnfIO
  , nfAppIO
  , whnfAppIO
  , io

    -- * Low-Level API
  , runBenchGolden

    -- * Lens-Based Expectations
  , module Test.Hspec.BenchGolden.Lenses

    -- * Re-exports
  , module Test.Hspec.BenchGolden.Arch
  ) where

import Data.IORef
import qualified Data.Text as T
import Lens.Micro ((^.))
import System.Environment (lookupEnv)
import Text.Printf (printf)
import qualified Text.PrettyPrint.Boxes as Box

import Test.Hspec.Core.Spec

import Test.Hspec.BenchGolden.Arch
import qualified Test.Hspec.BenchGolden.Lenses as L
import Test.Hspec.BenchGolden.Lenses hiding (Expectation)
import Test.Hspec.BenchGolden.Runner (runBenchGolden, setAcceptGoldens, setSkipBenchmarks, nf, whnf, nfIO, whnfIO, nfAppIO, whnfAppIO, io)
import Test.Hspec.BenchGolden.Types

-- | Create a benchmark golden test with default configuration.
--
-- This is the simplest way to add a benchmark test:
--
-- @
-- describe "Sorting" $ do
--   benchGolden "quicksort 1000 elements" $
--     nf quicksort [1000, 999..1]
-- @
--
-- Use evaluation strategy combinators to control how values are forced:
--
-- * 'nf' - Normal form (deep evaluation)
-- * 'whnf' - Weak head normal form (shallow evaluation)
-- * 'nfIO' - Normal form for IO actions
-- * 'whnfIO' - WHNF for IO actions
-- * 'nfAppIO' - Normal form for functions returning IO
-- * 'whnfAppIO' - WHNF for functions returning IO
-- * 'io' - Plain IO action (for backward compatibility)
--
-- Default configuration:
--
-- * 100 iterations
-- * 5 warm-up iterations
-- * 15% tolerance
-- * Variance warnings enabled
-- * Standard statistics (not robust mode)
benchGolden :: 
    String  -- ^ Name of the benchmark
    -> BenchAction -- ^ The benchmarkable action
    -> Spec
benchGolden :: String -> BenchAction -> Spec
benchGolden String
name BenchAction
action = BenchConfig -> String -> BenchAction -> Spec
benchGoldenWith BenchConfig
defaultBenchConfig String
name BenchAction
action

-- | Create a benchmark golden test with custom configuration.
--
-- Examples:
--
-- @
-- -- Tighter tolerance for critical code
-- benchGoldenWith defaultBenchConfig
--   { iterations = 500
--   , tolerancePercent = 5.0
--   , warmupIterations = 20
--   }
--   "hot loop" $
--   nf criticalFunction input
--
-- -- Robust statistics mode for noisy environments
-- benchGoldenWith defaultBenchConfig
--   { useRobustStatistics = True
--   , trimPercent = 10.0
--   , outlierThreshold = 3.0
--   }
--   "benchmark with outliers" $
--   whnf computation input
-- @
benchGoldenWith :: BenchConfig  -- ^ Configuration parameters
    -> String -- ^ Name of the benchmark
    -> BenchAction -- ^ The benchmarkable action
    -> Spec
benchGoldenWith :: BenchConfig -> String -> BenchAction -> Spec
benchGoldenWith BenchConfig
config String
name BenchAction
action =
  String -> BenchGolden -> SpecWith (Arg BenchGolden)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
name (BenchGolden -> SpecWith (Arg BenchGolden))
-> BenchGolden -> SpecWith (Arg BenchGolden)
forall a b. (a -> b) -> a -> b
$ BenchGolden
    { benchName :: String
benchName   = String
name
    , benchAction :: BenchAction
benchAction = BenchAction
action
    , benchConfig :: BenchConfig
benchConfig = BenchConfig
config
    }


-- | Create a benchmark golden test with custom lens-based expectations.
--
-- This combinator allows you to specify custom performance expectations using
-- lenses and tolerance combinators. Expectations can be composed using boolean
-- operators ('&&~', '||~').
--
-- Examples:
--
-- @
-- -- Median-based comparison (more robust to outliers)
-- benchGoldenWithExpectation "median test" defaultBenchConfig
--   [`expect` `_statsMedian` (`Percent` 10.0)]
--   (nf sort [1000, 999..1])
--
-- -- Multiple metrics must pass (AND composition)
-- benchGoldenWithExpectation "strict test" defaultBenchConfig
--   [ expect `_statsMean` (Percent 15.0) &&~
--     expect `_statsMAD` (Percent 50.0)
--   ]
--   (nf algorithm data)
--
-- -- Either metric can pass (OR composition)
-- benchGoldenWithExpectation "flexible test" defaultBenchConfig
--   [ expect _statsMedian (Percent 10.0) ||~
--     expect _statsMin (`Absolute` 0.01)
--   ]
--   (nf fastOp input)
--
-- -- Expect performance improvement (must be faster)
-- benchGoldenWithExpectation "optimization" defaultBenchConfig
--   [expect _statsMean (`MustImprove` 10.0)]  -- Must be ≥10% faster
--   (nf optimizedVersion data)
--
-- -- Expect controlled regression (for feature additions)
-- benchGoldenWithExpectation "new feature" defaultBenchConfig
--   [expect _statsMean (`MustRegress` 5.0)]  -- Accept 5-20% slowdown
--   (nf newFeature input)
--
-- -- Low variance requirement
-- benchGoldenWithExpectation "stable perf" defaultBenchConfig
--   [ expect _statsMean (Percent 15.0) &&~
--     expect `_statsIQR` (Absolute 0.1)
--   ]
--   (nfIO stableOperation)
-- @
--
-- Note: Expectations are checked against golden files. On first run, a baseline
-- is created. Use @GOLDS_GYM_ACCEPT=1@ to regenerate baselines.
benchGoldenWithExpectation ::
    String        -- ^ Name of the benchmark
    -> BenchConfig  -- ^ Configuration parameters
    -> [L.Expectation]  -- ^ List of expectations (all must pass)
    -> BenchAction       -- ^ The benchmarkable action
    -> Spec
benchGoldenWithExpectation :: String -> BenchConfig -> [Expectation] -> BenchAction -> Spec
benchGoldenWithExpectation String
name BenchConfig
config [Expectation]
expectations BenchAction
action =
  String
-> BenchGoldenWithExpectations
-> SpecM (Arg BenchGoldenWithExpectations) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
name (BenchGoldenWithExpectations
 -> SpecM (Arg BenchGoldenWithExpectations) ())
-> BenchGoldenWithExpectations
-> SpecM (Arg BenchGoldenWithExpectations) ()
forall a b. (a -> b) -> a -> b
$ String
-> BenchAction
-> BenchConfig
-> [Expectation]
-> BenchGoldenWithExpectations
BenchGoldenWithExpectations String
name BenchAction
action BenchConfig
config [Expectation]
expectations

-- | Data type for benchmarks with custom lens-based expectations.
data BenchGoldenWithExpectations = BenchGoldenWithExpectations
  !String        -- Name
  !BenchAction   -- Action
  !BenchConfig   -- Config
  ![L.Expectation] -- Expectations

-- | Instance for BenchGolden without arguments.
instance Example BenchGolden where
  type Arg BenchGolden = ()
  evaluateExample :: BenchGolden
-> Params
-> (ActionWith (Arg BenchGolden) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample BenchGolden
bg Params
params ActionWith (Arg BenchGolden) -> IO ()
hook ProgressCallback
progress =
    (() -> BenchGolden)
-> Params
-> (ActionWith (Arg (() -> BenchGolden)) -> IO ())
-> ProgressCallback
-> IO Result
forall e.
Example e =>
e
-> Params
-> (ActionWith (Arg e) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample (\() -> BenchGolden
bg) Params
params ActionWith (Arg BenchGolden) -> IO ()
ActionWith (Arg (() -> BenchGolden)) -> IO ()
hook ProgressCallback
progress

-- | Instance for BenchGolden with an argument.
--
-- This allows benchmarks to receive setup data from @before@ or @around@ combinators.
instance Example (arg -> BenchGolden) where
  type Arg (arg -> BenchGolden) = arg
  evaluateExample :: (arg -> BenchGolden)
-> Params
-> (ActionWith (Arg (arg -> BenchGolden)) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample arg -> BenchGolden
bgFn Params
_params ActionWith (Arg (arg -> BenchGolden)) -> IO ()
hook ProgressCallback
_progress = do
    -- Read environment variables to determine accept/skip flags
    Maybe String
acceptEnv <- String -> IO (Maybe String)
lookupEnv String
"GOLDS_GYM_ACCEPT"
    Maybe String
skipEnv <- String -> IO (Maybe String)
lookupEnv String
"GOLDS_GYM_SKIP"
    
    let shouldAccept :: Bool
shouldAccept = case Maybe String
acceptEnv of
          Just String
"1"    -> Bool
True
          Just String
"true" -> Bool
True
          Just String
"yes"  -> Bool
True
          Maybe String
_           -> Bool
False
        shouldSkip :: Bool
shouldSkip = case Maybe String
skipEnv of
          Just String
"1"    -> Bool
True
          Just String
"true" -> Bool
True
          Just String
"yes"  -> Bool
True
          Maybe String
_           -> Bool
False
    
    -- Store the flags so Runner can access them
    Bool -> IO ()
setAcceptGoldens Bool
shouldAccept
    Bool -> IO ()
setSkipBenchmarks Bool
shouldSkip
    
    IORef Result
ref <- Result -> IO (IORef Result)
forall a. a -> IO (IORef a)
newIORef (String -> ResultStatus -> Result
Result String
"" ResultStatus
Success)
    ActionWith (Arg (arg -> BenchGolden)) -> IO ()
hook (ActionWith (Arg (arg -> BenchGolden)) -> IO ())
-> ActionWith (Arg (arg -> BenchGolden)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Arg (arg -> BenchGolden)
arg -> do
      let bg :: BenchGolden
bg = arg -> BenchGolden
bgFn arg
Arg (arg -> BenchGolden)
arg
      BenchResult
result <- BenchGolden -> IO BenchResult
runBenchGolden BenchGolden
bg
      IORef Result -> Result -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Result
ref (BenchResult -> Result
fromBenchResult BenchResult
result)
    IORef Result -> IO Result
forall a. IORef a -> IO a
readIORef IORef Result
ref

-- | Instance for BenchGoldenWithExpectations (custom expectations).
instance Example BenchGoldenWithExpectations where
  type Arg BenchGoldenWithExpectations = ()
  evaluateExample :: BenchGoldenWithExpectations
-> Params
-> (ActionWith (Arg BenchGoldenWithExpectations) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample (BenchGoldenWithExpectations String
name BenchAction
action BenchConfig
config [Expectation]
expectations) Params
_params ActionWith (Arg BenchGoldenWithExpectations) -> IO ()
hook ProgressCallback
_progress = do
    -- Read environment variables to determine accept/skip flags
    Maybe String
acceptEnv <- String -> IO (Maybe String)
lookupEnv String
"GOLDS_GYM_ACCEPT"
    Maybe String
skipEnv <- String -> IO (Maybe String)
lookupEnv String
"GOLDS_GYM_SKIP"
    
    let shouldAccept :: Bool
shouldAccept = case Maybe String
acceptEnv of
          Just String
"1"    -> Bool
True
          Just String
"true" -> Bool
True
          Just String
"yes"  -> Bool
True
          Maybe String
_           -> Bool
False
        shouldSkip :: Bool
shouldSkip = case Maybe String
skipEnv of
          Just String
"1"    -> Bool
True
          Just String
"true" -> Bool
True
          Just String
"yes"  -> Bool
True
          Maybe String
_           -> Bool
False
    
    -- Store the flags so Runner can access them
    Bool -> IO ()
setAcceptGoldens Bool
shouldAccept
    Bool -> IO ()
setSkipBenchmarks Bool
shouldSkip
    
    IORef Result
ref <- Result -> IO (IORef Result)
forall a. a -> IO (IORef a)
newIORef (String -> ResultStatus -> Result
Result String
"" ResultStatus
Success)
    ActionWith (Arg BenchGoldenWithExpectations) -> IO ()
hook (ActionWith (Arg BenchGoldenWithExpectations) -> IO ())
-> ActionWith (Arg BenchGoldenWithExpectations) -> IO ()
forall a b. (a -> b) -> a -> b
$ \() -> do
      BenchResult
result <- String
-> BenchAction -> BenchConfig -> [Expectation] -> IO BenchResult
runBenchGoldenWithExpectations String
name BenchAction
action BenchConfig
config [Expectation]
expectations
      IORef Result -> Result -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Result
ref ([Expectation] -> BenchResult -> Result
fromBenchResultWithExpectations [Expectation]
expectations BenchResult
result)
    IORef Result -> IO Result
forall a. IORef a -> IO a
readIORef IORef Result
ref

-- | Run a benchmark with custom expectations.
runBenchGoldenWithExpectations :: String -> BenchAction -> BenchConfig -> [L.Expectation] -> IO BenchResult
runBenchGoldenWithExpectations :: String
-> BenchAction -> BenchConfig -> [Expectation] -> IO BenchResult
runBenchGoldenWithExpectations String
name BenchAction
action BenchConfig
config [Expectation]
expectations = do
  -- Convert to BenchGolden and run normally first
  let bg :: BenchGolden
bg = String -> BenchAction -> BenchConfig -> BenchGolden
BenchGolden String
name BenchAction
action BenchConfig
config
  BenchResult
result <- BenchGolden -> IO BenchResult
runBenchGolden BenchGolden
bg
  
  -- Extract tolerance from first expectation for error messages
  let (Double
tolPct, Maybe Double
tolAbs) = case [Expectation]
expectations of
        [] -> (BenchConfig -> Double
tolerancePercent BenchConfig
config, BenchConfig -> Maybe Double
absoluteToleranceMs BenchConfig
config)
        (Expectation
e:[Expectation]
_) -> Expectation -> (Double, Maybe Double)
L.toleranceFromExpectation Expectation
e
  
  -- Then check expectations for Pass/Regression/Improvement results
  case BenchResult
result of
    FirstRun GoldenStats
stats -> BenchResult -> IO BenchResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BenchResult -> IO BenchResult) -> BenchResult -> IO BenchResult
forall a b. (a -> b) -> a -> b
$ GoldenStats -> BenchResult
FirstRun GoldenStats
stats
    Pass GoldenStats
golden GoldenStats
actual [Warning]
warnings ->
      -- Check all expectations
      let allPass :: Bool
allPass = (Expectation -> Bool) -> [Expectation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Expectation
e -> Expectation -> GoldenStats -> GoldenStats -> Bool
L.checkExpectation Expectation
e GoldenStats
golden GoldenStats
actual) [Expectation]
expectations
      in if Bool
allPass
         then BenchResult -> IO BenchResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BenchResult -> IO BenchResult) -> BenchResult -> IO BenchResult
forall a b. (a -> b) -> a -> b
$ GoldenStats -> GoldenStats -> [Warning] -> BenchResult
Pass GoldenStats
golden GoldenStats
actual [Warning]
warnings
         else 
           -- Expectations failed - calculate actual percentage diff for error message
           let lens :: (Double -> Const Double Double)
-> GoldenStats -> Const Double GoldenStats
lens = BenchConfig -> Lens' GoldenStats Double
L.metricFor BenchConfig
config
               goldenVal :: Double
goldenVal = GoldenStats
golden GoldenStats
-> ((Double -> Const Double Double)
    -> GoldenStats -> Const Double GoldenStats)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double)
-> GoldenStats -> Const Double GoldenStats
lens
               actualVal :: Double
actualVal = GoldenStats
actual GoldenStats
-> ((Double -> Const Double Double)
    -> GoldenStats -> Const Double GoldenStats)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double)
-> GoldenStats -> Const Double GoldenStats
lens
               meanDiff :: Double
meanDiff = if Double
goldenVal Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 
                         then Double
100.0 
                         else ((Double
actualVal Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
goldenVal) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
goldenVal) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100
           in BenchResult -> IO BenchResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BenchResult -> IO BenchResult) -> BenchResult -> IO BenchResult
forall a b. (a -> b) -> a -> b
$ GoldenStats
-> GoldenStats -> Double -> Double -> Maybe Double -> BenchResult
Regression GoldenStats
golden GoldenStats
actual Double
meanDiff Double
tolPct Maybe Double
tolAbs
    Regression GoldenStats
golden GoldenStats
actual Double
pct Double
_tol Maybe Double
_absTol ->
      -- Check if regression is acceptable per expectations
      let allPass :: Bool
allPass = (Expectation -> Bool) -> [Expectation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Expectation
e -> Expectation -> GoldenStats -> GoldenStats -> Bool
L.checkExpectation Expectation
e GoldenStats
golden GoldenStats
actual) [Expectation]
expectations
      in if Bool
allPass
         then BenchResult -> IO BenchResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BenchResult -> IO BenchResult) -> BenchResult -> IO BenchResult
forall a b. (a -> b) -> a -> b
$ GoldenStats -> GoldenStats -> [Warning] -> BenchResult
Pass GoldenStats
golden GoldenStats
actual []
         else BenchResult -> IO BenchResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BenchResult -> IO BenchResult) -> BenchResult -> IO BenchResult
forall a b. (a -> b) -> a -> b
$ GoldenStats
-> GoldenStats -> Double -> Double -> Maybe Double -> BenchResult
Regression GoldenStats
golden GoldenStats
actual Double
pct Double
tolPct Maybe Double
tolAbs
    Improvement GoldenStats
golden GoldenStats
actual Double
pct Double
_tol Maybe Double
_absTol ->
      -- Check if improvement satisfies expectations
      let allPass :: Bool
allPass = (Expectation -> Bool) -> [Expectation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Expectation
e -> Expectation -> GoldenStats -> GoldenStats -> Bool
L.checkExpectation Expectation
e GoldenStats
golden GoldenStats
actual) [Expectation]
expectations
      in if Bool
allPass
         then BenchResult -> IO BenchResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BenchResult -> IO BenchResult) -> BenchResult -> IO BenchResult
forall a b. (a -> b) -> a -> b
$ GoldenStats -> GoldenStats -> [Warning] -> BenchResult
Pass GoldenStats
golden GoldenStats
actual []
         else BenchResult -> IO BenchResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BenchResult -> IO BenchResult) -> BenchResult -> IO BenchResult
forall a b. (a -> b) -> a -> b
$ GoldenStats
-> GoldenStats -> Double -> Double -> Maybe Double -> BenchResult
Improvement GoldenStats
golden GoldenStats
actual Double
pct Double
tolPct Maybe Double
tolAbs

-- | Convert expectation-based benchmark result to hspec Result.
fromBenchResultWithExpectations :: [L.Expectation] -> BenchResult -> Result
fromBenchResultWithExpectations :: [Expectation] -> BenchResult -> Result
fromBenchResultWithExpectations [Expectation]
_expectations = BenchResult -> Result
fromBenchResult

-- | Convert a benchmark result to an hspec Result.
fromBenchResult :: BenchResult -> Result
fromBenchResult :: BenchResult -> Result
fromBenchResult BenchResult
result = case BenchResult
result of
  FirstRun GoldenStats
stats ->
    String -> ResultStatus -> Result
Result (GoldenStats -> String
formatFirstRun GoldenStats
stats) ResultStatus
Success

  Pass GoldenStats
golden GoldenStats
actual [Warning]
warnings ->
    let info :: String
info = GoldenStats -> GoldenStats -> String
formatPass GoldenStats
golden GoldenStats
actual
        warningInfo :: String
warningInfo = [Warning] -> String
formatWarnings [Warning]
warnings
    in String -> ResultStatus -> Result
Result (String
info String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
warningInfo) ResultStatus
Success

  Regression GoldenStats
golden GoldenStats
actual Double
pctChange Double
tolerance Maybe Double
absToleranceMs ->
    let toleranceDesc :: String
        toleranceDesc :: String
toleranceDesc = case Maybe Double
absToleranceMs of
          Maybe Double
Nothing -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"tolerance: %.1f%%" Double
tolerance
          Just Double
absMs -> String -> Double -> Double -> String
forall r. PrintfType r => String -> r
printf String
"tolerance: %.1f%% or %.3f ms" Double
tolerance Double
absMs
        changeVerb :: String
        changeVerb :: String
changeVerb = if Double
pctChange Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0 then String
"increased" else String
"decreased"
        absPctChange :: Double
absPctChange = Double -> Double
forall a. Num a => a -> a
abs Double
pctChange
        message :: String
message = String -> String -> Double -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Mean time %s by %.1f%% (%s)\n\n%s"
                    String
changeVerb Double
absPctChange String
toleranceDesc (GoldenStats -> GoldenStats -> String
formatRegression GoldenStats
golden GoldenStats
actual)
    in String -> ResultStatus -> Result
Result String
message (Maybe Location -> FailureReason -> ResultStatus
Failure Maybe Location
forall a. Maybe a
Nothing (String -> FailureReason
Reason String
message))

  Improvement GoldenStats
golden GoldenStats
actual Double
pctChange Double
tolerance Maybe Double
absToleranceMs ->
    let toleranceDesc :: String
        toleranceDesc :: String
toleranceDesc = case Maybe Double
absToleranceMs of
          Maybe Double
Nothing -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"tolerance: %.1f%%" Double
tolerance
          Just Double
absMs -> String -> Double -> Double -> String
forall r. PrintfType r => String -> r
printf String
"tolerance: %.1f%% or %.3f ms" Double
tolerance Double
absMs
    in String -> ResultStatus -> Result
Result (String -> Double -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Performance improved by %.1f%% (%s)\n%s"
                Double
pctChange String
toleranceDesc (GoldenStats -> GoldenStats -> String
formatPass GoldenStats
golden GoldenStats
actual))
      ResultStatus
Success

-- | Format statistics for the first run.
formatFirstRun :: GoldenStats -> String
formatFirstRun :: GoldenStats -> String
formatFirstRun GoldenStats
stats = String
"First run - baseline created\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GoldenStats -> String
formatStats GoldenStats
stats

-- | Format a regression comparison with full details.
formatRegression :: GoldenStats -> GoldenStats -> String
formatRegression :: GoldenStats -> GoldenStats -> String
formatRegression GoldenStats
golden GoldenStats
actual =
  let meanDiff :: Double
meanDiff = if GoldenStats -> Double
statsMean GoldenStats
golden Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
                 then Double
0
                 else ((GoldenStats -> Double
statsMean GoldenStats
actual Double -> Double -> Double
forall a. Num a => a -> a -> a
- GoldenStats -> Double
statsMean GoldenStats
golden) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ GoldenStats -> Double
statsMean GoldenStats
golden) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100
      stddevDiff :: Double
stddevDiff = if GoldenStats -> Double
statsStddev GoldenStats
golden Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
                   then Double
0
                   else ((GoldenStats -> Double
statsStddev GoldenStats
actual Double -> Double -> Double
forall a. Num a => a -> a -> a
- GoldenStats -> Double
statsStddev GoldenStats
golden) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ GoldenStats -> Double
statsStddev GoldenStats
golden) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100
      medianDiff :: Double
medianDiff = if GoldenStats -> Double
statsMedian GoldenStats
golden Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
                   then Double
0
                   else ((GoldenStats -> Double
statsMedian GoldenStats
actual Double -> Double -> Double
forall a. Num a => a -> a -> a
- GoldenStats -> Double
statsMedian GoldenStats
golden) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ GoldenStats -> Double
statsMedian GoldenStats
golden) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100
      
      -- Create detailed comparison table
      metricCol :: Box
metricCol = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Box.vcat Alignment
Box.left ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$ (String -> Box) -> [String] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map String -> Box
Box.text 
        [String
"Metric", String
"------", String
"Mean", String
"Stddev", String
"Median", String
"Min", String
"Max"]
      baselineCol :: Box
baselineCol = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Box.vcat Alignment
Box.right ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$ (String -> Box) -> [String] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map String -> Box
Box.text
        [ String
"Baseline"
        , String
"--------"
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" (GoldenStats -> Double
statsMean GoldenStats
golden)
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" (GoldenStats -> Double
statsStddev GoldenStats
golden)
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" (GoldenStats -> Double
statsMedian GoldenStats
golden)
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" (GoldenStats -> Double
statsMin GoldenStats
golden)
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" (GoldenStats -> Double
statsMax GoldenStats
golden)
        ]
      actualCol :: Box
actualCol = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Box.vcat Alignment
Box.right ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$ (String -> Box) -> [String] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map String -> Box
Box.text 
        [ String
"Actual"
        , String
"------"
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" (GoldenStats -> Double
statsMean GoldenStats
actual)
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" (GoldenStats -> Double
statsStddev GoldenStats
actual)
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" (GoldenStats -> Double
statsMedian GoldenStats
actual)
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" (GoldenStats -> Double
statsMin GoldenStats
actual)
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" (GoldenStats -> Double
statsMax GoldenStats
actual)
        ]
      diffCol :: Box
diffCol = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Box.vcat Alignment
Box.right ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$ (String -> Box) -> [String] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map String -> Box
Box.text
        [ String
"Diff"
        , String
"----"
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%+.1f%%" Double
meanDiff
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%+.1f%%" Double
stddevDiff
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%+.1f%%" Double
medianDiff
        , String
""
        , String
""
        ]
      
      table :: Box
table = Int -> Alignment -> [Box] -> Box
forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
Box.hsep Int
2 Alignment
Box.top [Box
metricCol, Box
baselineCol, Box
actualCol, Box
diffCol]
  in Box -> String
Box.render Box
table

-- | Format a passing comparison.
formatPass :: GoldenStats -> GoldenStats -> String
formatPass :: GoldenStats -> GoldenStats -> String
formatPass GoldenStats
golden GoldenStats
actual =
  let meanDiff :: Double
meanDiff = if GoldenStats -> Double
statsMean GoldenStats
golden Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
                 then Double
0
                 else ((GoldenStats -> Double
statsMean GoldenStats
actual Double -> Double -> Double
forall a. Num a => a -> a -> a
- GoldenStats -> Double
statsMean GoldenStats
golden) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ GoldenStats -> Double
statsMean GoldenStats
golden) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100
      stddevDiff :: Double
stddevDiff = if GoldenStats -> Double
statsStddev GoldenStats
golden Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
                   then Double
0
                   else ((GoldenStats -> Double
statsStddev GoldenStats
actual Double -> Double -> Double
forall a. Num a => a -> a -> a
- GoldenStats -> Double
statsStddev GoldenStats
golden) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ GoldenStats -> Double
statsStddev GoldenStats
golden) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100
      
      -- Create table with metric, baseline, actual, and diff columns
      metricCol :: Box
metricCol = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Box.vcat Alignment
Box.left ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$ (String -> Box) -> [String] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map String -> Box
Box.text [String
"Metric", String
"------", String
"Mean", String
"Stddev"]
      baselineCol :: Box
baselineCol = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Box.vcat Alignment
Box.right ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$ (String -> Box) -> [String] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map String -> Box
Box.text
        [ String
"Baseline"
        , String
"--------"
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" (GoldenStats -> Double
statsMean GoldenStats
golden)
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" (GoldenStats -> Double
statsStddev GoldenStats
golden)
        ]
      actualCol :: Box
actualCol = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Box.vcat Alignment
Box.right ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$ (String -> Box) -> [String] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map String -> Box
Box.text 
        [ String
"Actual"
        , String
"------"
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" (GoldenStats -> Double
statsMean GoldenStats
actual)
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" (GoldenStats -> Double
statsStddev GoldenStats
actual)
        ]
      diffCol :: Box
diffCol = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Box.vcat Alignment
Box.right ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$ (String -> Box) -> [String] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map String -> Box
Box.text
        [ String
"Diff"
        , String
"----"
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%+.1f%%" Double
meanDiff
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%+.1f%%" Double
stddevDiff
        ]
      
      table :: Box
table = Int -> Alignment -> [Box] -> Box
forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
Box.hsep Int
2 Alignment
Box.top [Box
metricCol, Box
baselineCol, Box
actualCol, Box
diffCol]
  in Box -> String
Box.render Box
table

-- | Format statistics for display.
formatStats :: GoldenStats -> String
formatStats :: GoldenStats -> String
formatStats GoldenStats{Double
[Double]
[(Int, Double)]
Text
UTCTime
statsMean :: GoldenStats -> Double
statsStddev :: GoldenStats -> Double
statsMedian :: GoldenStats -> Double
statsMin :: GoldenStats -> Double
statsMax :: GoldenStats -> Double
statsMean :: Double
statsStddev :: Double
statsMedian :: Double
statsMin :: Double
statsMax :: Double
statsPercentiles :: [(Int, Double)]
statsArch :: Text
statsTimestamp :: UTCTime
statsTrimmedMean :: Double
statsMAD :: Double
statsIQR :: Double
statsOutliers :: [Double]
statsOutliers :: GoldenStats -> [Double]
statsIQR :: GoldenStats -> Double
statsMAD :: GoldenStats -> Double
statsTrimmedMean :: GoldenStats -> Double
statsTimestamp :: GoldenStats -> UTCTime
statsArch :: GoldenStats -> Text
statsPercentiles :: GoldenStats -> [(Int, Double)]
..} =
  let metricCol :: Box
metricCol = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Box.vcat Alignment
Box.left ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$ (String -> Box) -> [String] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map String -> Box
Box.text
        [ String
"Metric", String
"------", String
"Mean", String
"Stddev", String
"Median", String
"Min", String
"Max", String
"Arch" ]
      valueCol :: Box
valueCol = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Box.vcat Alignment
Box.right ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$ (String -> Box) -> [String] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map String -> Box
Box.text
        [ String
"Value"
        , String
"-----"
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" Double
statsMean
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" Double
statsStddev
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" Double
statsMedian
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" Double
statsMin
        , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" Double
statsMax
        , Text -> String
T.unpack Text
statsArch
        ]
      table :: Box
table = Int -> Alignment -> [Box] -> Box
forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
Box.hsep Int
2 Alignment
Box.top [Box
metricCol, Box
valueCol]
  in Box -> String
Box.render Box
table

-- | Format warnings for display.
formatWarnings :: [Warning] -> String
formatWarnings :: [Warning] -> String
formatWarnings [] = String
""
formatWarnings [Warning]
ws = String
"\nWarnings:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines ((Warning -> String) -> [Warning] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Warning -> String
formatWarning [Warning]
ws)

-- | Format a single warning.
formatWarning :: Warning -> String
formatWarning :: Warning -> String
formatWarning Warning
w = case Warning
w of
  VarianceIncreased Double
golden Double
actual Double
pct Double
tolerance ->
    String -> Double -> Double -> Double -> Double -> String
forall r. PrintfType r => String -> r
printf String
"  ⚠ Variance increased by %.1f%% (%.3f ms -> %.3f ms, tolerance: %.1f%%)"
      Double
pct Double
golden Double
actual Double
tolerance

  VarianceDecreased Double
golden Double
actual Double
pct Double
tolerance ->
    String -> Double -> Double -> Double -> Double -> String
forall r. PrintfType r => String -> r
printf String
"  ⚠ Variance decreased by %.1f%% (%.3f ms -> %.3f ms, tolerance: %.1f%%)"
      Double
pct Double
golden Double
actual Double
tolerance

  HighVariance Double
cv ->
    String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"  ⚠ High variance detected (CV = %.1f%%)" (Double
cv Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100)

  OutliersDetected Int
count [Double]
outliers ->
    let outlierStr :: String
outlierStr = if Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
5
                     then [String] -> String
unwords ((Double -> String) -> [Double] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3fms") [Double]
outliers)
                     else [String] -> String
unwords ((Double -> String) -> [Double] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3fms") (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
5 [Double]
outliers)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..."
    in String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"  ⚠ %d outlier(s) detected: %s" Int
count String
outlierStr