74 lines
2.5 KiB
Haskell
74 lines
2.5 KiB
Haskell
{-# OPTIONS_GHC -Wno-unused-imports #-}
|
|
|
|
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
|
|
, ExitSuccess
|
|
)
|
|
)
|
|
|
|
|
|
t :: String -> Text
|
|
t = Text.pack
|
|
|
|
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 :: Text
|
|
fReset = t $ Ansi.setSGRCode [Ansi.Reset]
|
|
|
|
setFGColorVivid :: Ansi.Color -> Text
|
|
setFGColorVivid 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 -> 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
|