{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
module System.Console.Pretty
( Color(..) , Pretty(..) , Section(..) , Style(..)
, supportsPretty)
where
import qualified Data.Char as C
import Data.Monoid ((<>))
import qualified Data.Text as T
import GHC.IO.Handle (Handle)
import System.Environment (lookupEnv)
import System.IO (hIsTerminalDevice, stdout)
data Section = Foreground | Background
data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White | Default
deriving (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)
data Style
= Normal | Bold | Faint | Italic
| Underline | SlowBlink | ColoredNormal | Reverse
deriving (Int -> Style
Style -> Int
Style -> [Style]
Style -> Style
Style -> Style -> [Style]
Style -> Style -> Style -> [Style]
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 :: Style -> Style -> Style -> [Style]
$cenumFromThenTo :: Style -> Style -> Style -> [Style]
enumFromTo :: Style -> Style -> [Style]
$cenumFromTo :: Style -> Style -> [Style]
enumFromThen :: Style -> Style -> [Style]
$cenumFromThen :: Style -> Style -> [Style]
enumFrom :: Style -> [Style]
$cenumFrom :: Style -> [Style]
fromEnum :: Style -> Int
$cfromEnum :: Style -> Int
toEnum :: Int -> Style
$ctoEnum :: Int -> Style
pred :: Style -> Style
$cpred :: Style -> Style
succ :: Style -> Style
$csucc :: Style -> Style
Enum)
class Pretty a where
color :: Color -> a -> a
color = forall a. Pretty a => Section -> Color -> a -> a
colorize Section
Foreground
bgColor :: Color -> a -> a
bgColor = forall a. Pretty a => Section -> Color -> a -> a
colorize Section
Background
colorize :: Section -> Color -> a -> a
style :: Style -> a -> a
instance Pretty T.Text where
colorize :: Section -> Color -> Text -> Text
colorize Section
section Color
col Text
str =
Text
"\x1b[" forall a. Semigroup a => a -> a -> a
<>
Text
sectionNum forall a. Semigroup a => a -> a -> a
<>
(Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ Int -> Char
C.intToDigit forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Color
col)
forall a. Semigroup a => a -> a -> a
<> Text
"m" forall a. Semigroup a => a -> a -> a
<>
Text
str forall a. Semigroup a => a -> a -> a
<>
Text
"\x1b[0m"
where
sectionNum :: T.Text
sectionNum :: Text
sectionNum = case Section
section of
Section
Foreground -> Text
"9"
Section
Background -> Text
"4"
style :: Style -> Text -> Text
style Style
sty Text
str =
Text
"\x1b[" forall a. Semigroup a => a -> a -> a
<>
(Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ Int -> Char
C.intToDigit forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Style
sty)
forall a. Semigroup a => a -> a -> a
<> Text
"m" forall a. Semigroup a => a -> a -> a
<>
Text
str forall a. Semigroup a => a -> a -> a
<>
Text
"\x1b[0m"
instance Pretty String where
colorize :: Section -> Color -> String -> String
colorize Section
section Color
col String
str =
String
"\x1b[" forall a. Semigroup a => a -> a -> a
<>
String
sectionNum forall a. Semigroup a => a -> a -> a
<>
forall a. Show a => a -> String
show (forall a. Enum a => a -> Int
fromEnum Color
col)
forall a. Semigroup a => a -> a -> a
<> String
"m" forall a. Semigroup a => a -> a -> a
<>
String
str forall a. Semigroup a => a -> a -> a
<>
String
"\x1b[0m"
where
sectionNum :: String
sectionNum :: String
sectionNum = case Section
section of
Section
Foreground -> String
"9"
Section
Background -> String
"4"
style :: Style -> String -> String
style Style
sty String
str =
String
"\x1b[" forall a. Semigroup a => a -> a -> a
<>
forall a. Show a => a -> String
show (forall a. Enum a => a -> Int
fromEnum Style
sty)
forall a. Semigroup a => a -> a -> a
<> String
"m" forall a. Semigroup a => a -> a -> a
<>
String
str forall a. Semigroup a => a -> a -> a
<>
String
"\x1b[0m"
supportsPretty :: IO Bool
supportsPretty :: IO Bool
supportsPretty =
Handle -> IO Bool
hSupportsANSI Handle
stdout
where
hSupportsANSI :: Handle -> IO Bool
hSupportsANSI :: Handle -> IO Bool
hSupportsANSI Handle
h = Bool -> Bool -> Bool
(&&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Bool
hIsTerminalDevice Handle
h forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
isDumb)
where
isDumb :: IO Bool
isDumb = (forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
"dumb") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"TERM"