{-# LANGUAGE NumericUnderscores #-}

-- | The measurement harness every benchmark slice shares. Deliberately not
-- @tasty-bench@: allocated bytes and the work counters the library reports
-- about itself are the figures a slice is here to expose, and a harness built
-- around a timing distribution cannot express either.
module BenchSupport
  ( timedValue
  , requireRight
  , randomPoints
  ) where

import Control.DeepSeq (NFData, force)
import Control.Exception (evaluate)
import Data.Word (Word64)
import GHC.Clock (getMonotonicTimeNSec)
import GHC.Stats (RTSStats (allocated_bytes), getRTSStats, getRTSStatsEnabled)
import Moonlight.Triangulation (Point (Point))
import System.CPUTime (getCPUTime)

-- | Both clocks, because they answer different questions and neither
-- substitutes for the other. Elapsed is what anything is compared against —
-- the board against spade is wall clock, and a parallel construction that used
-- more cores gets no allowance for having used them. CPU is the work receipt:
-- on one capability the two agree, and where they diverge the ratio is the
-- parallelism actually obtained. Reporting CPU alone, as this did, would let a
-- change that halves elapsed time and doubles total work read as a regression.
timedValue :: NFData value => String -> IO value -> IO value
timedValue label action = do
  statsEnabled <- getRTSStatsEnabled
  before <- if statsEnabled then Just <$> getRTSStats else pure Nothing
  wallStart <- getMonotonicTimeNSec
  cpuStart <- getCPUTime
  value <- action >>= evaluate . force
  cpuEnd <- getCPUTime
  wallEnd <- getMonotonicTimeNSec
  after <- if statsEnabled then Just <$> getRTSStats else pure Nothing
  putStrLn (label <> "-elapsed: " <> show (fromIntegral (wallEnd - wallStart) / 1.0e9 :: Double) <> "s")
  putStrLn (label <> "-cpu: " <> show (fromIntegral (cpuEnd - cpuStart) / 1.0e12 :: Double) <> "s")
  case (before, after) of
    (Just left, Just right) ->
      putStrLn (label <> "-allocated-bytes: " <> show (allocated_bytes right - allocated_bytes left))
    _ -> pure ()
  pure value

requireRight :: Show error => Either error value -> IO value
requireRight value = case value of
  Left failure -> fail (show failure)
  Right result -> pure result

randomPoints :: Word64 -> Int -> [Point]
randomPoints seed count = take count (go seed)
 where
  go :: Word64 -> [Point]
  go state =
    let state1 = state * 6364136223846793005 + 1442695040888963407
        state2 = state1 * 6364136223846793005 + 1442695040888963407
        unit :: Word64 -> Double
        unit value = fromIntegral (value `div` 2048) / 9_007_199_254_740_992
     in Point (2 * unit state1 - 1) (2 * unit state2 - 1) : go state2