{-# 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 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 -- (-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 :: 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"