module System.Console.ANSI.Stylized
( ColorIntensity(..)
, Color(..)
, ConsoleIntensity(..)
, Underlining(..)
, Style, ColourOption, StyleOption
, hResetGR, resetGR
, hPutStrS, putStrS
, hPutStrLnS, putStrLnS
, hPutS, putS
, hPutLnS, putLnS
, hPutT, putT
, hPutLnT, putLnT
) where
import Control.Arrow
import System.Console.ANSI
import System.IO
type Style = (ColourOption, StyleOption)
type ColourOption = (ColorIntensity, Color)
type StyleOption = (ConsoleIntensity, Underlining)
styleToSGRs :: Style -> [SGR]
styleToSGRs ((col_int, col), (b, u)) =
[
SetColor Foreground col_int col,
SetConsoleIntensity b,
SetUnderlining u
]
hResetGR :: Handle -> IO ()
hResetGR h = hSetSGR h [Reset]
resetGR :: IO ()
resetGR = setSGR [Reset]
hPutStrS :: Handle -> Style -> String -> IO ()
hPutStrS h style s = do
hSetSGR h $ styleToSGRs style
hPutStr h s
putStrS :: Style -> String -> IO ()
putStrS = hPutStrS stdout
hPutStrLnS :: Handle -> Style -> String -> IO ()
hPutStrLnS h style s = do
hSetSGR h $ styleToSGRs style
hPutStrLn h s
putStrLnS :: Style -> String -> IO ()
putStrLnS = hPutStrLnS stdout
hPutS :: Handle -> [(Style, String)] -> IO ()
hPutS _ [] = return ()
hPutS h (x:[]) = uncurry (hPutStrS h) x
hPutS h (x:xs) = uncurry (hPutStrS h) x >> hPutS h xs
putS :: [(Style, String)] -> IO ()
putS = hPutS stdout
hPutLnS :: Handle -> [(Style, String)] -> IO ()
hPutLnS _ [] = return ()
hPutLnS h (x:[]) = uncurry (hPutStrLnS h) x
hPutLnS h (x:xs) = uncurry (hPutStrS h) x >> hPutLnS h xs
putLnS :: [(Style, String)] -> IO ()
putLnS = hPutLnS stdout
hPutT :: (t -> Style) -> Handle -> [(t, String)] -> IO ()
hPutT fn h xs = hPutS h $ map (first fn) xs
putT :: (t -> Style) -> [(t, String)] -> IO ()
putT fn = hPutT fn stdout
hPutLnT :: (t -> Style) -> Handle -> [(t, String)] -> IO ()
hPutLnT fn h xs = hPutLnS h $ map (first fn) xs
putLnT :: (t -> Style) -> [(t, String)] -> IO ()
putLnT fn = hPutLnT fn stdout