Merge pull request #553 from haguenau/add-color-switch
Add --color switch
This commit is contained in:
commit
437e69fbba
|
@ -48,6 +48,7 @@ checkScript sys spec = do
|
|||
results <- checkScript (csScript spec)
|
||||
return CheckResult {
|
||||
crFilename = csFilename spec,
|
||||
crColorOption = csColorOption spec,
|
||||
crComments = results
|
||||
}
|
||||
where
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -59,7 +59,8 @@ instance Monoid Status where
|
|||
|
||||
data Options = Options {
|
||||
checkSpec :: CheckSpec,
|
||||
externalSources :: Bool
|
||||
externalSources :: Bool,
|
||||
color :: ColorOptions
|
||||
}
|
||||
|
||||
defaultOptions = Options {
|
||||
|
@ -73,6 +74,9 @@ options = [
|
|||
(ReqArg (Flag "exclude") "CODE1,CODE2..") "exclude types of warnings",
|
||||
Option "f" ["format"]
|
||||
(ReqArg (Flag "format") "FORMAT") "output format",
|
||||
Option "C" ["color"]
|
||||
(OptArg (maybe (Flag "color" "always") (Flag "color")) "WHEN")
|
||||
"Use color (auto, always, never)",
|
||||
Option "s" ["shell"]
|
||||
(ReqArg (Flag "shell") "SHELLNAME") "Specify dialect (sh,bash,dash,ksh)",
|
||||
Option "x" ["external-sources"]
|
||||
|
@ -195,6 +199,13 @@ runFormatter sys format options files = do
|
|||
then NoProblems
|
||||
else SomeProblems
|
||||
|
||||
parseColorOption colorOption =
|
||||
case colorOption of
|
||||
"auto" -> ColorAuto
|
||||
"always" -> ColorAlways
|
||||
"never" -> ColorNever
|
||||
_ -> error $ "Bad value for --color `" ++ colorOption ++ "'"
|
||||
|
||||
parseOption flag options =
|
||||
case flag of
|
||||
Flag "shell" str ->
|
||||
|
@ -224,6 +235,13 @@ parseOption flag options =
|
|||
externalSources = True
|
||||
}
|
||||
|
||||
Flag "color" color ->
|
||||
return options {
|
||||
checkSpec = (checkSpec options) {
|
||||
csColorOption = parseColorOption color
|
||||
}
|
||||
}
|
||||
|
||||
_ -> return options
|
||||
where
|
||||
die s = do
|
||||
|
|
Loading…
Reference in New Issue