sim-benchmarks: refactor PeerMetrics benchmarks

Use `env`, rather than storing data on heap for whole run of all
benchmarks.

Author: coot

ouroboros-network-testing/ouroboros-network-testing.cabal

@@ -68,6 +68,7 @@ library
     cborg >=0.2.1 && <0.3,
     containers,
     contra-tracer,
+    deepseq,
     deque ^>=0.4,
     io-classes:{io-classes, si-timers, strict-stm} ^>=1.8.0.1,
     io-sim,

ouroboros-network-testing/src/Test/Ouroboros/Network/Data/Script.hs

@@ -1,6 +1,7 @@
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE DerivingVia       #-}
-{-# LANGUAGE TupleSections     #-}
+{-# LANGUAGE DeriveTraversable          #-}
+{-# LANGUAGE DerivingVia                #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE TupleSections              #-}
 
 module Test.Ouroboros.Network.Data.Script
   ( -- * Test scripts
@@ -40,6 +41,7 @@ import Data.Set qualified as Set
 import Control.Concurrent.Class.MonadSTM (TVar)
 import Control.Concurrent.Class.MonadSTM qualified as LazySTM
 import Control.Concurrent.Class.MonadSTM.Strict
+import Control.DeepSeq
 import Control.Monad.Class.MonadAsync
 import Control.Monad.Class.MonadFork
 import Control.Monad.Class.MonadTimer.SI
@@ -55,6 +57,7 @@ import Test.QuickCheck
 
 newtype Script a = Script (NonEmpty a)
   deriving (Eq, Show, Functor, Foldable, Traversable)
+  deriving newtype NFData
 
 singletonScript :: a -> Script a
 singletonScript x = Script (x :| [])

ouroboros-network/bench/Main.hs

@@ -8,17 +8,16 @@ import Test.Ouroboros.Network.PeerSelection.PeerMetric
            (microbenchmark1GenerateInput, microbenchmark1ProcessInput)
 
 main :: IO ()
-main = do
-    is <- mapM (microbenchmark1GenerateInput False . snd) benchmarks
+main =
     defaultMain
-      [bgroup "ouroboros-network:sim-benchmarks"
-         [ bench (unwords ["microbenchmark1",name])
-               $ nfAppIO microbenchmark1ProcessInput i
-         | ((name,_),i) <- zip benchmarks is
-         ]
+      [ bgroup "ouroboros-network:sim-benchmarks"
+        [ bgroup "PeerMetrics"
+          [ env (microbenchmark1GenerateInput False 1_000) $ \i ->
+                bench "1k" $ nfAppIO microbenchmark1ProcessInput i
+          , env (microbenchmark1GenerateInput False 10_000) $ \i ->
+                bench "10k" $ nfAppIO microbenchmark1ProcessInput i
+          , env (microbenchmark1GenerateInput False 100_000) $ \i ->
+                bench "100k" $ nfAppIO microbenchmark1ProcessInput i
+          ]
+        ]
       ]
-  where
-    benchmarks = [("1k"  ,   1000)
-                 ,("10k" , 10_000)
-                 ,("100k",100_000)
-                 ]

ouroboros-network/testlib/Test/Ouroboros/Network/PeerSelection/PeerMetric.hs

@@ -1,4 +1,6 @@
 {-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingStrategies         #-}
 {-# LANGUAGE GeneralisedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase                 #-}
@@ -27,6 +29,7 @@ import Data.Map.Merge.Strict qualified as Map
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
+import GHC.Generics
 
 import Network.Mux.Trace (TraceLabelPeer (..))
 
@@ -73,7 +76,7 @@ instance Arbitrary TestAddress where
 data Event =
     FetchedHeader TestAddress SlotNo
   | FetchedBlock  TestAddress SlotNo SizeInBytes
-  deriving Show
+  deriving (Show, Generic, NFData)
 
 eventPeer :: Event -> TestAddress
 eventPeer (FetchedHeader peer _)   = peer
@@ -100,6 +103,7 @@ instance Arbitrary Event where
 
 newtype FixedScript = FixedScript { getFixedScript :: Script Event }
   deriving Show
+  deriving newtype NFData
 
 -- | Order events by 'SlotNo'
 --
@@ -446,9 +450,12 @@ microbenchmark1GenerateInput verbose' n = do
     mapM_ print (let FixedScript s = fixedScript in s)
   return fixedScript
 
+-- TODO:
+-- * we shouldn't use QuickCheck
+-- * and we shouldn't use IOSim (which `prop_simScript`) is using.
 microbenchmark1ProcessInput :: FixedScript -> IO ()
 microbenchmark1ProcessInput =
-  quickCheckWith (stdArgs{maxSuccess=1}) . prop_simScript
+  quickCheckWith (stdArgs{maxSuccess=1,chatty=False}) . prop_simScript
 
 microbenchmark1 :: Bool -> Int -> IO ()
 microbenchmark1 verbose' n =