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)
|
results <- checkScript (csScript spec)
|
||||||
return CheckResult {
|
return CheckResult {
|
||||||
crFilename = csFilename spec,
|
crFilename = csFilename spec,
|
||||||
|
crColorOption = csColorOption spec,
|
||||||
crComments = results
|
crComments = results
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
|
|
|
@ -35,7 +35,7 @@ format = return Formatter {
|
||||||
onResult = outputResult
|
onResult = outputResult
|
||||||
}
|
}
|
||||||
|
|
||||||
colorForLevel level =
|
colorForLevel level =
|
||||||
case level of
|
case level of
|
||||||
"error" -> 31 -- red
|
"error" -> 31 -- red
|
||||||
"warning" -> 33 -- yellow
|
"warning" -> 33 -- yellow
|
||||||
|
@ -44,13 +44,13 @@ colorForLevel level =
|
||||||
"message" -> 1 -- bold
|
"message" -> 1 -- bold
|
||||||
"source" -> 0 -- none
|
"source" -> 0 -- none
|
||||||
otherwise -> 0 -- none
|
otherwise -> 0 -- none
|
||||||
|
|
||||||
outputError file error = do
|
outputError file error = do
|
||||||
color <- getColorFunc
|
color <- getColorFunc $ ColorAuto -- FIXME: should respect --color
|
||||||
hPutStrLn stderr $ color "error" $ file ++ ": " ++ error
|
hPutStrLn stderr $ color "error ZZZ" $ file ++ ": " ++ error
|
||||||
|
|
||||||
outputResult result contents = do
|
outputResult result contents = do
|
||||||
color <- getColorFunc
|
color <- getColorFunc $ crColorOption result
|
||||||
let comments = crComments result
|
let comments = crComments result
|
||||||
let fileLines = lines contents
|
let fileLines = lines contents
|
||||||
let lineCount = fromIntegral $ length fileLines
|
let lineCount = fromIntegral $ length fileLines
|
||||||
|
@ -75,10 +75,15 @@ cuteIndent comment =
|
||||||
|
|
||||||
code code = "SC" ++ show code
|
code code = "SC" ++ show code
|
||||||
|
|
||||||
getColorFunc = do
|
getColorFunc colorOption = do
|
||||||
term <- hIsTerminalDevice stdout
|
term <- hIsTerminalDevice stdout
|
||||||
let windows = "mingw" `isPrefixOf` os
|
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
|
where
|
||||||
colorComment level comment =
|
colorComment level comment =
|
||||||
ansi (colorForLevel level) ++ comment ++ clear
|
ansi (colorForLevel level) ++ comment ++ clear
|
||||||
|
|
|
@ -34,21 +34,30 @@ data CheckSpec = CheckSpec {
|
||||||
csFilename :: String,
|
csFilename :: String,
|
||||||
csScript :: String,
|
csScript :: String,
|
||||||
csExcludedWarnings :: [Integer],
|
csExcludedWarnings :: [Integer],
|
||||||
|
csColorOption :: ColorOptions,
|
||||||
csShellTypeOverride :: Maybe Shell
|
csShellTypeOverride :: Maybe Shell
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
data CheckResult = CheckResult {
|
data CheckResult = CheckResult {
|
||||||
crFilename :: String,
|
crFilename :: String,
|
||||||
crComments :: [PositionedComment]
|
crComments :: [PositionedComment],
|
||||||
|
crColorOption :: ColorOptions
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
emptyCheckSpec = CheckSpec {
|
emptyCheckSpec = CheckSpec {
|
||||||
csFilename = "",
|
csFilename = "",
|
||||||
csScript = "",
|
csScript = "",
|
||||||
csExcludedWarnings = [],
|
csExcludedWarnings = [],
|
||||||
csShellTypeOverride = Nothing
|
csShellTypeOverride = Nothing,
|
||||||
|
csColorOption = ColorAuto
|
||||||
}
|
}
|
||||||
|
|
||||||
|
data ColorOptions =
|
||||||
|
ColorAuto
|
||||||
|
| ColorAlways
|
||||||
|
| ColorNever
|
||||||
|
deriving (Ord, Eq, Show)
|
||||||
|
|
||||||
-- Parser input and output
|
-- Parser input and output
|
||||||
data ParseSpec = ParseSpec {
|
data ParseSpec = ParseSpec {
|
||||||
psFilename :: String,
|
psFilename :: String,
|
||||||
|
|
|
@ -59,7 +59,8 @@ instance Monoid Status where
|
||||||
|
|
||||||
data Options = Options {
|
data Options = Options {
|
||||||
checkSpec :: CheckSpec,
|
checkSpec :: CheckSpec,
|
||||||
externalSources :: Bool
|
externalSources :: Bool,
|
||||||
|
color :: ColorOptions
|
||||||
}
|
}
|
||||||
|
|
||||||
defaultOptions = Options {
|
defaultOptions = Options {
|
||||||
|
@ -73,6 +74,9 @@ options = [
|
||||||
(ReqArg (Flag "exclude") "CODE1,CODE2..") "exclude types of warnings",
|
(ReqArg (Flag "exclude") "CODE1,CODE2..") "exclude types of warnings",
|
||||||
Option "f" ["format"]
|
Option "f" ["format"]
|
||||||
(ReqArg (Flag "format") "FORMAT") "output 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"]
|
Option "s" ["shell"]
|
||||||
(ReqArg (Flag "shell") "SHELLNAME") "Specify dialect (sh,bash,dash,ksh)",
|
(ReqArg (Flag "shell") "SHELLNAME") "Specify dialect (sh,bash,dash,ksh)",
|
||||||
Option "x" ["external-sources"]
|
Option "x" ["external-sources"]
|
||||||
|
@ -195,6 +199,13 @@ runFormatter sys format options files = do
|
||||||
then NoProblems
|
then NoProblems
|
||||||
else SomeProblems
|
else SomeProblems
|
||||||
|
|
||||||
|
parseColorOption colorOption =
|
||||||
|
case colorOption of
|
||||||
|
"auto" -> ColorAuto
|
||||||
|
"always" -> ColorAlways
|
||||||
|
"never" -> ColorNever
|
||||||
|
_ -> error $ "Bad value for --color `" ++ colorOption ++ "'"
|
||||||
|
|
||||||
parseOption flag options =
|
parseOption flag options =
|
||||||
case flag of
|
case flag of
|
||||||
Flag "shell" str ->
|
Flag "shell" str ->
|
||||||
|
@ -224,6 +235,13 @@ parseOption flag options =
|
||||||
externalSources = True
|
externalSources = True
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Flag "color" color ->
|
||||||
|
return options {
|
||||||
|
checkSpec = (checkSpec options) {
|
||||||
|
csColorOption = parseColorOption color
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
_ -> return options
|
_ -> return options
|
||||||
where
|
where
|
||||||
die s = do
|
die s = do
|
||||||
|
|
Loading…
Reference in New Issue