Indicator of how long the loop took

feedback/src/Feedback/Common/Output.hs

@@ -1,12 +1,14 @@
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Feedback.Common.Output where
 
 import qualified Data.Text as T
 import Data.Time
+import Data.Word
 import System.Exit
 import Text.Colour
+import Text.Printf
 
 putTimedChunks :: TerminalCapabilities -> [Chunk] -> IO ()
 putTimedChunks terminalCapabilities chunks = do
@@ -16,7 +18,7 @@ putTimedChunks terminalCapabilities chunks = do
   putStrLn ""
 
 indicatorChunk :: String -> Chunk
-indicatorChunk = fore cyan . chunk . T.pack
+indicatorChunk = fore cyan . chunk . T.pack . printf "%-8s"
 
 loopNameChunk :: String -> Chunk
 loopNameChunk = fore yellow . chunk . T.pack
@@ -25,14 +27,22 @@ commandChunk :: String -> Chunk
 commandChunk = fore blue . chunk . T.pack
 
 exitCodeChunks :: ExitCode -> [Chunk]
-exitCodeChunks = \case
-  ExitSuccess ->
-    [ fore cyan "exited: ",
-      " ",
-      fore green "success"
-    ]
-  ExitFailure c ->
-    [ fore cyan "exited: ",
-      " ",
-      fore red $ chunk $ T.pack $ "failed: " <> show c
-    ]
+exitCodeChunks ec =
+  [ indicatorChunk "exited:",
+    " ",
+    case ec of
+      ExitSuccess ->
+        fore green "success"
+      ExitFailure c ->
+        fore red $ chunk $ T.pack $ "failed: " <> show c
+  ]
+
+durationChunks :: Word64 -> [Chunk]
+durationChunks nanosecs =
+  let diffTime :: Double
+      diffTime = fromIntegral nanosecs / 1_000_000_000
+   in [ indicatorChunk "took",
+        " ",
+        chunk $
+          T.pack $ printf "%4.2fs" diffTime
+      ]

feedback/src/Feedback/Loop.hs

@@ -7,10 +7,12 @@ module Feedback.Loop where
 import Control.Monad
 import Data.List
 import qualified Data.Text as T
+import Data.Word
 import Feedback.Common.OptParse
 import Feedback.Common.Output
 import Feedback.Common.Process
 import Feedback.Loop.OptParse
+import GHC.Clock (getMonotonicTimeNSec)
 import Path
 import Path.IO
 import System.Exit
@@ -75,9 +77,13 @@ processWorker command eventChan outputChan = do
   let sendOutput = writeChan outputChan
   currentProcessVar <- newEmptyMVar
   let startNewProcess = do
+        start <- getMonotonicTimeNSec
+        let endFunc ec = do
+              end <- getMonotonicTimeNSec
+              sendOutput $ OutputProcessExited ec (end - start)
         processHandle <-
           startProcessHandle
-            (sendOutput . OutputProcessExited)
+            endFunc
             command
         putMVar currentProcessVar processHandle
         sendOutput $ OutputProcessStarted command
@@ -100,7 +106,7 @@ data Output
   | OutputKilling
   | OutputKilled
   | OutputProcessStarted !String
-  | OutputProcessExited !ExitCode
+  | OutputProcessExited !ExitCode !Word64
   deriving (Show)
 
 outputWorker :: OutputSettings -> Chan Output -> IO ()
@@ -131,4 +137,6 @@ outputWorker OutputSettings {..} outputChan = do
             " ",
             commandChunk command
           ]
-      OutputProcessExited ec -> put $ exitCodeChunks ec
+      OutputProcessExited ec nanosecs -> do
+        put $ exitCodeChunks ec
+        put $ durationChunks nanosecs

feedback/src/Feedback/Test.hs

@@ -9,6 +9,7 @@ import Feedback.Common.OptParse
 import Feedback.Common.Output
 import Feedback.Common.Process
 import Feedback.Test.OptParse
+import GHC.Clock (getMonotonicTimeNSec)
 import Text.Colour.Capabilities.FromEnv (getTerminalCapabilitiesFromEnv)
 
 runFeedbackTest :: IO ()
@@ -19,5 +20,9 @@ runFeedbackTest = do
   forM_ (M.toList testSettingLoops) $ \(loopName, LoopSettings {..}) -> do
     put [indicatorChunk "testing ", " ", loopNameChunk loopName]
     put [indicatorChunk "starting", " ", commandChunk loopSettingCommand]
+    start <- getMonotonicTimeNSec
     ec <- startProcessAndWait loopSettingCommand
+    end <- getMonotonicTimeNSec
     put $ exitCodeChunks ec
+    let duration = end - start
+    put $ durationChunks duration