Make doAnalyze more user-friendly

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)
       }

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

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]