{-# 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]
(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)
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]
(Style -> Style)
-> (Style -> Style)
-> (Int -> Style)
-> (Style -> Int)
-> (Style -> [Style])
-> (Style -> Style -> [Style])
-> (Style -> Style -> [Style])
-> (Style -> Style -> Style -> [Style])
-> Enum 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 = Section -> Color -> a -> a
forall a. Pretty a => Section -> Color -> a -> a
colorize Section
Foreground
bgColor :: Color -> a -> a
bgColor = Section -> Color -> a -> a
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
section col :: Color
col str :: Text
str =
"\x1b[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
sectionNum Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char
C.intToDigit (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Color -> Int
forall a. Enum a => a -> Int
fromEnum Color
col)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
"\x1b[0m"
where
sectionNum :: T.Text
sectionNum :: Text
sectionNum = case Section
section of
Foreground -> "9"
Background -> "4"
style :: Style -> Text -> Text
style sty :: Style
sty str :: Text
str =
"\x1b[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char
C.intToDigit (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Style -> Int
forall a. Enum a => a -> Int
fromEnum Style
sty)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
"\x1b[0m"
instance Pretty String where
colorize :: Section -> Color -> String -> String
colorize section :: Section
section col :: Color
col str :: String
str =
"\x1b[" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
sectionNum String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
Int -> String
forall a. Show a => a -> String
show (Color -> Int
forall a. Enum a => a -> Int
fromEnum Color
col)
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "m" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
"\x1b[0m"
where
sectionNum :: String
sectionNum :: String
sectionNum = case Section
section of
Foreground -> "9"
Background -> "4"
style :: Style -> String -> String
style sty :: Style
sty str :: String
str =
"\x1b[" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
Int -> String
forall a. Show a => a -> String
show (Style -> Int
forall a. Enum a => a -> Int
fromEnum Style
sty)
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "m" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
"\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 h :: Handle
h = Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> IO Bool -> IO (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Bool
hIsTerminalDevice Handle
h IO (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
isDumb)
where
isDumb :: IO Bool
isDumb = (Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just "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 "TERM"