From 7cebff0d30b628e4a7d32feff83a767c126e32e7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 8 Feb 2025 15:51:42 +0100
Subject: Time information in output

Changelog: Time information in output
---
 erebos-tester.cabal |  1 +
 src/Output.hs       | 22 ++++++++++++++++++----
 src/Run.hs          |  1 +
 3 files changed, 20 insertions(+), 4 deletions(-)

diff --git a/erebos-tester.cabal b/erebos-tester.cabal
index c944e83..77af52b 100644
--- a/erebos-tester.cabal
+++ b/erebos-tester.cabal
@@ -96,6 +96,7 @@ executable erebos-tester
         base            ^>= { 4.15, 4.16, 4.17, 4.18, 4.19, 4.20 },
         bytestring      ^>= { 0.10, 0.11, 0.12 },
         containers      ^>= { 0.6.2.1, 0.7 },
+        clock           ^>= { 0.8.4 },
         directory       ^>=1.3.6.0,
         filepath        ^>= { 1.4.2.1, 1.5.2 },
         Glob             >=0.10 && <0.11,
diff --git a/src/Output.hs b/src/Output.hs
index 135e6e0..1555e54 100644
--- a/src/Output.hs
+++ b/src/Output.hs
@@ -2,6 +2,7 @@ module Output (
     Output, OutputType(..),
     MonadOutput(..),
     startOutput,
+    resetOutputTime,
     outLine,
     outPromptGetLine,
     outPromptGetLineCompletion,
@@ -19,10 +20,14 @@ import Data.Text.Lazy.IO qualified as TL
 
 import System.Console.Haskeline
 import System.Console.Haskeline.History
+import System.Clock
+
+import Text.Printf
 
 data Output = Output
     { outState :: MVar OutputState
     , outConfig :: OutputConfig
+    , outStartedAt :: MVar TimeSpec
     }
 
 data OutputConfig = OutputConfig
@@ -52,9 +57,15 @@ instance MonadIO m => MonadOutput (ReaderT Output m) where
     getOutput = ask
 
 startOutput :: Bool -> Bool -> IO Output
-startOutput outVerbose outUseColor = Output
-    <$> newMVar OutputState { outPrint = TL.putStrLn, outHistory = emptyHistory }
-    <*> pure OutputConfig { .. }
+startOutput outVerbose outUseColor = do
+    outState <- newMVar OutputState { outPrint = TL.putStrLn, outHistory = emptyHistory }
+    outConfig <- pure OutputConfig {..}
+    outStartedAt <- newMVar =<< getTime Monotonic
+    return Output {..}
+
+resetOutputTime :: Output -> IO ()
+resetOutputTime Output {..} = do
+    modifyMVar_ outStartedAt . const $ getTime Monotonic
 
 outColor :: OutputType -> Text
 outColor OutputChildStdout = T.pack "0"
@@ -97,9 +108,12 @@ ioWithOutput act = liftIO . act =<< getOutput
 outLine :: MonadOutput m => OutputType -> Maybe Text -> Text -> m ()
 outLine otype prompt line = ioWithOutput $ \out ->
     when (outVerbose (outConfig out) || printWhenQuiet otype) $ do
+        stime <- readMVar (outStartedAt out)
+        nsecs <- toNanoSecs . (`diffTimeSpec` stime) <$> getTime Monotonic
         withMVar (outState out) $ \st -> do
             outPrint st $ TL.fromChunks $ concat
-                [ if outUseColor (outConfig out)
+                [ [ T.pack $ printf "[% 2d.%03d] " (nsecs `quot` 1000000000) ((nsecs `quot` 1000000) `rem` 1000) ]
+                , if outUseColor (outConfig out)
                     then [ T.pack "\ESC[", outColor otype, T.pack "m" ]
                     else []
                 , [ maybe "" (<> outSign otype <> outArr otype <> " ") prompt ]
diff --git a/src/Run.hs b/src/Run.hs
index 001d887..330d147 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -88,6 +88,7 @@ runTest out opts test variables = do
                 withVarExprList rest act
         withVarExprList [] act = act
 
+    resetOutputTime out
     res <- runExceptT $ flip runReaderT (tenv, tstate) $ fromTestRun $ do
         withVarExprList variables $ do
             withInternet $ \_ -> do
-- 
cgit v1.2.3