From 49ffea3f2eb03e0c24dc5da804ee6ab9fb181759 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Mon, 20 Feb 2023 18:22:37 +0100
Subject: [PATCH] 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 | 17 +++++++++++------
 src-hxbrief/Util.hs | 29 +++++++++++++++++++++++++++++
 2 files changed, 40 insertions(+), 6 deletions(-)

diff --git a/src-hxbrief/Main.hs b/src-hxbrief/Main.hs
index 80daf10..4117a4e 100644
--- a/src-hxbrief/Main.hs
+++ b/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
-              fst teeHandles `forM_` \h -> Text.IO.hPutStrLn h x
-              modifyMVar_ stateVar (processLine StdOut x)
+              rawLine <- Text.IO.hGetLine out
+              let line = if filterEscapes then filterEscapeFunc rawLine else Text.filter (/= '\r') rawLine
+              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
-              snd teeHandles `forM_` \h -> Text.IO.hPutStrLn h x
-              modifyMVar_ stateVar (processLine StdErr x)
+              rawLine <- Text.IO.hGetLine err
+              let line = if filterEscapes then filterEscapeFunc rawLine else Text.filter (/= '\r') rawLine
+              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
diff --git a/src-hxbrief/Util.hs b/src-hxbrief/Util.hs
index 4c99422..c3cf6e4 100644
--- a/src-hxbrief/Util.hs
+++ b/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