{-# LANGUAGE CPP #-}

-- | Working with escape sequences
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 (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 -> ([Char] -> Bool) -> Maybe [Char] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"dumb") (Maybe [Char] -> Bool) -> IO (Maybe [Char]) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"TERM"
    if Bool
hdl Bool -> Bool -> Bool
&& Bool
env then Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True else
#ifdef mingw32_HOST_OS
        checkEscCodesWindows
#else
        Bool -> IO Bool
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 -- (-11) for some reason
c_ENABLE_VIRTUAL_TERMINAL_PROCESSING = 0x0004 :: Word32


-- | Try and get the handle attributes, if they are all satisifed, return True.
--   If they aren't, try and set it to emulated mode.
checkEscCodesWindows :: IO Bool
checkEscCodesWindows = do
    h <- c_GetStdHandle c_STD_OUTPUT_HANDLE
    -- might return INVALID_HANDLE_VALUE, but then the next step will happily fail
    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 :: [Char] -> [Char]
removeEscCodes (Char
'\ESC':Char
'[':[Char]
xs) = [Char] -> [Char]
removeEscCodes ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
drop1 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
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) [Char]
xs
removeEscCodes (Char
x:[Char]
xs) = Char
x Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
removeEscCodes [Char]
xs
removeEscCodes [] = []


escWindowTitle :: String -> String
escWindowTitle :: [Char] -> [Char]
escWindowTitle [Char]
x = [Char]
"\ESC]0;" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\BEL"

escCursorUp :: Int -> String
escCursorUp :: Int -> [Char]
escCursorUp Int
i = [Char]
"\ESC[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"A"

escClearLine :: String
escClearLine :: [Char]
escClearLine = [Char]
"\ESC[K"


data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White
    deriving (Int -> Color -> [Char] -> [Char]
[Color] -> [Char] -> [Char]
Color -> [Char]
(Int -> Color -> [Char] -> [Char])
-> (Color -> [Char]) -> ([Color] -> [Char] -> [Char]) -> Show Color
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Color] -> [Char] -> [Char]
$cshowList :: [Color] -> [Char] -> [Char]
show :: Color -> [Char]
$cshow :: Color -> [Char]
showsPrec :: Int -> Color -> [Char] -> [Char]
$cshowsPrec :: Int -> Color -> [Char] -> [Char]
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
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 -> [Char]
escForeground Color
x = [Char]
"\ESC[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Color -> Int
forall a. Enum a => a -> Int
fromEnum Color
x) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"m"

escNormal :: String
escNormal :: [Char]
escNormal = [Char]
"\ESC[0m"