From e1b7b08d398765676a1169fa4a1c0463b19f71d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sun, 30 Aug 2026 11:36:17 +0200 Subject: Gather and report test times --- src/Output.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) (limited to 'src/Output.hs') diff --git a/src/Output.hs b/src/Output.hs index b28ad5c..962a594 100644 --- a/src/Output.hs +++ b/src/Output.hs @@ -3,6 +3,7 @@ module Output ( MonadOutput(..), startOutput, resetOutputTime, + getElapsedTime, outLine, outLineF, outPromptGetLine, @@ -14,6 +15,7 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Reader +import Data.Scientific import Data.Text (Text) import Data.Text qualified as T import Data.Text.Lazy qualified as TL @@ -89,6 +91,12 @@ resetOutputTime :: Output -> IO () resetOutputTime Output {..} = do modifyMVar_ outStartedAt . const $ getTime Monotonic +getElapsedTime :: Output -> IO Scientific +getElapsedTime Output {..} = do + stime <- readMVar outStartedAt + (/ 1000000000) . fromIntegral . toNanoSecs . (`diffTimeSpec` stime) <$> getTime Monotonic + + outColor :: OutputType -> Text outColor = \case OutputGlobalInfo -> "0" @@ -185,13 +193,12 @@ outLineF otype prompt line = ioWithOutput $ \out -> OutputStyleTest -> testOutput out where normalOutput out = do - stime <- readMVar (outStartedAt out) - nsecs <- toNanoSecs . (`diffTimeSpec` stime) <$> getTime Monotonic + secs <- getElapsedTime out withMVar (outState out) $ \st -> do forM_ (normalOutputLines otype $ renderLine out line) $ \line' -> do outPrint st $ TL.fromChunks $ concat [ if includeTestTime otype - then [ T.pack $ printf "[% 2d.%03d] " (nsecs `quot` 1000000000) ((nsecs `quot` 1000000) `rem` 1000) ] + then [ T.pack $ printf "[% 2d.%03d] " (floor secs :: Integer) (floor (secs * 1000) `rem` 1000 :: Integer) ] else [] , if outUseColor (outConfig out) then [ T.pack "\ESC[", outColor otype, T.pack "m" ] -- cgit v1.2.3