From 18901eab39a70bc6066046c185c112317c739a90 Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Mon, 8 Apr 2019 16:45:04 +0200
Subject: [PATCH] align benchmark structure with hspec a bit more

---
 test/bench/Main.hs | 66 +++++++++++++++++++++-------------------------
 1 file changed, 30 insertions(+), 36 deletions(-)

diff --git a/test/bench/Main.hs b/test/bench/Main.hs
index 713e5c9f1e2..9f181879a6a 100644
--- a/test/bench/Main.hs
+++ b/test/bench/Main.hs
@@ -17,8 +17,6 @@ import Cardano.Wallet.Network.HttpBridge
     ( newNetworkLayer )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( Passphrase (..) )
-import Cardano.Wallet.Primitive.AddressDiscovery
-    ( mkAddressPoolGap )
 import Cardano.Wallet.Primitive.Types
     ( SlotId, WalletName (..) )
 import Control.Arrow
@@ -32,7 +30,7 @@ import Control.DeepSeq
 import Control.Exception
     ( bracket, evaluate )
 import Control.Monad
-    ( mapM_ )
+    ( forM_ )
 import Criterion.Measurement
     ( getTime, initializeTime, secs )
 import Data.Generics.Internal.VL.Lens
@@ -43,7 +41,7 @@ import qualified Data.Text as T
 import Data.Text.Class
     ( FromText (..), TextDecodingError (..), ToText (..) )
 import Fmt
-    ( fmt, (+|), (+||), (|+), (||+) )
+    ( fmt, (+||), (|+), (||+) )
 import Say
     ( say )
 import System.Environment
@@ -59,10 +57,20 @@ main :: IO ()
 main = do
     network <- getArgs >>= either fail return . parseArgs
     installSignalHandlers
-    runBenchmarks
-        [ bench ("restore " <> toText network <> " seq")
+    initializeTime
+    describe "Wallet Restoration"
+        [ bench ("Restore " <> toText network <> " seq")
             (bench_restoration network walletSeq)
         ]
+  where
+    walletSeq :: NewWallet
+    walletSeq = NewWallet
+        { gap = minBound
+        , name = WalletName "Benchmark Sequential Wallet"
+        , passphrase = mempty
+        , secondFactor = mempty
+        , seed = Passphrase "whatever"
+        }
 
 -- | Very simplistic benchmark argument parser. If anything more is ever needed,
 -- it's probably a good idea to go for `optparse-application` or similar for a
@@ -77,26 +85,24 @@ parseArgs = \case
         Left "invalid arguments provided to benchmark suite: I expect a\
             \ single string with the target network (e.g. \"mainnet\")."
 
-runBenchmarks :: [IO (Text, Double)] -> IO ()
-runBenchmarks bs = do
-    initializeTime
-    rs <- sequence bs
-    say "\n\nAll results:"
-    mapM_ (uncurry printResult) rs
-
-bench :: Text -> IO () -> IO (Text, Double)
-bench benchName action = do
-    say $ "Running " <> benchName
+-- | Run a serie of benchmark in sequence
+describe :: Text -> [IO Double] -> IO ()
+describe title bs = do
+    say title
+    forM_ bs $ \runBenchmark -> do
+        time <- runBenchmark
+        say . fmt $ secs time|+""
+
+-- | Declare a benchmark to run. Returns the time it took.
+bench :: Text -> IO () -> IO Double
+bench title action = do
+    say $ "    " <> title
     start <- getTime
     res <- action
     evaluate (rnf res)
     finish <- getTime
-    let dur = finish - start
-    printResult benchName dur
-    pure (benchName, dur)
+    return $ finish - start
 
-printResult :: Text -> Double -> IO ()
-printResult benchName dur = say . fmt $ "  "+|benchName|+": "+|secs dur|+""
 
 {-------------------------------------------------------------------------------
                                   Benchmarks
@@ -108,16 +114,13 @@ bench_restoration network nw = withHttpBridge network $ \port -> do
     dbLayer <- MVar.newDBLayer
     networkLayer <- newNetworkLayer networkName port
     (_, bh) <- unsafeRunExceptT $ networkTip networkLayer
-    say . fmt $ "Note: the "+|networkName|+" tip is at "+||(bh ^. #slotId)||+""
+    say . fmt $ networkName|+" tip is at "+||(bh ^. #slotId)||+""
     let walletLayer = mkWalletLayer dbLayer networkLayer
     wallet <- unsafeRunExceptT $ createWallet walletLayer nw
     processWallet walletLayer logChunk wallet
   where
     networkName = toText network
 
-logChunk :: SlotId -> IO ()
-logChunk slot = say . fmt $ "Processing "+||slot||+""
-
 withHttpBridge :: Network -> (Int -> IO a) -> IO a
 withHttpBridge network action = bracket start stop (const (action port))
   where
@@ -138,14 +141,5 @@ withHttpBridge network action = bracket start stop (const (action port))
         cancel handle
         threadDelay 1000000 -- wait for socket to be closed
 
-
-baseWallet :: NewWallet
-baseWallet = NewWallet (Passphrase "") (Passphrase "")
-             (WalletName "") (Passphrase "") gap20
-    where Right gap20 = mkAddressPoolGap 20
-
-walletSeq :: NewWallet
-walletSeq = baseWallet
-    { seed = Passphrase "involve key curtain arrest fortune custom lens marine before material wheel glide cause weapon wrap"
-    , name = WalletName "Benchmark Sequential Wallet"
-    }
+logChunk :: SlotId -> IO ()
+logChunk slot = say . fmt $ "Processing "+||slot||+""