{-# 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 = Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
checkEscCodesOnce
{-# NOINLINE checkEscCodesOnce #-}
checkEscCodesOnce :: Bool
checkEscCodesOnce :: Bool
checkEscCodesOnce = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
Bool
hdl <- Handle -> IO Bool
hIsTerminalDevice Handle
stdout
Bool
env <- Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"dumb") (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
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 Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True else
#ifdef mingw32_HOST_OS
checkEscCodesWindows
#else
Bool -> IO Bool
forall a. a -> IO a
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 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
drop1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlpha) String
xs
removeEscCodes (Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
removeEscCodes String
xs
removeEscCodes [] = []
escWindowTitle :: String -> String
escWindowTitle :: String -> String
escWindowTitle String
x = String
"\ESC]0;" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\BEL"
escCursorUp :: Int -> String
escCursorUp :: Int -> String
escCursorUp Int
i = String
"\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
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
(Int -> Color -> String -> String)
-> (Color -> String) -> ([Color] -> String -> String) -> Show Color
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Color -> String -> String
showsPrec :: Int -> Color -> String -> String
$cshow :: Color -> String
show :: Color -> String
$cshowList :: [Color] -> String -> String
showList :: [Color] -> String -> String
Show,Int -> Color
Color -> Int
Color -> [Color]
Color -> Color
Color -> Color -> [Color]
Color -> Color -> Color -> [Color]
(Color -> Color)
-> (Color -> Color)
-> (Int -> Color)
-> (Color -> Int)
-> (Color -> [Color])
-> (Color -> Color -> [Color])
-> (Color -> Color -> [Color])
-> (Color -> Color -> Color -> [Color])
-> Enum 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
$csucc :: Color -> Color
succ :: Color -> Color
$cpred :: Color -> Color
pred :: Color -> Color
$ctoEnum :: Int -> Color
toEnum :: Int -> Color
$cfromEnum :: Color -> Int
fromEnum :: Color -> Int
$cenumFrom :: Color -> [Color]
enumFrom :: Color -> [Color]
$cenumFromThen :: Color -> Color -> [Color]
enumFromThen :: Color -> Color -> [Color]
$cenumFromTo :: Color -> Color -> [Color]
enumFromTo :: Color -> Color -> [Color]
$cenumFromThenTo :: Color -> Color -> Color -> [Color]
enumFromThenTo :: Color -> Color -> Color -> [Color]
Enum)
escForeground :: Color -> String
escForeground :: Color -> String
escForeground Color
x = String
"\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Color -> Int
forall a. Enum a => a -> Int
fromEnum Color
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"m"
escNormal :: String
escNormal :: String
escNormal = String
"\ESC[0m"