diff --git a/examples/end-to-end-benchmarks.hs b/examples/end-to-end-benchmarks.hs index 994a7ed..05fc69e 100755 --- a/examples/end-to-end-benchmarks.hs +++ b/examples/end-to-end-benchmarks.hs @@ -20,7 +20,7 @@ benchmarks = main :: IO () main = defaultMainWith config "hyperion-example-end-to-end" benchmarks where - config = defaultConfig + config = defaultConfigMonoid { configMonoidSamplingStrategy = pure $ timeBound (fromSeconds 5) (repeat 10) } diff --git a/src/Hyperion/Main.hs b/src/Hyperion/Main.hs index fb2d081..57e71d6 100644 --- a/src/Hyperion/Main.hs +++ b/src/Hyperion/Main.hs @@ -8,11 +8,16 @@ module Hyperion.Main ( defaultMain , Mode(..) + , Config(..) , ConfigMonoid(..) , ReportOutput(..) + , configFromMonoid , nullOutputPath , defaultConfig + , defaultConfigMonoid , defaultMainWith + , doAnalyze + , doRun ) where import Control.Applicative @@ -178,8 +183,11 @@ nullOutputPath = "nul" nullOutputPath = "/dev/null" #endif -defaultConfig :: ConfigMonoid -defaultConfig = mempty +defaultConfigMonoid :: ConfigMonoid +defaultConfigMonoid = mempty + +defaultConfig :: Config +defaultConfig = configFromMonoid defaultConfigMonoid data DuplicateIdentifiers a = DuplicateIdentifiers [a] instance (Show a, Typeable a) => Exception (DuplicateIdentifiers a) @@ -210,6 +218,24 @@ doRun strategy bks = do throwIO $ DuplicateIdentifiers [ n | n:_:_ <- group (sort ids) ] foldMap (runBenchmark strategy) bks +reportAnalysis + :: Config + -> ContextInfo -- ^ Benchmark context information. + -> HashMap BenchmarkId Report + -> IO () +reportAnalysis config cinfo report = do + now <- getCurrentTime + let metadata = + configUserMetadata config + -- Prepend user metadata so that the user can rewrite @timestamp@, + -- for instance. + <> HashMap.fromList [ "timestamp" JSON..= now ] + void $ bracket + (mapM (openReportHandle cinfo) + $ Set.toList (configReportOutputs config)) + (mapM_ closeReportHandle) + (mapM (\h -> printReport h metadata report)) + -- | Print the report. printReport :: ReportOutput IO.Handle @@ -257,28 +283,15 @@ closeReportHandle (ReportJsonFlat h) = IO.hClose h doAnalyze :: Config -- ^ Hyperion config. - -> ContextInfo -- ^ Benchmark context information. -> [Benchmark] -- ^ Benchmarks to be run. - -> IO () -doAnalyze Config{..} cinfo bks = do + -> IO (HashMap BenchmarkId Report) +doAnalyze Config{..} bks = do results <- doRun (indexedStrategy Config{..}) bks let strip | configRaw = id | otherwise = reportMeasurements .~ Nothing report = results & imapped %@~ analyze & mapped %~ strip - now <- getCurrentTime - let -- TODO Use output of hostname(1) as reasonable default. - hostId = Nothing :: Maybe Text - metadata = - configUserMetadata - -- Prepend user metadata so that the user can rewrite @timestamp@, - -- for instance. - <> HashMap.fromList [ "timestamp" JSON..= now, "location" JSON..= hostId ] - void $ bracket - (mapM (openReportHandle cinfo) - $ Set.toList configReportOutputs) - (mapM_ closeReportHandle) - (mapM (\h -> printReport h metadata report)) + pure report defaultMainWith :: ConfigMonoid -- ^ Preset Hyperion config. @@ -304,10 +317,10 @@ defaultMainWith presetConfig packageName bks = do Run -> do _ <- doRun (indexedStrategy config) bks return () - Analyze -> doAnalyze config cinfo bks + Analyze -> doAnalyze config bks >>= reportAnalysis config cinfo defaultMain :: String -- ^ Package name, user provided. -> [Benchmark] -- ^ Benchmarks to be run. -> IO () -defaultMain = defaultMainWith defaultConfig +defaultMain = defaultMainWith defaultConfigMonoid diff --git a/tests/Hyperion/MainSpec.hs b/tests/Hyperion/MainSpec.hs index 82c3d10..77f5255 100644 --- a/tests/Hyperion/MainSpec.hs +++ b/tests/Hyperion/MainSpec.hs @@ -15,8 +15,10 @@ spec = do it "checks for duplicate identifiers" $ property $ \b -> length (b^..identifiers) /= length (group (sort (b^..identifiers))) ==> expectFailure $ monadicIO $ run $ - defaultMainWith defaultConfig{configMonoidMode = return Run} "spec" [b] + defaultMainWith + defaultConfigMonoid{configMonoidMode = return Run} "spec" [b] it "Analyzes uniquely identified benchmarks" $ property $ \b -> length (b^..identifiers) == length (group (sort (b^..identifiers))) ==> monadicIO $ run $ - defaultMainWith defaultConfig{configMonoidReportOutputs = [ReportJson nullOutputPath]} "specs" [b] + defaultMainWith + defaultConfigMonoid{configMonoidReportOutputs = [ReportJson nullOutputPath]} "specs" [b]