Implement filter for console escape codes (behind flag)

--filter-escape-sequences filters output from the subprocess
so that backspace is respected, color codes and cursor
movement get ignored. In general the subprocess should be
configured to produce plain output instead, though.

src-hxbrief/Main.hs

@@ -126,6 +126,8 @@ data Config = Config
   , c_errFile     :: Maybe Handle
   , c_sectionChar :: Maybe Char
   , c_termSize    :: Maybe (Int, Int)
+  -- We don't need this in the config currently.
+  -- , c_filterEscapes :: Bool
   }
 
 data State = State
@@ -684,6 +686,7 @@ main = B.mainFromCmdParser $ do
   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")
+  filterEscapes   <- B.addSimpleBoolFlag "" ["filter-escape-sequences"] (B.flagHelpStr "filter console escape-sequences from process output. Slower, but prevents glitches.")
   -- section         <- B.addSimpleBoolFlag "" ["section"] mempty
   B.reorderStop
   rest <- B.addParamRestOfInputRaw "COMMAND" mempty <&> \case
@@ -831,13 +834,15 @@ main = B.mainFromCmdParser $ do
                         go
               in  go
         let outHandler out = forever $ do
-              x <- Text.filter (/= '\r') <$> Text.IO.hGetLine out
+              rawLine <- Text.IO.hGetLine out
-              fst teeHandles `forM_` \h -> Text.IO.hPutStrLn h x
+              let line = if filterEscapes then filterEscapeFunc rawLine else Text.filter (/= '\r') rawLine
-              modifyMVar_ stateVar (processLine StdOut x)
+              fst teeHandles `forM_` \h -> Text.IO.hPutStrLn h line
+              modifyMVar_ stateVar (processLine StdOut line)
         let errHandler err = forever $ do
-              x <- Text.filter (/= '\r') <$> Text.IO.hGetLine err
+              rawLine <- Text.IO.hGetLine err
-              snd teeHandles `forM_` \h -> Text.IO.hPutStrLn h x
+              let line = if filterEscapes then filterEscapeFunc rawLine else Text.filter (/= '\r') rawLine
-              modifyMVar_ stateVar (processLine StdErr x)
+              snd teeHandles `forM_` \h -> Text.IO.hPutStrLn h line
+              modifyMVar_ stateVar (processLine StdErr line)
         let tickHandler = forever $ do
               threadDelay 333333
               modifyMVar_ stateVar $ execStateT $ updateLastLine >> updateStateLine

src-hxbrief/Util.hs

@@ -3,6 +3,7 @@
 module Util where
 
 
+import qualified Data.Char                     as Char
 import           Data.Text                      ( Text )
 import qualified Data.Text                     as Text
 import qualified System.Console.ANSI           as Ansi
@@ -42,3 +43,31 @@ showEC :: ExitCode -> Text
 showEC = \case
   ExitSuccess   -> setFGColorVivid Ansi.Green <> t "0" <> fReset
   ExitFailure i -> setFGColorVivid Ansi.Red <> t (show i) <> fReset
+
+filterEscapeFunc :: Text -> Text
+filterEscapeFunc input = go Text.empty input
+ where
+  isSpecial c = Char.isControl c
+  go clean open = case Text.break isSpecial open of
+    (a, b) -> case Text.uncons b of
+      Nothing             -> clean <> a
+      Just ('\x07', rest) -> go (clean <> a) rest -- bell
+      Just ('\x08', rest) -> if Text.null a -- backspace
+        then if Text.null clean
+          then go clean rest
+          else go (Text.init clean) rest
+        else go (clean <> Text.init a) rest
+      Just ('\x09', rest) -> -- tab
+        go (clean <> a <> Text.pack "  ") rest
+      Just ('\x1b', rest) ->  -- esc
+                             clean <> a <> case Text.uncons rest of
+        Nothing             -> Text.empty
+        Just ('\x5b', more) -> finishEscape more
+        Just ('\x9b', more) -> finishEscape more
+        Just (_     , more) -> filterEscapeFunc more
+      Just (_, rest) -> go (clean <> a) rest
+  finishEscape remain = case Text.uncons remain of
+    Nothing        -> remain
+    Just (c, rest) -> if c >= '\x40' && c <= '\x7e'
+      then filterEscapeFunc rest
+      else finishEscape rest