Add initial support for --color

This commit is contained in:
David Haguenauer
2015-12-03 11:15:32 -05:00
parent bd359c5c0f
commit a3d4101d6c
4 changed files with 40 additions and 8 deletions

View File

@@ -48,6 +48,7 @@ checkScript sys spec = do
results <- checkScript (csScript spec)
return CheckResult {
crFilename = csFilename spec,
crColorOption = csColorOption spec,
crComments = results
}
where

View File

@@ -46,11 +46,11 @@ colorForLevel level =
otherwise -> 0 -- none
outputError file error = do
color <- getColorFunc
hPutStrLn stderr $ color "error" $ file ++ ": " ++ error
color <- getColorFunc $ ColorAuto -- FIXME: should respect --color
hPutStrLn stderr $ color "error ZZZ" $ file ++ ": " ++ error
outputResult result contents = do
color <- getColorFunc
color <- getColorFunc $ crColorOption result
let comments = crComments result
let fileLines = lines contents
let lineCount = fromIntegral $ length fileLines
@@ -75,10 +75,15 @@ cuteIndent comment =
code code = "SC" ++ show code
getColorFunc = do
getColorFunc colorOption = do
term <- hIsTerminalDevice stdout
let windows = "mingw" `isPrefixOf` os
return $ if term && not windows then colorComment else const id
let isUsableTty = term && not windows
let useColor = case colorOption of
ColorAlways -> True
ColorNever -> False
ColorAuto -> isUsableTty
return $ if useColor then colorComment else const id
where
colorComment level comment =
ansi (colorForLevel level) ++ comment ++ clear

View File

@@ -34,21 +34,30 @@ data CheckSpec = CheckSpec {
csFilename :: String,
csScript :: String,
csExcludedWarnings :: [Integer],
csColorOption :: ColorOptions,
csShellTypeOverride :: Maybe Shell
} deriving (Show, Eq)
data CheckResult = CheckResult {
crFilename :: String,
crComments :: [PositionedComment]
crComments :: [PositionedComment],
crColorOption :: ColorOptions
} deriving (Show, Eq)
emptyCheckSpec = CheckSpec {
csFilename = "",
csScript = "",
csExcludedWarnings = [],
csShellTypeOverride = Nothing
csShellTypeOverride = Nothing,
csColorOption = ColorAuto
}
data ColorOptions =
ColorAuto
| ColorAlways
| ColorNever
deriving (Ord, Eq, Show)
-- Parser input and output
data ParseSpec = ParseSpec {
psFilename :: String,