From ac6997be19a32d6258edf2fad3c47c13b0e1b594 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Mon, 20 Feb 2023 15:00:45 +0100 Subject: [PATCH] Show per-line wall clock info --- src-hxbrief/Main.hs | 101 +++++++++++++++++++++++++++----------------- 1 file changed, 62 insertions(+), 39 deletions(-) diff --git a/src-hxbrief/Main.hs b/src-hxbrief/Main.hs index b9f94c8..80daf10 100644 --- a/src-hxbrief/Main.hs +++ b/src-hxbrief/Main.hs @@ -105,7 +105,7 @@ data JoinMode data JoinedInfo = JoinedNot Bool -- yield or drop, not to be merged. bool determines whether to forward - | JoinedHeader Bool (Maybe Text) Int Int -- header, not to be merged. bool determines whether to forward. Int is count stdout/stderr + | JoinedHeader TimeSpec Bool (Maybe Text) Int Int -- header, not to be merged. bool determines whether to forward. Int is count stdout/stderr | JoinedAll Bool Int -- bool determines whether to forward | Joined Int Text [Text] -- pattern, prefix @@ -238,21 +238,21 @@ dispatchPat oldKind i pat prefix = do StdOut -> when (c_keepStdout conf /= Drop) $ outputConcurrent prettyPat StdErr -> when (c_keepStderr conf /= Drop) $ errorConcurrent prettyPat -showHeader :: Text -> Maybe Text -> Int -> Int -> Text -showHeader header mLevel2 countOut countErr = +showHeader :: Float -> Text -> Maybe Text -> Int -> Int -> Text +showHeader diffTime header mLevel2 countOut countErr = header <> (maybe (t "") (\l2 -> t " " <> l2) mLevel2) <> fGrey - <> t " (" - <> t (show countOut) - <> t "/" - <> t (show countErr) - <> t " lines out/err)" + <> t (printf " (%i/%i lines out/err, %0.1fs)" countOut countErr diffTime) <> fReset -dispatchHeader :: StreamKind -> Int -> Int -> Text -> StateT State IO () -dispatchHeader oldKind countOut countErr header = do - let prettyPat = showHeader header Nothing countOut countErr <> t "\n" +dispatchHeader + :: TimeSpec -> StreamKind -> Int -> Int -> Text -> StateT State IO () +dispatchHeader startTime oldKind countOut countErr header = do + now <- gets s_nowTime + let prettyPat = + showHeader (diffTimes startTime now) header Nothing countOut countErr + <> t "\n" conf <- gets s_config liftIO $ case oldKind of StdOut -> when (c_keepStdout conf /= Drop) $ outputConcurrent prettyPat @@ -283,8 +283,8 @@ dispatchSummary = \case SummaryNone -> pure () SummaryNorm kind line (JoinedNot keep) -> when keep $ dispatchYielded (kind, line) - SummaryNorm kind line (JoinedHeader keep _mLevel2 iOut iErr) -> - when keep $ dispatchHeader kind iOut iErr line + SummaryNorm kind line (JoinedHeader startTime keep _mLevel2 iOut iErr) -> + when keep $ dispatchHeader startTime kind iOut iErr line SummaryNorm kind _ (JoinedAll keep i ) -> when keep $ dispatchSkipped kind i SummaryNorm kind _ (Joined i pat prefix) -> dispatchPat kind i pat prefix @@ -322,8 +322,9 @@ summarizeLines (kind, line, _linetime) = do (JoinSpecific, pat) -> SummaryNorm kind line (Joined 1 pat (Text.words line)) (JoinHeader1, _) -> - SummaryNorm kind line (JoinedHeader False Nothing 0 0) - (JoinHeader2 , _) -> SummaryNorm kind line (JoinedNot False) + SummaryNorm kind line (JoinedHeader (s_nowTime s) False Nothing 0 0) + (JoinHeader2, _) -> + SummaryNorm kind line (JoinedHeader (s_nowTime s) False Nothing 0 0) (JoinDrop , _) -> SummaryNorm kind line (JoinedNot False) (JoinErrorStart, _) -> SummaryErr kind line (JoinErrorStop, _) -> @@ -365,21 +366,24 @@ summarizeLines (kind, line, _linetime) = do (SummaryNorm oldKind oldLine (JoinedNot keep), _joiner) -> do when keep $ dispatchYielded (oldKind, oldLine) defaultReplace - (SummaryNorm oldKind oldLine (JoinedHeader keep mLevel2 countOut countErr), joiner) + (SummaryNorm oldKind oldLine (JoinedHeader startTime keep mLevel2 countOut countErr), joiner) -> do - let replaceMay = case joiner of - (JoinYield , _pat) -> Just (JoinedNot True) - (JoinAllKeep , _ ) -> Just (JoinedAll True 1) - (JoinAllDrop , _ ) -> Nothing - (JoinSpecific , pat ) -> Just (Joined 1 pat (Text.words line)) - (JoinHeader1 , _ ) -> Just (JoinedHeader False Nothing 0 0) - (JoinHeader2 , _ ) -> Nothing - (JoinDrop , _ ) -> Nothing - (JoinErrorStart, _ ) -> Nothing - (JoinErrorStop , _ ) -> Nothing + let + replaceMay = case joiner of + (JoinYield , _pat) -> Just (JoinedNot True) + (JoinAllKeep , _ ) -> Just (JoinedAll True 1) + (JoinAllDrop , _ ) -> Nothing + (JoinSpecific, pat ) -> Just (Joined 1 pat (Text.words line)) + (JoinHeader1, _) -> + Just (JoinedHeader (s_nowTime s) False Nothing 0 0) + (JoinHeader2 , _) -> Nothing + (JoinDrop , _) -> Nothing + (JoinErrorStart, _) -> Nothing + (JoinErrorStop , _) -> Nothing case replaceMay of Just replace -> do - when keep $ dispatchHeader oldKind countOut countErr oldLine + when keep + $ dispatchHeader startTime oldKind countOut countErr oldLine put s { s_summary = SummaryNorm kind line replace } Nothing -> do let newLevel2 = case joiner of @@ -390,8 +394,16 @@ summarizeLines (kind, line, _linetime) = do oldKind oldLine (case kind of - StdOut -> JoinedHeader keep newLevel2 (countOut + 1) countErr - StdErr -> JoinedHeader keep newLevel2 countOut (countErr + 1) + StdOut -> JoinedHeader startTime + keep + newLevel2 + (countOut + 1) + countErr + StdErr -> JoinedHeader startTime + keep + newLevel2 + countOut + (countErr + 1) ) } (SummaryNorm oldKind _ (JoinedAll keep i), joiner) -> case joiner of @@ -461,15 +473,21 @@ processLine newKind newLine = execStateT $ do reverse $ take (c_lines conf) curLines <&> prettyLine conf summary <- gets s_summary + now <- gets s_nowTime pure $ case summary of SummaryNone -> prettyLines SummaryNorm StdOut line (JoinedNot _) -> (fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines - SummaryNorm StdOut line (JoinedHeader _ mLevel2 countOut countErr) -> - (fWhiteDis <> t "│ " <> fReset <> ellipse - conf - (showHeader line mLevel2 countOut countErr) - ) + SummaryNorm StdOut line (JoinedHeader startTime _ mLevel2 countOut countErr) + -> (fWhiteDis <> t "│ " <> fReset <> ellipse + conf + (showHeader (diffTimes startTime now) + line + mLevel2 + countOut + countErr + ) + ) : prettyLines SummaryNorm StdOut line (JoinedAll _ 1) -> (fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines @@ -501,11 +519,16 @@ processLine newKind newLine = execStateT $ do (fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines SummaryNorm StdErr line (JoinedNot _) -> (fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines - SummaryNorm StdErr line (JoinedHeader _ mLevel2 countOut countErr) -> - (fRedDis <> t "│ " <> fReset <> ellipse - conf - (showHeader line mLevel2 countOut countErr) - ) + SummaryNorm StdErr line (JoinedHeader startTime _ mLevel2 countOut countErr) + -> (fRedDis <> t "│ " <> fReset <> ellipse + conf + (showHeader (diffTimes startTime now) + line + mLevel2 + countOut + countErr + ) + ) : prettyLines SummaryNorm StdErr line (JoinedAll _ 1) -> (fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines