module ShellCheck.Formatter.TTY (format) where
import ShellCheck.Interface
import ShellCheck.Formatter.Format
import Data.List
import GHC.Exts
import System.Info
import System.IO
format :: FormatterOptions -> IO Formatter
format options = return Formatter {
header = return (),
footer = return (),
onFailure = outputError options,
onResult = outputResult options
}
colorForLevel level =
case level of
"error" -> 31
"warning" -> 33
"info" -> 32
"style" -> 32
"message" -> 1
"source" -> 0
_ -> 0
outputError options file error = do
color <- getColorFunc $ foColorOption options
hPutStrLn stderr $ color "error" $ file ++ ": " ++ error
outputResult options result sys = do
color <- getColorFunc $ foColorOption options
let comments = crComments result
let fileGroups = groupWith sourceFile comments
mapM_ (outputForFile color sys) fileGroups
outputForFile color sys comments = do
let fileName = sourceFile (head comments)
result <- (siReadFile sys) fileName
let contents = either (const "") id result
let fileLines = lines contents
let lineCount = fromIntegral $ length fileLines
let groups = groupWith lineNo comments
mapM_ (\x -> do
let lineNum = lineNo (head x)
let line = if lineNum < 1 || lineNum > lineCount
then ""
else fileLines !! fromIntegral (lineNum 1)
putStrLn ""
putStrLn $ color "message" $
"In " ++ fileName ++" line " ++ show lineNum ++ ":"
putStrLn (color "source" line)
mapM_ (\c -> putStrLn (color (severityText c) $ cuteIndent c)) x
putStrLn ""
) groups
cuteIndent :: PositionedComment -> String
cuteIndent comment =
replicate (fromIntegral $ colNo comment 1) ' ' ++
"^-- " ++ code (codeNo comment) ++ ": " ++ messageText comment
code code = "SC" ++ show code
getColorFunc colorOption = do
term <- hIsTerminalDevice stdout
let windows = "mingw" `isPrefixOf` os
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
clear = ansi 0
ansi n = "\x1B[" ++ show n ++ "m"