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.

hxtools.cabal

@@ -33,7 +33,10 @@ executable hxbrief
                       async >=2.2.3 && <2.3,
                       transformers >=0.5.6.2 &&<0.6,
                       clock >=0.8 &&<0.9,
-                      pretty >=1.1.3.6 && <1.2
+                      pretty >=1.1.3.6 && <1.2,
+                      text >=1.2.4,
+                      regex-base >=0.94 && <0.95,
+                      regex-pcre-builtin >=0.95 && < 0.96
   hs-source-dirs:     src-hxbrief
   default-language:   Haskell2010
   ghc-options:        -rtsopts -threaded -Wall

seaaye.nix

@@ -4,23 +4,24 @@
   {
     hackage-8-10 = {
       resolver = "hackage";
-      index-state = "2021-07-01T00:00:00Z";
+      index-state = "2022-07-01T00:00:00Z";
       ghc-ver = "ghc8107";
     };
-    hackage-9-01 = {
+    hackage-9-00 = {
       resolver = "hackage";
-      index-state = "2021-07-01T00:00:00Z";
-      ghc-ver = "ghc901";
+      index-state = "2022-07-01T00:00:00Z";
+      ghc-ver = "ghc902";
       enabled = false;
     };
     hackage-9-02 = {
       resolver = "hackage";
-      index-state = "2021-11-01T00:00:00Z";
-      ghc-ver = "ghc921";
+      index-state = "2022-07-01T00:00:00Z";
+      ghc-ver = "ghc925";
       enabled = false;
     };
   };
   module-flags = [
+    # { enableLibraryProfiling = true; }
     # N.B.: There are haskell-nix module options. See the haskell-nix docs
     #       for details. Also, be careful about typos: In many cases you
     #       will not get errors but the typo'd flag will just not have any

src-hxbrief/Util.hs

@@ -3,6 +3,9 @@
 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
 import           System.Exit                    ( ExitCode
                                                   ( ExitFailure
@@ -11,27 +14,60 @@ import           System.Exit                    ( ExitCode
                                                 )
 
 
+t :: String -> Text
+t = Text.pack
 
-fGrey :: String
-fGrey = Ansi.setSGRCode [Ansi.SetColor Ansi.Foreground Ansi.Dull Ansi.White]
-fWhite :: String
-fWhite = Ansi.setSGRCode [Ansi.SetColor Ansi.Foreground Ansi.Vivid Ansi.White]
-fWhiteDis :: String
-fWhiteDis = ""
-fRedDis :: String
-fRedDis = "" -- TODO disabled until the bug is fixed.
+fGrey :: Text
+fGrey =
+  t $ Ansi.setSGRCode [Ansi.SetColor Ansi.Foreground Ansi.Dull Ansi.White]
+fWhite :: Text
+fWhite =
+  t $ Ansi.setSGRCode [Ansi.SetColor Ansi.Foreground Ansi.Vivid Ansi.White]
+fWhiteDis :: Text
+fWhiteDis = t ""
+fRedDis :: Text
+fRedDis = t "" -- TODO disabled until the bug is fixed.
  -- setFGColorDull Ansi.Red
 
-fReset :: String
-fReset = Ansi.setSGRCode [Ansi.Reset]
+fReset :: Text
+fReset = t $ Ansi.setSGRCode [Ansi.Reset]
 
-setFGColorVivid :: Ansi.Color -> String
+setFGColorVivid :: Ansi.Color -> Text
 setFGColorVivid c =
-  Ansi.setSGRCode [Ansi.SetColor Ansi.Foreground Ansi.Vivid c]
-setFGColorDull :: Ansi.Color -> String
-setFGColorDull c = Ansi.setSGRCode [Ansi.SetColor Ansi.Foreground Ansi.Dull c]
+  t $ Ansi.setSGRCode [Ansi.SetColor Ansi.Foreground Ansi.Vivid c]
+setFGColorDull :: Ansi.Color -> Text
+setFGColorDull c =
+  t $ Ansi.setSGRCode [Ansi.SetColor Ansi.Foreground Ansi.Dull c]
 
-showEC :: ExitCode -> String
+showEC :: ExitCode -> Text
 showEC = \case
-  ExitSuccess   -> setFGColorVivid Ansi.Green ++ "0" ++ fReset
-  ExitFailure i -> setFGColorVivid Ansi.Red ++ show i ++ fReset
+  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