Support headers
parent
33019050c5
commit
095eab90dc
|
|
@ -93,14 +93,17 @@ data StreamKind = StdOut | StdErr
|
|||
deriving (Eq, Show)
|
||||
|
||||
data JoinMode
|
||||
= JoinYield -- i.e. don't join: We want to yield that exact line
|
||||
| JoinAll -- join with any other JoinAll-tagged lines/patterns
|
||||
= JoinYield -- don't join: We want to yield that exact line
|
||||
| JoinDrop -- don't join, and drop the line from the summary
|
||||
| JoinAllKeep -- join with any other JoinAll-tagged lines/patterns, override headers
|
||||
| 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
|
||||
|
||||
data JoinedInfo
|
||||
= JoinedNot -- Line did not match any pattern
|
||||
| JoinedYield -- Line matched a yield pattern, must be forwarded as-is
|
||||
| JoinedAll Int
|
||||
= JoinedNot Bool -- yield or drop, not to be merged. bool determines whether to forward
|
||||
| JoinedHeader Bool 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
|
||||
|
||||
data KeepMode
|
||||
|
|
@ -226,6 +229,25 @@ dispatchPat oldKind i pat prefix = do
|
|||
StdOut -> when (c_keepStdout conf /= Drop) $ outputConcurrent prettyPat
|
||||
StdErr -> when (c_keepStderr conf /= Drop) $ errorConcurrent prettyPat
|
||||
|
||||
showHeader :: Text -> Int -> Int -> Text
|
||||
showHeader header countOut countErr =
|
||||
header
|
||||
<> fGrey
|
||||
<> t " ("
|
||||
<> t (show countOut)
|
||||
<> t "/"
|
||||
<> t (show countErr)
|
||||
<> t " lines out/err)"
|
||||
<> fReset
|
||||
|
||||
dispatchHeader :: StreamKind -> Int -> Int -> Text -> StateT State IO ()
|
||||
dispatchHeader oldKind countOut countErr header = do
|
||||
let prettyPat = showHeader header countOut countErr <> t "\n"
|
||||
conf <- gets s_config
|
||||
liftIO $ case oldKind of
|
||||
StdOut -> when (c_keepStdout conf /= Drop) $ outputConcurrent prettyPat
|
||||
StdErr -> when (c_keepStderr conf /= Drop) $ errorConcurrent prettyPat
|
||||
|
||||
dispatchSkipped :: StreamKind -> Int -> StateT State IO ()
|
||||
dispatchSkipped oldKind i = do
|
||||
let kindStr = case oldKind of
|
||||
|
|
@ -250,83 +272,118 @@ summarizeLines :: (StreamKind, Text, Float) -> StateT State IO ()
|
|||
summarizeLines (kind, line, _linetime) = do
|
||||
s <- get
|
||||
let conf = s_config s
|
||||
let match :: Maybe (JoinMode, Text) =
|
||||
let match :: (JoinMode, Text) =
|
||||
case
|
||||
firstJust
|
||||
( firstJust
|
||||
(\(mode, pat, regex) -> if Regex.matchTest regex line
|
||||
then Just (mode, pat)
|
||||
else Nothing
|
||||
)
|
||||
(c_summarize conf)
|
||||
, kind
|
||||
)
|
||||
of
|
||||
j@Just{} -> j
|
||||
Nothing | kind == StdOut && c_keepStdout conf == Conflate ->
|
||||
Just (JoinAll, t "*")
|
||||
Nothing | kind == StdErr && c_keepStderr conf == Conflate ->
|
||||
Just (JoinAll, t "*")
|
||||
Nothing -> Nothing
|
||||
(Just j , _ ) -> j
|
||||
(Nothing, StdOut) -> case c_keepStdout conf of
|
||||
Conflate -> (JoinAllKeep, t "*")
|
||||
Keep -> (JoinYield, t "*")
|
||||
Drop -> (JoinDrop, t "*")
|
||||
(Nothing, StdErr) -> case c_keepStderr conf of
|
||||
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
|
||||
Nothing -> JoinedNot
|
||||
Just (JoinYield , _ ) -> JoinedYield
|
||||
Just (JoinAll , _ ) -> JoinedAll 1
|
||||
Just (JoinSpecific, pat) -> Joined 1 pat (Text.words line)
|
||||
(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
|
||||
)
|
||||
}
|
||||
(Just (oldKind, oldLine, JoinedNot), _) -> do
|
||||
dispatchLine (oldKind, oldLine)
|
||||
-- (Just (oldKind, oldLine, JoinedNot), _) -> do
|
||||
-- dispatchLine (oldKind, oldLine)
|
||||
-- put s
|
||||
-- { s_summary = Just
|
||||
-- ( kind
|
||||
-- , line
|
||||
-- , case match of
|
||||
-- Nothing -> JoinedNot
|
||||
-- Just (JoinYield , _ ) -> JoinedYield
|
||||
-- Just (JoinAllKeep , _ ) -> JoinedAll True 1
|
||||
-- Just (JoinAllDrop , _ ) -> JoinedAll False 1
|
||||
-- Just (JoinSpecific, pat) -> Joined 1 pat (Text.words line)
|
||||
-- Just (JoinHeader , _ ) -> JoinedHeader
|
||||
-- )
|
||||
-- }
|
||||
(Just (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
|
||||
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
|
||||
case replaceMay of
|
||||
Just replace -> do
|
||||
when keep $ dispatchHeader oldKind countOut countErr oldLine
|
||||
put s { s_summary = Just (kind, line, replace) }
|
||||
Nothing -> do
|
||||
put s
|
||||
{ s_summary = Just
|
||||
( kind
|
||||
, line
|
||||
, case match of
|
||||
Nothing -> JoinedNot
|
||||
Just (JoinYield , _ ) -> JoinedYield
|
||||
Just (JoinAll , _ ) -> JoinedAll 1
|
||||
Just (JoinSpecific, pat) -> Joined 1 pat (Text.words line)
|
||||
( oldKind
|
||||
, oldLine
|
||||
, case kind of
|
||||
StdOut ->
|
||||
JoinedHeader keep (countOut + 1) countErr
|
||||
StdErr ->
|
||||
JoinedHeader keep countOut (countErr + 1)
|
||||
)
|
||||
}
|
||||
(Just (oldKind, oldLine, JoinedYield), Nothing) -> do
|
||||
dispatchYielded (oldKind, oldLine)
|
||||
put s { s_summary = Just (kind, line, JoinedNot) }
|
||||
(Just (oldKind, oldLine, JoinedYield), _) -> do
|
||||
dispatchYielded (oldKind, oldLine)
|
||||
put s
|
||||
{ s_summary = Just
|
||||
( kind
|
||||
, line
|
||||
, case match of
|
||||
Nothing -> JoinedNot
|
||||
Just (JoinAll , _ ) -> JoinedAll 1
|
||||
Just (JoinSpecific, pat) -> Joined 1 pat (Text.words line)
|
||||
Just (JoinYield , _ ) -> JoinedYield
|
||||
)
|
||||
}
|
||||
(Just (oldKind, _, JoinedAll i), Nothing) -> do
|
||||
dispatchSkipped oldKind i
|
||||
put s { s_summary = Just (kind, line, JoinedNot) }
|
||||
(Just (oldKind, _, Joined i oldPat oldPrefix), Nothing) -> do
|
||||
dispatchPat oldKind i oldPat oldPrefix
|
||||
put s { s_summary = Just (kind, line, JoinedNot) }
|
||||
(Just (oldKind, _, JoinedAll i), Just joiner) -> case joiner of
|
||||
(Just (oldKind, _, JoinedAll keep i), joiner) -> case joiner of
|
||||
(JoinYield, _pat) -> do
|
||||
dispatchSkipped oldKind i
|
||||
put s { s_summary = Just (kind, line, JoinedYield) }
|
||||
(JoinAll, _)
|
||||
when keep $ dispatchSkipped oldKind i
|
||||
put s { s_summary = Just (kind, line, JoinedNot True) }
|
||||
(JoinAllKeep, _)
|
||||
| kind == oldKind -> do
|
||||
put s { s_summary = Just (kind, line, JoinedAll (i + 1)) }
|
||||
put s { s_summary = Just (kind, line, JoinedAll True (i + 1)) }
|
||||
| otherwise -> do
|
||||
dispatchSkipped oldKind i
|
||||
put s { s_summary = Just (kind, line, JoinedAll 1) }
|
||||
when keep $ dispatchSkipped oldKind i
|
||||
put s { s_summary = Just (kind, line, JoinedAll True 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)) }
|
||||
(Just (oldKind, _, Joined i oldPat oldPrefix), Just joiner) ->
|
||||
case joiner of
|
||||
(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 [] = []
|
||||
|
|
@ -341,9 +398,12 @@ summarizeLines (kind, line, _linetime) = do
|
|||
( kind
|
||||
, line
|
||||
, case joiner of
|
||||
(JoinYield , _ ) -> JoinedYield
|
||||
(JoinAll , _ ) -> JoinedAll 1
|
||||
(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
|
||||
)
|
||||
}
|
||||
|
||||
|
|
@ -393,11 +453,17 @@ processLine newKind newLine = execStateT $ do
|
|||
summary <- gets s_summary
|
||||
pure $ case summary of
|
||||
Nothing -> prettyLines
|
||||
Just (StdOut, line, JoinedNot) ->
|
||||
Just (StdOut, line, JoinedNot _) ->
|
||||
(fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines
|
||||
Just (StdOut, line, JoinedAll 1) ->
|
||||
Just (StdOut, line, JoinedHeader _ countOut countErr) ->
|
||||
(fWhiteDis <> t "│ " <> fReset <> ellipse
|
||||
conf
|
||||
(showHeader line countOut countErr)
|
||||
)
|
||||
: prettyLines
|
||||
Just (StdOut, line, JoinedAll _ 1) ->
|
||||
(fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines
|
||||
Just (StdOut, _line, JoinedAll i) ->
|
||||
Just (StdOut, _line, JoinedAll _ i) ->
|
||||
( fWhiteDis
|
||||
<> t "│ "
|
||||
<> fGrey
|
||||
|
|
@ -421,15 +487,17 @@ processLine newKind newLine = execStateT $ do
|
|||
<> fReset
|
||||
)
|
||||
: prettyLines
|
||||
Just (StdOut, line, JoinedYield) ->
|
||||
(fWhiteDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines
|
||||
Just (StdErr, line, JoinedNot) ->
|
||||
Just (StdErr, line, JoinedNot _) ->
|
||||
(fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines
|
||||
Just (StdErr, line, JoinedYield) ->
|
||||
Just (StdErr, line, JoinedHeader _ countOut countErr) ->
|
||||
(fRedDis <> t "│ " <> fReset <> ellipse
|
||||
conf
|
||||
(showHeader line countOut countErr)
|
||||
)
|
||||
: prettyLines
|
||||
Just (StdErr, line, JoinedAll _ 1) ->
|
||||
(fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines
|
||||
Just (StdErr, line, JoinedAll 1) ->
|
||||
(fRedDis <> t "│ " <> fReset <> ellipse conf line) : prettyLines
|
||||
Just (StdErr, _line, JoinedAll i) ->
|
||||
Just (StdErr, _line, JoinedAll _ i) ->
|
||||
( fRedDis
|
||||
<> t "│ "
|
||||
<> fGrey
|
||||
|
|
@ -506,69 +574,73 @@ updateStateLine = do
|
|||
quoteIfSpaces :: String -> String
|
||||
quoteIfSpaces s = if any Char.isSpace s then "\"" ++ s ++ "\"" else s
|
||||
|
||||
-- brittany-next-binding --columns 180
|
||||
main :: IO ()
|
||||
main = B.mainFromCmdParser $ do
|
||||
B.reorderStart
|
||||
-- For both stdout and stderr, each line flow through multiple stages.
|
||||
-- In the console UI, lines "flow" from bottom of the screen upwards.
|
||||
-- Lets image we run over the canonical "fizzbuzz" linewise output:
|
||||
-- -- 1, 2, Fizz, 4, Buzz, Fizz, 7, 8, Fizz, Buzz, 11, Fizz, 13, 14, Fizz Buzz, 16, 17, Fizz, 19, Buzz, Fizz, 22, 23, Fizz, Buzz, 26, Fizz, 28, 29, Fizz Buzz, 31, 32, Fizz, 34, Buzz, Fizz, ...
|
||||
-- We configure to 2 live lines + summary, summarizing lines that contain
|
||||
-- numbers, yielding lines that contain Fizz/Buzz.
|
||||
-- Time flows from left to right:
|
||||
-- (you can see this live by running:)
|
||||
-- > hxbrief --drop --yield "Fizz|Buzz" -s "[0-9]" -n3 -- ./sample-fizzbuzz.sh
|
||||
-- t0 t1 t2 t3 t4 t5 t6 t7 t8 Line class
|
||||
-- .... -forwarded-
|
||||
-- Fizz Buzz -forwarded-
|
||||
-- Fizz Fizz Buzz Fizz -forwarded-
|
||||
-- | 1 | %d+ | Fizz | 4 | Buzz | Fizz | 7 -summary-
|
||||
-- | 1 | 2 | Fizz | 4 | Buzz | Fizz | 7 | 8 -live-
|
||||
-- | 1 | 2 | Fizz | 4 | Buzz | Fizz | 7 | 8 | Fizz -live-
|
||||
--
|
||||
-- As you can see, lines flow from being the output of our fizzbuzz into our
|
||||
-- live display, into the summary, into the forwarded. At each step, we can
|
||||
-- filter/merge lines, i.e.
|
||||
--
|
||||
-- input --------> live --------------> summary --------> forwarded
|
||||
-- filter f1 filter/merge f2 filter f3
|
||||
--
|
||||
-- f1/f2/f3 together determine how far each line "travels". hxbrief allows
|
||||
-- configuring a) a default behaviour b) a list of (regex, behaviour) pairs
|
||||
-- that control how any particular input line is handled.
|
||||
-- behaviour | matching lines ...
|
||||
-- 1) discard | are filtered out at f1. All other pass f1.
|
||||
-- 2) drop | are filtered out at f2.
|
||||
-- 3) conflate | combine with any other lines with this behaviour
|
||||
-- 4) group | combine with lines that matched the same pattern, get filtered at f3
|
||||
-- 5) summary | combine with lines that matched the same pattern, pass f3
|
||||
-- 6) header | always replace the current summary, get filtered out at f3
|
||||
-- 7) yield | always replace the current summary, pass f3
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
numLines :: Int <- B.addFlagReadParam "n" ["lines"] "LINES" (B.flagDefault 5)
|
||||
maxLines <- B.addSimpleBoolFlag "" ["max-lines"] mempty
|
||||
keepStdout <- B.addSimpleBoolFlag "" ["keep-out"] mempty
|
||||
keepStderr <- B.addSimpleBoolFlag "" ["keep-err"] mempty
|
||||
keepBoth <- B.addSimpleBoolFlag "" ["keep"] mempty
|
||||
keepBoth <- B.addSimpleBoolFlag "" ["keep-all"] mempty
|
||||
dropStdout <- B.addSimpleBoolFlag "" ["drop-out"] mempty
|
||||
dropStderr <- B.addSimpleBoolFlag "" ["drop-err"] mempty
|
||||
dropBoth <- B.addSimpleBoolFlag "" ["drop"] mempty
|
||||
dropBoth <- B.addSimpleBoolFlag "" ["drop-all"] mempty
|
||||
conflateStdout <- B.addSimpleBoolFlag "" ["conflate-out"] mempty
|
||||
conflateStderr <- B.addSimpleBoolFlag "" ["conflate-err"] mempty
|
||||
conflateBoth <- B.addSimpleBoolFlag "" ["conflate"] mempty
|
||||
summarize <- B.addFlagStringParams
|
||||
"s"
|
||||
["summarize"]
|
||||
"REGEX"
|
||||
(B.flagHelpStr "bundle lines starting with this pattern into one line")
|
||||
summarizeFull <- B.addFlagStringParams
|
||||
""
|
||||
["summarize-any"]
|
||||
"REGEX"
|
||||
(B.flagHelpStr "bundle lines containing this pattern into one line")
|
||||
skip <- B.addFlagStringParams
|
||||
"x"
|
||||
["skip"]
|
||||
"REGEX"
|
||||
(B.flagHelpStr "drop lines starting with this pattern, similar to `grep -v`"
|
||||
)
|
||||
skipFull <- B.addFlagStringParams
|
||||
""
|
||||
["skip-any"]
|
||||
"REGEX"
|
||||
(B.flagHelpStr "drop lines containing this pattern, similar to `grep -v`")
|
||||
conflateBoth <- B.addSimpleBoolFlag "" ["conflate-all"] mempty
|
||||
summarize <- B.addFlagStringParams "s" ["summarize"] "REGEX" (B.flagHelpStr "bundle lines starting with this pattern into one line")
|
||||
summarizeFull <- B.addFlagStringParams "" ["summarize-any"] "REGEX" (B.flagHelpStr "bundle lines containing this pattern into one line")
|
||||
dropArg <- B.addFlagStringParams "x" ["drop"] "REGEX" (B.flagHelpStr "drop lines starting with this pattern, similar to `grep -v`")
|
||||
dropFull <- B.addFlagStringParams "" ["drop-any"] "REGEX" (B.flagHelpStr "drop lines containing this pattern, similar to `grep -v`")
|
||||
label <- B.addFlagStringParams "" ["label"] "STRING" mempty
|
||||
yield <- B.addFlagStringParams
|
||||
"y"
|
||||
["yield"]
|
||||
"REGEX"
|
||||
(B.flagHelpStr
|
||||
"always fully retain lines starting with this pattern, disregarding skip/summarize"
|
||||
)
|
||||
yieldFull <- B.addFlagStringParams
|
||||
""
|
||||
["yield-any"]
|
||||
"REGEX"
|
||||
(B.flagHelpStr
|
||||
"always fully retain lines containing this pattern, disregarding skip/summarize"
|
||||
)
|
||||
yield <- B.addFlagStringParams "y" ["yield"] "REGEX" (B.flagHelpStr "always fully retain lines starting with 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")
|
||||
headerFull <- B.addFlagStringParams "" ["header-any"] "REGEX" (B.flagHelpStr "containing this pattern: always replaces summary, then gets dropped")
|
||||
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")
|
||||
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")
|
||||
-- section <- B.addSimpleBoolFlag "" ["section"] mempty
|
||||
B.reorderStop
|
||||
rest <- B.addParamRestOfInputRaw "COMMAND" mempty <&> \case
|
||||
|
|
@ -625,24 +697,13 @@ main = B.mainFromCmdParser $ do
|
|||
envLines <- System.Environment.lookupEnv "LINES"
|
||||
envCols <- System.Environment.lookupEnv "COLUMNS"
|
||||
pure $ (,) <$> (envLines >>= readMaybe) <*> (envCols >>= readMaybe)
|
||||
let stdoutCheckCount =
|
||||
length
|
||||
$ [ () | keepStdout || keepBoth ]
|
||||
++ [ () | conflateStdout || conflateBoth ]
|
||||
++ [ () | dropStdout || dropBoth ]
|
||||
let stderrCheckCount =
|
||||
length
|
||||
$ [ () | keepStderr || keepBoth ]
|
||||
++ [ () | conflateStderr || conflateBoth ]
|
||||
++ [ () | dropStderr || dropBoth ]
|
||||
let stdoutCheckCount = length $ [ () | keepStdout || keepBoth ] ++ [ () | conflateStdout || conflateBoth ] ++ [ () | dropStdout || dropBoth ]
|
||||
let stderrCheckCount = length $ [ () | keepStderr || keepBoth ] ++ [ () | conflateStderr || conflateBoth ] ++ [ () | dropStderr || dropBoth ]
|
||||
adjustedNumLines <- case termSizeMay of
|
||||
Just (termLines, _) | maxLines -> pure $ max 1 (termLines - 3)
|
||||
Just (termLines, _) | termLines < numLines + 3 -> do
|
||||
let actual = max 1 (termLines - 3)
|
||||
errorConcurrent
|
||||
$ "Warning: output is too small, only showing "
|
||||
++ show actual
|
||||
++ " lines!\n"
|
||||
errorConcurrent $ "Warning: output is too small, only showing " ++ show actual ++ " lines!\n"
|
||||
pure actual
|
||||
_ -> pure numLines
|
||||
let compiler joinMode x = do
|
||||
|
|
@ -658,8 +719,10 @@ main = B.mainFromCmdParser $ do
|
|||
, yieldFull <&> compiler JoinYield
|
||||
, summarize <&> compiler JoinSpecific . (\x -> "^(" ++ x ++ ")")
|
||||
, summarizeFull <&> compiler JoinSpecific
|
||||
, skip <&> compiler JoinAll . (\x -> "^(" ++ x ++ ")")
|
||||
, skipFull <&> compiler JoinAll
|
||||
, header <&> compiler JoinHeader . (\x -> "^(" ++ x ++ ")")
|
||||
, headerFull <&> compiler JoinHeader
|
||||
, dropArg <&> compiler JoinAllDrop . (\x -> "^(" ++ x ++ ")")
|
||||
, dropFull <&> compiler JoinAllDrop
|
||||
]
|
||||
(lastLine, ecMay) <- displayConsoleRegions $ do
|
||||
initialState <- do
|
||||
|
|
@ -668,22 +731,18 @@ main = B.mainFromCmdParser $ do
|
|||
pure State
|
||||
{ s_config = Config
|
||||
{ c_label = case label of
|
||||
[] ->
|
||||
let full = unwords $ map quoteIfSpaces rest
|
||||
in t $ if length full < 80 then full else head rest
|
||||
[] -> let full = unwords $ map quoteIfSpaces rest in t $ if length full < 80 then full else head rest
|
||||
[labelStr] -> t labelStr
|
||||
_ -> error "too many labels!"
|
||||
, c_lines = adjustedNumLines
|
||||
, c_keepStdout = if
|
||||
| stdoutCheckCount > 1 -> error
|
||||
"too many keep/drop/conflate for stdout!"
|
||||
| stdoutCheckCount > 1 -> error "too many keep/drop/conflate for stdout!"
|
||||
| keepStdout || keepBoth -> Keep
|
||||
| conflateStdout || conflateBoth -> Conflate
|
||||
| dropStdout || dropBoth -> Drop
|
||||
| otherwise -> Keep
|
||||
, c_keepStderr = if
|
||||
| stderrCheckCount > 1 -> error
|
||||
"too many keep/drop/conflate for stderr!"
|
||||
| stderrCheckCount > 1 -> error "too many keep/drop/conflate for stderr!"
|
||||
| keepStderr || keepBoth -> Keep
|
||||
| conflateStderr || conflateBoth -> Conflate
|
||||
| dropStderr || dropBoth -> Drop
|
||||
|
|
@ -726,26 +785,15 @@ main = B.mainFromCmdParser $ do
|
|||
modifyMVar_ stateVar (processLine StdErr x)
|
||||
let tickHandler = forever $ do
|
||||
threadDelay 333333
|
||||
modifyMVar_ stateVar
|
||||
$ execStateT
|
||||
$ updateLastLine
|
||||
>> updateStateLine
|
||||
modifyMVar_ stateVar $ execStateT $ updateLastLine >> updateStateLine
|
||||
innerEnv <- do
|
||||
env <- System.Environment.getEnvironment
|
||||
pure (env ++ [("IN_HXBRIEF", "1")])
|
||||
|
||||
let mainBlock =
|
||||
P.withCreateProcess
|
||||
((P.proc restPath restArgs) { P.std_in = P.CreatePipe
|
||||
, P.std_out = P.CreatePipe
|
||||
, P.std_err = P.CreatePipe
|
||||
, P.env = Just innerEnv
|
||||
}
|
||||
)
|
||||
P.withCreateProcess ((P.proc restPath restArgs) { P.std_in = P.CreatePipe, P.std_out = P.CreatePipe, P.std_err = P.CreatePipe, P.env = Just innerEnv })
|
||||
$ \(Just inp) (Just out) (Just err) hdl -> do
|
||||
A.withAsync (inHandler inp) $ \inAsync ->
|
||||
A.withAsync (outHandler out) $ \outAsync ->
|
||||
A.withAsync (errHandler err) $ \errAsync ->
|
||||
A.withAsync (inHandler inp) $ \inAsync -> A.withAsync (outHandler out) $ \outAsync -> A.withAsync (errHandler err) $ \errAsync ->
|
||||
A.withAsync tickHandler $ \_tickAsync -> do
|
||||
ec <- P.waitForProcess hdl
|
||||
A.cancel inAsync
|
||||
|
|
@ -759,30 +807,21 @@ main = B.mainFromCmdParser $ do
|
|||
countErr <- gets s_countErr
|
||||
if countOut == 0 && countErr == 1
|
||||
then do
|
||||
modify
|
||||
$ \s -> s { s_config = (s_config s) { c_keepStderr = Keep } }
|
||||
reverse finalLines
|
||||
`forM_` \(kind, line, _) -> dispatchLine (kind, line)
|
||||
modify $ \s -> s { s_config = (s_config s) { c_keepStderr = Keep } }
|
||||
reverse finalLines `forM_` \(kind, line, _) -> dispatchLine (kind, line)
|
||||
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 ) -> dispatchLine (kind, line)
|
||||
Just (kind, line, JoinedYield) -> dispatchYielded (kind, line)
|
||||
Just (kind, _ , JoinedAll i) -> dispatchSkipped kind i
|
||||
Just (kind, _, Joined i pat prefix) ->
|
||||
dispatchPat kind i pat prefix
|
||||
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
|
||||
line <- evalStateT (bumpNowTime >> stateLine) finalState
|
||||
s_regions finalState `forM_` \r -> closeConsoleRegion r
|
||||
let prefix =
|
||||
fGrey
|
||||
<> line
|
||||
<> t ", "
|
||||
<> setFGColorVivid Ansi.Blue
|
||||
<> (c_label $ s_config finalState)
|
||||
<> fGrey
|
||||
let prefix = fGrey <> line <> t ", " <> setFGColorVivid Ansi.Blue <> (c_label $ s_config finalState) <> fGrey
|
||||
let lastLine = case ecMay of
|
||||
Nothing -> prefix <> t ", UserInterrupt\n" <> fReset
|
||||
Just ec -> prefix <> t ", ec=" <> showEC ec <> t "\n"
|
||||
|
|
|
|||
Loading…
Reference in New Issue