{-# LANGUAGE CPP #-}
module General.EscCodes(
Color(..),
checkEscCodes,
removeEscCodes,
escWindowTitle,
escCursorUp,
escClearLine,
escForeground,
escNormal
) where
import Data.Char
import Data.List.Extra
import System.IO
import System.Environment
import System.IO.Unsafe
#ifdef mingw32_HOST_OS
import Data.Word
import Data.Bits
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
#endif
checkEscCodes :: IO Bool
checkEscCodes :: IO Bool
checkEscCodes = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
checkEscCodesOnce
{-# NOINLINE checkEscCodesOnce #-}
checkEscCodesOnce :: Bool
checkEscCodesOnce :: Bool
checkEscCodesOnce = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
Bool
hdl <- Handle -> IO Bool
hIsTerminalDevice Handle
stdout
Bool
env <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Eq a => a -> a -> Bool
/= String
"dumb") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"TERM"
if Bool
hdl Bool -> Bool -> Bool
&& Bool
env then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True else
#ifdef mingw32_HOST_OS
checkEscCodesWindows
#else
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
#endif
#ifdef mingw32_HOST_OS
#ifdef x86_64_HOST_ARCH
#define CALLCONV ccall
#else
#define CALLCONV stdcall
#endif
foreign import CALLCONV unsafe "Windows.h GetStdHandle" c_GetStdHandle :: Word32 -> IO (Ptr ())
foreign import CALLCONV unsafe "Windows.h GetConsoleMode" c_GetConsoleModule :: Ptr () -> Ptr Word32 -> IO Bool
foreign import CALLCONV unsafe "Windows.h SetConsoleMode" c_SetConsoleMode :: Ptr () -> Word32 -> IO Bool
c_STD_OUTPUT_HANDLE = 4294967285 :: Word32
c_ENABLE_VIRTUAL_TERMINAL_PROCESSING = 0x0004 :: Word32
checkEscCodesWindows :: IO Bool
checkEscCodesWindows = do
h <- c_GetStdHandle c_STD_OUTPUT_HANDLE
mode <- alloca $ \v -> do
b <- c_GetConsoleModule h v
if b then Just <$> peek v else pure Nothing
case mode of
Nothing -> pure False
Just mode -> do
let modeNew = mode .|. c_ENABLE_VIRTUAL_TERMINAL_PROCESSING
if mode == modeNew then pure True else do
c_SetConsoleMode h modeNew
#endif
removeEscCodes :: String -> String
removeEscCodes :: String -> String
removeEscCodes (Char
'\ESC':Char
'[':String
xs) = String -> String
removeEscCodes forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
drop1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlpha) String
xs
removeEscCodes (Char
x:String
xs) = Char
x forall a. a -> [a] -> [a]
: String -> String
removeEscCodes String
xs
removeEscCodes [] = []
escWindowTitle :: String -> String
escWindowTitle :: String -> String
escWindowTitle String
x = String
"\ESC]0;" forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
"\BEL"
escCursorUp :: Int -> String
escCursorUp :: Int -> String
escCursorUp Int
i = String
"\ESC[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
"A"
escClearLine :: String
escClearLine :: String
escClearLine = String
"\ESC[K"
data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White
deriving (Int -> Color -> String -> String
[Color] -> String -> String
Color -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Color] -> String -> String
$cshowList :: [Color] -> String -> String
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> String -> String
$cshowsPrec :: Int -> Color -> String -> String
Show,Int -> Color
Color -> Int
Color -> [Color]
Color -> Color
Color -> Color -> [Color]
Color -> Color -> Color -> [Color]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Color -> Color -> Color -> [Color]
$cenumFromThenTo :: Color -> Color -> Color -> [Color]
enumFromTo :: Color -> Color -> [Color]
$cenumFromTo :: Color -> Color -> [Color]
enumFromThen :: Color -> Color -> [Color]
$cenumFromThen :: Color -> Color -> [Color]
enumFrom :: Color -> [Color]
$cenumFrom :: Color -> [Color]
fromEnum :: Color -> Int
$cfromEnum :: Color -> Int
toEnum :: Int -> Color
$ctoEnum :: Int -> Color
pred :: Color -> Color
$cpred :: Color -> Color
succ :: Color -> Color
$csucc :: Color -> Color
Enum)
escForeground :: Color -> String
escForeground :: Color -> String
escForeground Color
x = String
"\ESC[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
30 forall a. Num a => a -> a -> a
+ forall a. Enum a => a -> Int
fromEnum Color
x) forall a. [a] -> [a] -> [a]
++ String
"m"
escNormal :: String
escNormal :: String
escNormal = String
"\ESC[0m"