From 8956098913a84df3fbbc28327f16a62b1be226c4 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Mon, 12 Dec 2022 17:10:17 +0100 Subject: [PATCH] Support error-start/stop for capturing regex-matched error output --- src-hxbrief/Main.hs | 223 ++++++++++++++++++++++++-------------------- 1 file changed, 121 insertions(+), 102 deletions(-) diff --git a/src-hxbrief/Main.hs b/src-hxbrief/Main.hs index 7cf6dc2..6ae7f52 100644 --- a/src-hxbrief/Main.hs +++ b/src-hxbrief/Main.hs @@ -99,6 +99,8 @@ data JoinMode | JoinAllDrop -- join with any other JoinAll-tagged lines/patterns, drop before headers, dont output | JoinSpecific -- join with this pattern only | JoinHeader -- join with nothing, stays, only gets replaced by next yield/header + | JoinErrorStart + | JoinErrorStop data JoinedInfo = JoinedNot Bool -- yield or drop, not to be merged. bool determines whether to forward @@ -118,6 +120,7 @@ data Config = Config , c_keepStdout :: KeepMode , c_keepStderr :: KeepMode , c_summarize :: [(JoinMode, Text, PCRE.Regex)] + , c_errorStop :: [PCRE.Regex] , c_outFile :: Maybe Handle , c_errFile :: Maybe Handle , c_sectionChar :: Maybe Char @@ -134,9 +137,14 @@ data State = State , s_globalStart :: TimeSpec , s_lastLineTime :: TimeSpec , s_nowTime :: TimeSpec - , s_summary :: Maybe (StreamKind, Text, JoinedInfo) + , s_summary :: Summary } +data Summary + = SummaryNone + | SummaryNorm StreamKind Text JoinedInfo + | SummaryErr StreamKind Text + -- bumpLineTime :: StateT State IO () -- bumpLineTime = do @@ -267,6 +275,16 @@ dispatchSkipped oldKind i = do StdOut -> when (c_keepStdout conf /= Drop) $ outputConcurrent prettyPat StdErr -> when (c_keepStderr conf /= Drop) $ errorConcurrent prettyPat +dispatchSummary :: Summary -> StateT State IO () +dispatchSummary = \case + SummaryErr kind line -> dispatchYielded (kind, line) + SummaryNone -> pure () + SummaryNorm kind line (JoinedNot keep) -> + when keep $ dispatchYielded (kind, line) + SummaryNorm kind line (JoinedHeader keep iOut iErr) -> + when keep $ dispatchHeader 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 summarizeLines :: (StreamKind, Text, Float) -> StateT State IO () summarizeLines (kind, line, _linetime) = do @@ -292,20 +310,39 @@ summarizeLines (kind, line, _linetime) = do Conflate -> (JoinAllKeep, t "*") Keep -> (JoinYield, t "*") Drop -> (JoinDrop, t "*") - case (s_summary s, match) of - (Nothing, _) -> put s - { s_summary = Just - ( kind - , line - , case match of - (JoinYield , _ ) -> JoinedNot True - (JoinAllKeep , _ ) -> JoinedAll True 1 - (JoinAllDrop , _ ) -> JoinedAll False 1 - (JoinSpecific, pat) -> Joined 1 pat (Text.words line) - (JoinHeader , _ ) -> JoinedHeader False 0 0 - (JoinDrop , _ ) -> JoinedNot False - ) + let + defaultReplace = put s + { s_summary = + (case match of + (JoinYield , _) -> SummaryNorm kind line (JoinedNot True) + (JoinAllKeep, _) -> SummaryNorm kind line (JoinedAll True 1) + (JoinAllDrop, _) -> SummaryNorm kind line (JoinedAll False 1) + (JoinSpecific, pat) -> + SummaryNorm kind line (Joined 1 pat (Text.words line)) + (JoinHeader , _) -> SummaryNorm kind line (JoinedHeader False 0 0) + (JoinDrop , _) -> SummaryNorm kind line (JoinedNot False) + (JoinErrorStart, _) -> SummaryErr kind line + (JoinErrorStop, _) -> + error "hxbrief internal error, unexpected JoinErrorStop" + ) } + case (s_summary s, match) of + (SummaryNone, (JoinErrorStart, _)) -> do + put s { s_summary = SummaryErr kind line } + (summary@SummaryNorm{}, (JoinErrorStart, _)) -> do + dispatchSummary summary + put s { s_summary = SummaryErr kind line } + (SummaryErr oldKind oldLine, _) -> do + dispatchYielded (oldKind, oldLine) + case + firstJust + (\regex -> if Regex.matchTest regex line then Just () else Nothing) + (c_errorStop conf) + of + Just () -> defaultReplace + Nothing -> do + put s { s_summary = SummaryErr kind line } + (SummaryNone, _ ) -> defaultReplace -- (Just (oldKind, oldLine, JoinedNot), _) -> do -- dispatchLine (oldKind, oldLine) -- put s @@ -321,91 +358,60 @@ summarizeLines (kind, line, _linetime) = do -- Just (JoinHeader , _ ) -> JoinedHeader -- ) -- } - (Just (oldKind, oldLine, JoinedNot keep), joiner) -> do + (SummaryNorm oldKind oldLine (JoinedNot keep), _joiner) -> do when keep $ dispatchYielded (oldKind, oldLine) - put s - { s_summary = case joiner of - (JoinYield , _pat) -> Just (kind, line, JoinedNot True) - (JoinAllKeep, _ ) -> Just (kind, line, JoinedAll True 1) - (JoinAllDrop, _ ) -> Just (kind, line, JoinedAll False 1) - (JoinSpecific, pat) -> - Just (kind, line, Joined 1 pat (Text.words line)) - (JoinHeader, _) -> Just (kind, line, JoinedHeader False 0 0) - (JoinDrop , _) -> Just (kind, line, JoinedNot False) - } - (Just (oldKind, oldLine, JoinedHeader keep countOut countErr), joiner) -> - do + defaultReplace + (SummaryNorm oldKind oldLine (JoinedHeader keep 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)) - (JoinHeader , _ ) -> Just (JoinedHeader False 0 0) - (JoinDrop , _ ) -> Nothing + (JoinYield , _pat) -> Just (JoinedNot True) + (JoinAllKeep , _ ) -> Just (JoinedAll True 1) + (JoinAllDrop , _ ) -> Nothing + (JoinSpecific , pat ) -> Just (Joined 1 pat (Text.words line)) + (JoinHeader , _ ) -> Just (JoinedHeader False 0 0) + (JoinDrop , _ ) -> Nothing + (JoinErrorStart, _ ) -> Nothing + (JoinErrorStop , _ ) -> Nothing case replaceMay of Just replace -> do when keep $ dispatchHeader oldKind countOut countErr oldLine - put s { s_summary = Just (kind, line, replace) } + put s { s_summary = SummaryNorm kind line replace } Nothing -> do put s - { s_summary = Just - ( oldKind - , oldLine - , case kind of + { s_summary = SummaryNorm + oldKind + oldLine + (case kind of StdOut -> JoinedHeader keep (countOut + 1) countErr StdErr -> JoinedHeader keep countOut (countErr + 1) ) } - (Just (oldKind, _, JoinedAll keep i), joiner) -> case joiner of - (JoinYield, _pat) -> do - when keep $ dispatchSkipped oldKind i - put s { s_summary = Just (kind, line, JoinedNot True) } + (SummaryNorm oldKind _ (JoinedAll keep i), joiner) -> case joiner of (JoinAllKeep, _) | kind == oldKind -> do - put s { s_summary = Just (kind, line, JoinedAll True (i + 1)) } - | otherwise -> do - when keep $ dispatchSkipped oldKind i - put s { s_summary = Just (kind, line, JoinedAll True 1) } + put s { s_summary = SummaryNorm kind line (JoinedAll True (i + 1)) } (JoinAllDrop, _) | kind == oldKind -> do - put s { s_summary = Just (kind, line, JoinedAll False (i + 1)) } - | otherwise -> do - when keep $ dispatchSkipped oldKind i - put s { s_summary = Just (kind, line, JoinedAll False 1) } - (JoinSpecific, pat) -> do - dispatchSkipped oldKind i - put s { s_summary = Just (kind, line, Joined 1 pat (Text.words line)) } - (JoinHeader, _) -> do - dispatchSkipped oldKind i - put s { s_summary = Just (kind, line, JoinedHeader False 0 0) } - (JoinDrop, _) -> do - dispatchSkipped oldKind i - put s { s_summary = Just (kind, line, JoinedNot False) } - (Just (oldKind, _, Joined i oldPat oldPrefix), joiner) -> case joiner of - (JoinSpecific, pat) | oldPat == pat && kind == oldKind -> do - let newPrefix = - let go [] = [] - go ((a, b) : rest) | a == b = a : go rest - | otherwise = [] - in go $ zip oldPrefix (Text.words line) - put s { s_summary = Just (kind, line, Joined (i + 1) pat newPrefix) } + put s { s_summary = SummaryNorm kind line (JoinedAll False (i + 1)) } _ -> do - dispatchPat oldKind i oldPat oldPrefix - put s - { s_summary = Just - ( kind - , line - , case joiner of - (JoinYield , _ ) -> JoinedNot True - (JoinAllKeep , _ ) -> JoinedAll True 1 - (JoinAllDrop , _ ) -> JoinedAll False 1 - (JoinSpecific, pat) -> Joined 1 pat (Text.words line) - (JoinHeader , _ ) -> JoinedHeader False 0 0 - (JoinDrop , _ ) -> JoinedNot False - ) - } + when keep $ dispatchSkipped oldKind i + defaultReplace + (SummaryNorm oldKind _ (Joined i oldPat oldPrefix), joiner) -> + case joiner of + (JoinSpecific, pat) | oldPat == pat && kind == oldKind -> do + let newPrefix = + let go [] = [] + go ((a, b) : rest) | a == b = a : go rest + | otherwise = [] + in go $ zip oldPrefix (Text.words line) + put s + { s_summary = SummaryNorm kind line (Joined (i + 1) pat newPrefix) + } + _ -> do + dispatchPat oldKind i oldPat oldPrefix + defaultReplace prettyLine :: Config -> (StreamKind, Text, Float) -> Text @@ -452,18 +458,18 @@ processLine newKind newLine = execStateT $ do summary <- gets s_summary pure $ case summary of - Nothing -> prettyLines - Just (StdOut, line, JoinedNot _) -> + SummaryNone -> prettyLines + SummaryNorm StdOut line (JoinedNot _) -> (fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines - Just (StdOut, line, JoinedHeader _ countOut countErr) -> + SummaryNorm StdOut line (JoinedHeader _ countOut countErr) -> (fWhiteDis <> t "│ " <> fReset <> ellipse conf (showHeader line countOut countErr) ) : prettyLines - Just (StdOut, line, JoinedAll _ 1) -> + SummaryNorm StdOut line (JoinedAll _ 1) -> (fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines - Just (StdOut, _line, JoinedAll _ i) -> + SummaryNorm StdOut _line (JoinedAll _ i) -> ( fWhiteDis <> t "│ " <> fGrey @@ -473,9 +479,9 @@ processLine newKind newLine = execStateT $ do <> fReset ) : prettyLines - Just (StdOut, line, Joined 1 _ _) -> + SummaryNorm StdOut line (Joined 1 _ _) -> (fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines - Just (StdOut, _, Joined i pat _) -> + SummaryNorm StdOut _ (Joined i pat _) -> ( fWhiteDis <> t "│ " <> fReset @@ -487,17 +493,19 @@ processLine newKind newLine = execStateT $ do <> fReset ) : prettyLines - Just (StdErr, line, JoinedNot _) -> + SummaryErr StdOut line -> + (fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines + SummaryNorm StdErr line (JoinedNot _) -> (fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines - Just (StdErr, line, JoinedHeader _ countOut countErr) -> + SummaryNorm StdErr line (JoinedHeader _ countOut countErr) -> (fRedDis <> t "│ " <> fReset <> ellipse conf (showHeader line countOut countErr) ) : prettyLines - Just (StdErr, line, JoinedAll _ 1) -> + SummaryNorm StdErr line (JoinedAll _ 1) -> (fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines - Just (StdErr, _line, JoinedAll _ i) -> + SummaryNorm StdErr _line (JoinedAll _ i) -> ( fRedDis <> t "│ " <> fGrey @@ -507,9 +515,9 @@ processLine newKind newLine = execStateT $ do <> fReset ) : prettyLines - Just (StdErr, line, Joined 1 _ _) -> + SummaryNorm StdErr line (Joined 1 _ _) -> (fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines - Just (StdErr, _, Joined i pat _) -> + SummaryNorm StdErr _ (Joined i pat _) -> ( fRedDis <> t "│ " <> fReset @@ -521,6 +529,8 @@ processLine newKind newLine = execStateT $ do <> fReset ) : prettyLines + SummaryErr StdErr line -> + (fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines let showCount = min (c_lines conf) (length prettyLinesWithSummary) do -- make sure we have enough regions allocated let need = showCount + 1 @@ -638,6 +648,10 @@ main = B.mainFromCmdParser $ do yieldFull <- B.addFlagStringParams "" ["yield-any"] "REGEX" (B.flagHelpStr "always fully retain lines containing this pattern, disregarding skip/summarize") header <- B.addFlagStringParams "h" ["header"] "REGEX" (B.flagHelpStr "starting with this pattern: always replaces summary, then gets dropped") headerFull <- B.addFlagStringParams "" ["header-any"] "REGEX" (B.flagHelpStr "containing this pattern: always replaces summary, then gets dropped") + errorStart <- B.addFlagStringParams "" ["error-start"] "REGEX" mempty + errorStartFull <- B.addFlagStringParams "" ["error-start-any"] "REGEX" mempty + errorStop <- B.addFlagStringParams "" ["error-stop"] "REGEX" mempty + errorStopFull <- B.addFlagStringParams "" ["error-stop-any"] "REGEX" mempty omitSummary <- B.addSimpleBoolFlag "" ["omit-summary"] mempty tee <- B.addFlagStringParams "" ["tee"] "BASENAMEBASEPATH" (B.flagHelp $ PP.text "Write copy of stdout/stderr to BASEPATH.{out/err}.txt") teeBoth <- B.addFlagStringParams "" ["tee-both"] "FILENAMEFILEPATH" (B.flagHelp $ PP.text "Write copy of stdout and stderr to FILEPATH") @@ -712,6 +726,12 @@ main = B.mainFromCmdParser $ do case regexE of Left err -> error $ show err Right regex -> pure (joinMode, tx, regex) + compilerStop x = do + let tx = t x + regexE <- PCRE.compile PCRE.compBlank PCRE.execBlank tx + case regexE of + Left err -> error $ show err + Right regex -> pure regex compiled_summarize <- sequence $ join @@ -723,8 +743,11 @@ main = B.mainFromCmdParser $ do , headerFull <&> compiler JoinHeader , dropArg <&> compiler JoinAllDrop . (\x -> "^(" ++ x ++ ")") , dropFull <&> compiler JoinAllDrop + , errorStart <&> compiler JoinErrorStart . (\x -> "^(" ++ x ++ ")") + , errorStartFull <&> compiler JoinErrorStart ] - (lastLine, ecMay) <- displayConsoleRegions $ do + compiled_errorStop <- sequence $ join [errorStop <&> compilerStop . (\x -> "^(" ++ x ++ ")"), errorStopFull <&> compilerStop] + (lastLine, ecMay) <- displayConsoleRegions $ do initialState <- do startTime <- getTime RealtimeCoarse line0 <- openConsoleRegion Linear @@ -748,6 +771,7 @@ main = B.mainFromCmdParser $ do | dropStderr || dropBoth -> Drop | otherwise -> Keep , c_summarize = compiled_summarize + , c_errorStop = compiled_errorStop , c_outFile = Nothing , c_errFile = Nothing , c_sectionChar = Nothing -- if section then Just '#' else Nothing @@ -761,7 +785,7 @@ main = B.mainFromCmdParser $ do , s_globalStart = startTime , s_lastLineTime = startTime , s_nowTime = startTime - , s_summary = Nothing + , s_summary = SummaryNone } stateVar :: MVar State <- newMVar initialState @@ -812,12 +836,7 @@ main = B.mainFromCmdParser $ do else do -- we leave the lines in final state, but process them reverse finalLines `forM_` summarizeLines - gets s_summary >>= \case - Nothing -> pure () - Just (kind, line, JoinedNot keep) -> when keep $ dispatchYielded (kind, line) - Just (kind, line, JoinedHeader keep iOut iErr) -> when keep $ dispatchHeader kind iOut iErr line - Just (kind, _, JoinedAll keep i) -> when keep $ dispatchSkipped kind i - Just (kind, _, Joined i pat prefix) -> dispatchPat kind i pat prefix + gets s_summary >>= dispatchSummary finalState <- takeMVar stateVar line <- evalStateT (bumpNowTime >> stateLine) finalState s_regions finalState `forM_` \r -> closeConsoleRegion r