hexagoxel
/
hxtools
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Support error-start/stop for capturing regex-matched error output

master
Lennart Spitzner 2022-12-12 17:10:17 +01:00
parent 095eab90dc
commit 8956098913
1 changed files with 121 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

223
src-hxbrief/Main.hs
View File

@ -99,6 +99,8 @@ data JoinMode
| JoinAllDrop -- join with any other JoinAll-tagged lines/patterns, drop before headers, dont output | JoinAllDrop -- join with any other JoinAll-tagged lines/patterns, drop before headers, dont output
| JoinSpecific -- join with this pattern only | JoinSpecific -- join with this pattern only
| JoinHeader -- join with nothing, stays, only gets replaced by next yield/header | JoinHeader -- join with nothing, stays, only gets replaced by next yield/header
| JoinErrorStart
| JoinErrorStop
data JoinedInfo data JoinedInfo
= JoinedNot Bool -- yield or drop, not to be merged. bool determines whether to forward = 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_keepStdout :: KeepMode
, c_keepStderr :: KeepMode , c_keepStderr :: KeepMode
, c_summarize :: [(JoinMode, Text, PCRE.Regex)] , c_summarize :: [(JoinMode, Text, PCRE.Regex)]
, c_errorStop :: [PCRE.Regex]
, c_outFile :: Maybe Handle , c_outFile :: Maybe Handle
, c_errFile :: Maybe Handle , c_errFile :: Maybe Handle
, c_sectionChar :: Maybe Char , c_sectionChar :: Maybe Char
@ -134,9 +137,14 @@ data State = State
, s_globalStart :: TimeSpec , s_globalStart :: TimeSpec
, s_lastLineTime :: TimeSpec , s_lastLineTime :: TimeSpec
, s_nowTime :: 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 :: StateT State IO ()
-- bumpLineTime = do -- bumpLineTime = do
@ -267,6 +275,16 @@ dispatchSkipped oldKind i = do
StdOut -> when (c_keepStdout conf /= Drop) $ outputConcurrent prettyPat StdOut -> when (c_keepStdout conf /= Drop) $ outputConcurrent prettyPat
StdErr -> when (c_keepStderr conf /= Drop) $ errorConcurrent 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 :: (StreamKind, Text, Float) -> StateT State IO ()
summarizeLines (kind, line, _linetime) = do summarizeLines (kind, line, _linetime) = do
@ -292,20 +310,39 @@ summarizeLines (kind, line, _linetime) = do
Conflate -> (JoinAllKeep, t "*") Conflate -> (JoinAllKeep, t "*")
Keep -> (JoinYield, t "*") Keep -> (JoinYield, t "*")
Drop -> (JoinDrop, t "*") Drop -> (JoinDrop, t "*")
case (s_summary s, match) of let
(Nothing, _) -> put s defaultReplace = put s
{ s_summary = Just { s_summary =
( kind (case match of
, line (JoinYield , _) -> SummaryNorm kind line (JoinedNot True)
, case match of (JoinAllKeep, _) -> SummaryNorm kind line (JoinedAll True 1)
(JoinYield , _ ) -> JoinedNot True (JoinAllDrop, _) -> SummaryNorm kind line (JoinedAll False 1)
(JoinAllKeep , _ ) -> JoinedAll True 1 (JoinSpecific, pat) ->
(JoinAllDrop , _ ) -> JoinedAll False 1 SummaryNorm kind line (Joined 1 pat (Text.words line))
(JoinSpecific, pat) -> Joined 1 pat (Text.words line) (JoinHeader , _) -> SummaryNorm kind line (JoinedHeader False 0 0)
(JoinHeader , _ ) -> JoinedHeader False 0 0 (JoinDrop , _) -> SummaryNorm kind line (JoinedNot False)
(JoinDrop , _ ) -> 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 -- (Just (oldKind, oldLine, JoinedNot), _) -> do
-- dispatchLine (oldKind, oldLine) -- dispatchLine (oldKind, oldLine)
-- put s -- put s
@ -321,91 +358,60 @@ summarizeLines (kind, line, _linetime) = do
-- Just (JoinHeader , _ ) -> JoinedHeader -- Just (JoinHeader , _ ) -> JoinedHeader
-- ) -- )
-- } -- }
(Just (oldKind, oldLine, JoinedNot keep), joiner) -> do (SummaryNorm oldKind oldLine (JoinedNot keep), _joiner) -> do
when keep $ dispatchYielded (oldKind, oldLine) when keep $ dispatchYielded (oldKind, oldLine)
put s defaultReplace
{ s_summary = case joiner of (SummaryNorm oldKind oldLine (JoinedHeader keep countOut countErr), joiner)
(JoinYield , _pat) -> Just (kind, line, JoinedNot True) -> do
(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
let replaceMay = case joiner of let replaceMay = case joiner of
(JoinYield , _pat) -> Just (JoinedNot True) (JoinYield , _pat) -> Just (JoinedNot True)
(JoinAllKeep , _ ) -> Just (JoinedAll True 1) (JoinAllKeep , _ ) -> Just (JoinedAll True 1)
(JoinAllDrop , _ ) -> Nothing (JoinAllDrop , _ ) -> Nothing
(JoinSpecific, pat ) -> Just (Joined 1 pat (Text.words line)) (JoinSpecific , pat ) -> Just (Joined 1 pat (Text.words line))
(JoinHeader , _ ) -> Just (JoinedHeader False 0 0) (JoinHeader , _ ) -> Just (JoinedHeader False 0 0)
(JoinDrop , _ ) -> Nothing (JoinDrop , _ ) -> Nothing
(JoinErrorStart, _ ) -> Nothing
(JoinErrorStop , _ ) -> Nothing
case replaceMay of case replaceMay of
Just replace -> do Just replace -> do
when keep $ dispatchHeader oldKind countOut countErr oldLine 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 Nothing -> do
put s put s
{ s_summary = Just { s_summary = SummaryNorm
( oldKind oldKind
, oldLine oldLine
, case kind of (case kind of
StdOut -> StdOut ->
JoinedHeader keep (countOut + 1) countErr JoinedHeader keep (countOut + 1) countErr
StdErr -> StdErr ->
JoinedHeader keep countOut (countErr + 1) JoinedHeader keep countOut (countErr + 1)
) )
} }
(Just (oldKind, _, JoinedAll keep i), joiner) -> case joiner of (SummaryNorm 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) }
(JoinAllKeep, _) (JoinAllKeep, _)
| kind == oldKind -> do | kind == oldKind -> do
put s { s_summary = Just (kind, line, JoinedAll True (i + 1)) } put s { s_summary = SummaryNorm kind line (JoinedAll True (i + 1)) }
| otherwise -> do
when keep $ dispatchSkipped oldKind i
put s { s_summary = Just (kind, line, JoinedAll True 1) }
(JoinAllDrop, _) (JoinAllDrop, _)
| kind == oldKind -> do | kind == oldKind -> do
put s { s_summary = Just (kind, line, JoinedAll False (i + 1)) } put s { s_summary = SummaryNorm 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) }
_ -> do _ -> do
dispatchPat oldKind i oldPat oldPrefix when keep $ dispatchSkipped oldKind i
put s defaultReplace
{ s_summary = Just (SummaryNorm oldKind _ (Joined i oldPat oldPrefix), joiner) ->
( kind case joiner of
, line (JoinSpecific, pat) | oldPat == pat && kind == oldKind -> do
, case joiner of let newPrefix =
(JoinYield , _ ) -> JoinedNot True let go [] = []
(JoinAllKeep , _ ) -> JoinedAll True 1 go ((a, b) : rest) | a == b = a : go rest
(JoinAllDrop , _ ) -> JoinedAll False 1 | otherwise = []
(JoinSpecific, pat) -> Joined 1 pat (Text.words line) in go $ zip oldPrefix (Text.words line)
(JoinHeader , _ ) -> JoinedHeader False 0 0 put s
(JoinDrop , _ ) -> JoinedNot False { s_summary = SummaryNorm kind line (Joined (i + 1) pat newPrefix)
) }
} _ -> do
dispatchPat oldKind i oldPat oldPrefix
defaultReplace
prettyLine :: Config -> (StreamKind, Text, Float) -> Text prettyLine :: Config -> (StreamKind, Text, Float) -> Text
@ -452,18 +458,18 @@ processLine newKind newLine = execStateT $ do
summary <- gets s_summary summary <- gets s_summary
pure $ case summary of pure $ case summary of
Nothing -> prettyLines SummaryNone -> prettyLines
Just (StdOut, line, JoinedNot _) -> SummaryNorm StdOut line (JoinedNot _) ->
(fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines (fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines
Just (StdOut, line, JoinedHeader _ countOut countErr) -> SummaryNorm StdOut line (JoinedHeader _ countOut countErr) ->
(fWhiteDis <> t "│ " <> fReset <> ellipse (fWhiteDis <> t "│ " <> fReset <> ellipse
conf conf
(showHeader line countOut countErr) (showHeader line countOut countErr)
) )
: prettyLines : prettyLines
Just (StdOut, line, JoinedAll _ 1) -> SummaryNorm StdOut line (JoinedAll _ 1) ->
(fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines (fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines
Just (StdOut, _line, JoinedAll _ i) -> SummaryNorm StdOut _line (JoinedAll _ i) ->
( fWhiteDis ( fWhiteDis
<> t "│ " <> t "│ "
<> fGrey <> fGrey
@ -473,9 +479,9 @@ processLine newKind newLine = execStateT $ do
<> fReset <> fReset
) )
: prettyLines : prettyLines
Just (StdOut, line, Joined 1 _ _) -> SummaryNorm StdOut line (Joined 1 _ _) ->
(fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines (fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines
Just (StdOut, _, Joined i pat _) -> SummaryNorm StdOut _ (Joined i pat _) ->
( fWhiteDis ( fWhiteDis
<> t "│ " <> t "│ "
<> fReset <> fReset
@ -487,17 +493,19 @@ processLine newKind newLine = execStateT $ do
<> fReset <> fReset
) )
: prettyLines : 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 (fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines
Just (StdErr, line, JoinedHeader _ countOut countErr) -> SummaryNorm StdErr line (JoinedHeader _ countOut countErr) ->
(fRedDis <> t "│ " <> fReset <> ellipse (fRedDis <> t "│ " <> fReset <> ellipse
conf conf
(showHeader line countOut countErr) (showHeader line countOut countErr)
) )
: prettyLines : prettyLines
Just (StdErr, line, JoinedAll _ 1) -> SummaryNorm StdErr line (JoinedAll _ 1) ->
(fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines (fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines
Just (StdErr, _line, JoinedAll _ i) -> SummaryNorm StdErr _line (JoinedAll _ i) ->
( fRedDis ( fRedDis
<> t "│ " <> t "│ "
<> fGrey <> fGrey
@ -507,9 +515,9 @@ processLine newKind newLine = execStateT $ do
<> fReset <> fReset
) )
: prettyLines : prettyLines
Just (StdErr, line, Joined 1 _ _) -> SummaryNorm StdErr line (Joined 1 _ _) ->
(fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines (fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines
Just (StdErr, _, Joined i pat _) -> SummaryNorm StdErr _ (Joined i pat _) ->
( fRedDis ( fRedDis
<> t "│ " <> t "│ "
<> fReset <> fReset
@ -521,6 +529,8 @@ processLine newKind newLine = execStateT $ do
<> fReset <> fReset
) )
: prettyLines : prettyLines
SummaryErr StdErr line ->
(fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines
let showCount = min (c_lines conf) (length prettyLinesWithSummary) let showCount = min (c_lines conf) (length prettyLinesWithSummary)
do -- make sure we have enough regions allocated do -- make sure we have enough regions allocated
let need = showCount + 1 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") 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") 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") 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 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") 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") 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 case regexE of
Left err -> error $ show err Left err -> error $ show err
Right regex -> pure (joinMode, tx, regex) 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 <- compiled_summarize <-
sequence sequence
$ join $ join
@ -723,8 +743,11 @@ main = B.mainFromCmdParser $ do
, headerFull <&> compiler JoinHeader , headerFull <&> compiler JoinHeader
, dropArg <&> compiler JoinAllDrop . (\x -> "^(" ++ x ++ ")") , dropArg <&> compiler JoinAllDrop . (\x -> "^(" ++ x ++ ")")
, dropFull <&> compiler JoinAllDrop , 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 initialState <- do
startTime <- getTime RealtimeCoarse startTime <- getTime RealtimeCoarse
line0 <- openConsoleRegion Linear line0 <- openConsoleRegion Linear
@ -748,6 +771,7 @@ main = B.mainFromCmdParser $ do
| dropStderr || dropBoth -> Drop | dropStderr || dropBoth -> Drop
| otherwise -> Keep | otherwise -> Keep
, c_summarize = compiled_summarize , c_summarize = compiled_summarize
, c_errorStop = compiled_errorStop
, c_outFile = Nothing , c_outFile = Nothing
, c_errFile = Nothing , c_errFile = Nothing
, c_sectionChar = Nothing -- if section then Just '#' else Nothing , c_sectionChar = Nothing -- if section then Just '#' else Nothing
@ -761,7 +785,7 @@ main = B.mainFromCmdParser $ do
, s_globalStart = startTime , s_globalStart = startTime
, s_lastLineTime = startTime , s_lastLineTime = startTime
, s_nowTime = startTime , s_nowTime = startTime
, s_summary = Nothing , s_summary = SummaryNone
} }
stateVar :: MVar State <- newMVar initialState stateVar :: MVar State <- newMVar initialState
@ -812,12 +836,7 @@ main = B.mainFromCmdParser $ do
else do else do
-- we leave the lines in final state, but process them -- we leave the lines in final state, but process them
reverse finalLines `forM_` summarizeLines reverse finalLines `forM_` summarizeLines
gets s_summary >>= \case gets s_summary >>= dispatchSummary
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
finalState <- takeMVar stateVar finalState <- takeMVar stateVar
line <- evalStateT (bumpNowTime >> stateLine) finalState line <- evalStateT (bumpNowTime >> stateLine) finalState
s_regions finalState `forM_` \r -> closeConsoleRegion r s_regions finalState `forM_` \r -> closeConsoleRegion r