7x31
/
shellcheck
mirror of https://github.com/koalaman/shellcheck.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Some hlint fixes. 

Ironically, this is the first time the linter has been linted.
This commit is contained in:
Vidar Holen 2014-02-16 12:57:34 -08:00
parent 5d8d57cf07
commit b087b7efb1
3 changed files with 77 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
ShellCheck/AST.hs
View File

@ -128,12 +128,12 @@ data ConditionType = DoubleBracket | SingleBracket deriving (Show, Eq)
-- I apologize for nothing! -- I apologize for nothing!
lolHax s = Re.subRegex (Re.mkRegex "(Id [0-9]+)") (show s) "(Id 0)" lolHax s = Re.subRegex (Re.mkRegex "(Id [0-9]+)") (show s) "(Id 0)"
instance Eq Token where instance Eq Token where
(==) a b = (lolHax a) == (lolHax b) (==) a b = lolHax a == lolHax b
analyze :: Monad m => (Token -> m ()) -> (Token -> m ()) -> (Token -> Token) -> Token -> m Token analyze :: Monad m => (Token -> m ()) -> (Token -> m ()) -> (Token -> Token) -> Token -> m Token
analyze f g i t = analyze f g i =
round t round
where where
round t = do round t = do
f t f t
@ -340,14 +340,14 @@ getId t = case t of
blank :: Monad m => Token -> m () blank :: Monad m => Token -> m ()
blank = const $ return () blank = const $ return ()
doAnalysis f t = analyze f blank id t doAnalysis f = analyze f blank id
doStackAnalysis startToken endToken t = analyze startToken endToken id t doStackAnalysis startToken endToken = analyze startToken endToken id
doTransform i t = runIdentity $ analyze blank blank i t doTransform i = runIdentity . analyze blank blank i
isLoop t = case t of isLoop t = case t of
T_WhileExpression _ _ _ -> True T_WhileExpression {} -> True
T_UntilExpression _ _ _ -> True T_UntilExpression {} -> True
T_ForIn _ _ _ _ -> True T_ForIn {} -> True
T_ForArithmetic _ _ _ _ _ -> True T_ForArithmetic {} -> True
T_SelectIn _ _ _ _ -> True T_SelectIn {} -> True
_ -> False _ -> False

96
ShellCheck/Analytics.hs
View File

@ -17,20 +17,19 @@
-} -}
module ShellCheck.Analytics (AnalysisOption(..), filterByAnnotation, runAnalytics, shellForExecutable) where module ShellCheck.Analytics (AnalysisOption(..), filterByAnnotation, runAnalytics, shellForExecutable) where
import ShellCheck.AST
import ShellCheck.Data
import ShellCheck.Parser
import Control.Monad import Control.Monad
import Control.Monad.State import Control.Monad.State
import Control.Monad.Writer import Control.Monad.Writer
import qualified Data.Map as Map
import Data.Char import Data.Char
import Data.Functor import Data.Functor
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Debug.Trace import Debug.Trace
import ShellCheck.AST
import ShellCheck.Data
import ShellCheck.Parser
import Text.Regex import Text.Regex
import Data.Maybe import qualified Data.Map as Map
data Shell = Ksh | Zsh | Sh | Bash data Shell = Ksh | Zsh | Sh | Bash
deriving (Show, Eq) deriving (Show, Eq)
@ -48,7 +47,7 @@ treeChecks :: [Parameters -> Token -> [Note]]
treeChecks = [ treeChecks = [
runNodeAnalysis runNodeAnalysis
(\p t -> mapM_ (\f -> f t) $ (\p t -> mapM_ (\f -> f t) $
map (\f -> f p) (nodeChecks ++ (checksFor (shellType p)))) map (\f -> f p) (nodeChecks ++ checksFor (shellType p)))
,subshellAssignmentCheck ,subshellAssignmentCheck
,checkSpacefulness ,checkSpacefulness
,checkQuotesInLiterals ,checkQuotesInLiterals
@ -88,10 +87,10 @@ runList options root list = notes
getShellOption = getShellOption =
fromMaybe (determineShell root) . msum $ fromMaybe (determineShell root) . msum $
map ((\option -> map (\option ->
case option of case option of
ForceShell x -> return x ForceShell x -> return x
)) options ) options
checkList l t = concatMap (\f -> f t) l checkList l t = concatMap (\f -> f t) l
@ -99,7 +98,7 @@ prop_determineShell0 = determineShell (T_Script (Id 0) "#!/bin/sh" []) == Sh
prop_determineShell1 = determineShell (T_Script (Id 0) "#!/usr/bin/env ksh" []) == Ksh prop_determineShell1 = determineShell (T_Script (Id 0) "#!/usr/bin/env ksh" []) == Ksh
prop_determineShell2 = determineShell (T_Script (Id 0) "" []) == Bash prop_determineShell2 = determineShell (T_Script (Id 0) "" []) == Bash
determineShell (T_Script _ shebang _) = fromMaybe Bash . shellForExecutable $ shellFor shebang determineShell (T_Script _ shebang _) = fromMaybe Bash . shellForExecutable $ shellFor shebang
where shellFor s | "/env " `isInfixOf` s = head ((drop 1 $ words s)++[""]) where shellFor s | "/env " `isInfixOf` s = head (drop 1 (words s)++[""])
shellFor s = reverse . takeWhile (/= '/') . reverse $ s shellFor s = reverse . takeWhile (/= '/') . reverse $ s
shellForExecutable "sh" = return Sh shellForExecutable "sh" = return Sh
@ -186,8 +185,8 @@ nodeChecks = [
] ]
filterByAnnotation token notes = filterByAnnotation token =
filter (not . shouldIgnore) notes filter (not . shouldIgnore)
where where
numFor (Note _ _ code _) = code numFor (Note _ _ code _) = code
idFor (Note id _ _ _) = id idFor (Note id _ _ _) = id
@ -208,8 +207,8 @@ err = makeNote ErrorC
info = makeNote InfoC info = makeNote InfoC
style = makeNote StyleC style = makeNote StyleC
isVariableStartChar x = x == '_' || x >= 'a' && x <= 'z' || x >= 'A' && x <= 'Z' isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x
isVariableChar x = isVariableStartChar x || x >= '0' && x <= '9' isVariableChar x = isVariableStartChar x || isDigit x
prop_isVariableName1 = isVariableName "_fo123" prop_isVariableName1 = isVariableName "_fo123"
prop_isVariableName2 = not $ isVariableName "4" prop_isVariableName2 = not $ isVariableName "4"
@ -219,17 +218,17 @@ isVariableName _ = False
willSplit x = willSplit x =
case x of case x of
T_DollarBraced _ _ -> True T_DollarBraced {} -> True
T_DollarExpansion _ _ -> True T_DollarExpansion {} -> True
T_Backticked _ _ -> True T_Backticked {} -> True
T_BraceExpansion _ s -> True T_BraceExpansion {} -> True
T_Glob _ _ -> True T_Glob {} -> True
T_Extglob _ _ _ -> True T_Extglob {} -> True
T_NormalWord _ l -> any willSplit l T_NormalWord _ l -> any willSplit l
_ -> False _ -> False
isGlob (T_Extglob _ _ _) = True isGlob (T_Extglob {}) = True
isGlob (T_Glob _ _) = True isGlob (T_Glob {}) = True
isGlob (T_NormalWord _ l) = any isGlob l isGlob (T_NormalWord _ l) = any isGlob l
isGlob _ = False isGlob _ = False
@ -270,8 +269,8 @@ makeSimple (T_Annotation _ _ f) = f
makeSimple t = t makeSimple t = t
simplify = doTransform makeSimple simplify = doTransform makeSimple
deadSimple (T_NormalWord _ l) = [concat (concatMap (deadSimple) l)] deadSimple (T_NormalWord _ l) = [concat (concatMap deadSimple l)]
deadSimple (T_DoubleQuoted _ l) = [(concat (concatMap (deadSimple) l))] deadSimple (T_DoubleQuoted _ l) = [(concat (concatMap deadSimple l))]
deadSimple (T_SingleQuoted _ s) = [s] deadSimple (T_SingleQuoted _ s) = [s]
deadSimple (T_DollarBraced _ _) = ["${VAR}"] deadSimple (T_DollarBraced _ _) = ["${VAR}"]
deadSimple (T_DollarArithmetic _ _) = ["${VAR}"] deadSimple (T_DollarArithmetic _ _) = ["${VAR}"]
@ -280,7 +279,7 @@ deadSimple (T_Backticked _ _) = ["${VAR}"]
deadSimple (T_Glob _ s) = [s] deadSimple (T_Glob _ s) = [s]
deadSimple (T_Pipeline _ [x]) = deadSimple x deadSimple (T_Pipeline _ [x]) = deadSimple x
deadSimple (T_Literal _ x) = [x] deadSimple (T_Literal _ x) = [x]
deadSimple (T_SimpleCommand _ vars words) = concatMap (deadSimple) words deadSimple (T_SimpleCommand _ vars words) = concatMap deadSimple words
deadSimple (T_Redirecting _ _ foo) = deadSimple foo deadSimple (T_Redirecting _ _ foo) = deadSimple foo
deadSimple (T_DollarSingleQuoted _ s) = [s] deadSimple (T_DollarSingleQuoted _ s) = [s]
deadSimple (T_Annotation _ _ s) = deadSimple s deadSimple (T_Annotation _ _ s) = deadSimple s
@ -296,7 +295,7 @@ verifyNot f s = checkNode f s == Just False
verifyTree f s = checkTree f s == Just True verifyTree f s = checkTree f s == Just True
verifyNotTree f s = checkTree f s == Just False verifyNotTree f s = checkTree f s == Just False
checkNode f s = checkTree (runNodeAnalysis f) s checkNode f = checkTree (runNodeAnalysis f)
checkTree f s = case parseShell "-" s of checkTree f s = case parseShell "-" s of
(ParseResult (Just (t, m)) _) -> Just . not . null $ runList [] t [f] (ParseResult (Just (t, m)) _) -> Just . not . null $ runList [] t [f]
_ -> Nothing _ -> Nothing
@ -312,7 +311,7 @@ checkEchoWc _ (T_Pipeline id [a, b]) =
where where
acmd = deadSimple a acmd = deadSimple a
bcmd = deadSimple b bcmd = deadSimple b
countMsg = style id 2000 $ "See if you can use ${#variable} instead." countMsg = style id 2000 "See if you can use ${#variable} instead."
checkEchoWc _ _ = return () checkEchoWc _ _ = return ()
prop_checkEchoSed1 = verify checkEchoSed "FOO=$(echo \"$cow\" | sed 's/foo/bar/g')" prop_checkEchoSed1 = verify checkEchoSed "FOO=$(echo \"$cow\" | sed 's/foo/bar/g')"
@ -329,7 +328,8 @@ checkEchoSed _ (T_Pipeline id [a, b]) =
bcmd = deadSimple b bcmd = deadSimple b
checkIn s = checkIn s =
case matchRegex sedRe s of case matchRegex sedRe s of
Just _ -> style id 2001 $ "See if you can use ${variable//search/replace} instead." Just _ -> style id 2001
"See if you can use ${variable//search/replace} instead."
_ -> return () _ -> return ()
checkEchoSed _ _ = return () checkEchoSed _ _ = return ()
@ -345,10 +345,10 @@ prop_checkAssignAteCommand2 = verify checkAssignAteCommand "A=ls --sort=$foo"
prop_checkAssignAteCommand3 = verify checkAssignAteCommand "A=cat foo | grep bar" prop_checkAssignAteCommand3 = verify checkAssignAteCommand "A=cat foo | grep bar"
prop_checkAssignAteCommand4 = verifyNot checkAssignAteCommand "A=foo ls -l" prop_checkAssignAteCommand4 = verifyNot checkAssignAteCommand "A=foo ls -l"
prop_checkAssignAteCommand5 = verifyNot checkAssignAteCommand "PAGER=cat grep bar" prop_checkAssignAteCommand5 = verifyNot checkAssignAteCommand "PAGER=cat grep bar"
checkAssignAteCommand _ (T_SimpleCommand id ((T_Assignment _ _ _ _ assignmentTerm):[]) (firstWord:_)) = checkAssignAteCommand _ (T_SimpleCommand id (T_Assignment _ _ _ _ assignmentTerm:[]) (firstWord:_)) =
when ("-" `isPrefixOf` (concat $ deadSimple firstWord) || when ("-" `isPrefixOf` concat (deadSimple firstWord) ||
(isCommonCommand (getLiteralString assignmentTerm) isCommonCommand (getLiteralString assignmentTerm)
&& not (isCommonCommand (getLiteralString firstWord)))) $ && not (isCommonCommand (getLiteralString firstWord))) $
warn id 2037 "To assign the output of a command, use var=$(cmd) ." warn id 2037 "To assign the output of a command, use var=$(cmd) ."
where where
isCommonCommand (Just s) = s `elem` commonCommands isCommonCommand (Just s) = s `elem` commonCommands
@ -358,7 +358,7 @@ checkAssignAteCommand _ _ = return ()
prop_checkArithmeticOpCommand1 = verify checkArithmeticOpCommand "i=i + 1" prop_checkArithmeticOpCommand1 = verify checkArithmeticOpCommand "i=i + 1"
prop_checkArithmeticOpCommand2 = verify checkArithmeticOpCommand "foo=bar * 2" prop_checkArithmeticOpCommand2 = verify checkArithmeticOpCommand "foo=bar * 2"
prop_checkArithmeticOpCommand3 = verifyNot checkArithmeticOpCommand "foo + opts" prop_checkArithmeticOpCommand3 = verifyNot checkArithmeticOpCommand "foo + opts"
checkArithmeticOpCommand _ (T_SimpleCommand id ((T_Assignment _ _ _ _ _):[]) (firstWord:_)) = checkArithmeticOpCommand _ (T_SimpleCommand id [T_Assignment {}] (firstWord:_)) =
fromMaybe (return ()) $ check <$> getGlobOrLiteralString firstWord fromMaybe (return ()) $ check <$> getGlobOrLiteralString firstWord
where where
check op = check op =
@ -376,9 +376,8 @@ checkWrongArithmeticAssignment params (T_SimpleCommand id ((T_Assignment _ _ _ _
var <- match !!! 0 var <- match !!! 0
op <- match !!! 1 op <- match !!! 1
Map.lookup var references Map.lookup var references
return $ do return . warn (getId val) 2100 $
warn (getId val) 2100 $ "Use $((..)) for arithmetics, e.g. i=$((i " ++ op ++ " 2))"
"Use $((..)) for arithmetics, e.g. i=$((i " ++ op ++ " 2))"
where where
regex = mkRegex "^([_a-zA-Z][_a-zA-Z0-9]*)([+*-]).+$" regex = mkRegex "^([_a-zA-Z][_a-zA-Z0-9]*)([+*-]).+$"
references = foldl (flip ($)) Map.empty (map insertRef $ variableFlow params) references = foldl (flip ($)) Map.empty (map insertRef $ variableFlow params)
@ -426,7 +425,7 @@ prop_checkPipePitfalls6 = verify checkPipePitfalls "find . | xargs foo"
checkPipePitfalls _ (T_Pipeline id commands) = do checkPipePitfalls _ (T_Pipeline id commands) = do
for ["find", "xargs"] $ for ["find", "xargs"] $
\(find:xargs:_) -> let args = deadSimple xargs in \(find:xargs:_) -> let args = deadSimple xargs in
when (not $ hasShortParameter args '0') $ unless (hasShortParameter args '0') $
warn (getId find) 2038 "Use either 'find .. -print0 | xargs -0 ..' or 'find .. -exec .. +' to allow for non-alphanumeric filenames." warn (getId find) 2038 "Use either 'find .. -print0 | xargs -0 ..' or 'find .. -exec .. +' to allow for non-alphanumeric filenames."
for ["?", "echo"] $ for ["?", "echo"] $
@ -441,10 +440,10 @@ checkPipePitfalls _ (T_Pipeline id commands) = do
for' ["ls", "xargs"] $ for' ["ls", "xargs"] $
\x -> warn x 2011 "Use 'find .. -print0 | xargs -0 ..' or 'find .. -exec .. +' to allow non-alphanumeric filenames." \x -> warn x 2011 "Use 'find .. -print0 | xargs -0 ..' or 'find .. -exec .. +' to allow non-alphanumeric filenames."
] ]
when (not didLs) $ do unless didLs $ do
for ["ls", "?"] $ for ["ls", "?"] $
\(ls:_) -> (when (not $ hasShortParameter (deadSimple ls) 'N') $ \(ls:_) -> unless (hasShortParameter (deadSimple ls) 'N') $
info (getId ls) 2012 "Use find instead of ls to better handle non-alphanumeric filenames.") info (getId ls) 2012 "Use find instead of ls to better handle non-alphanumeric filenames."
return () return ()
where where
for l f = for l f =
@ -535,7 +534,7 @@ checkBashisms _ = bashism
bashism t@(T_SimpleCommand _ _ (cmd:arg:_)) bashism t@(T_SimpleCommand _ _ (cmd:arg:_))
| t `isCommand` "echo" && "-" `isPrefixOf` argString = | t `isCommand` "echo" && "-" `isPrefixOf` argString =
when (not $ "--" `isPrefixOf` argString) $ -- echo "-------" unless ("--" `isPrefixOf` argString) $ -- echo "-------"
warnMsg (getId arg) "echo flag" warnMsg (getId arg) "echo flag"
where argString = (concat $ deadSimple arg) where argString = (concat $ deadSimple arg)
bashism t@(T_SimpleCommand _ _ (cmd:arg:_)) bashism t@(T_SimpleCommand _ _ (cmd:arg:_))
@ -568,13 +567,13 @@ prop_checkForInQuoted4a = verifyNot checkForInQuoted "for f in foo{1,2,3}; do tr
prop_checkForInQuoted5 = verify checkForInQuoted "for f in ls; do true; done" prop_checkForInQuoted5 = verify checkForInQuoted "for f in ls; do true; done"
checkForInQuoted _ (T_ForIn _ f [T_NormalWord _ [word@(T_DoubleQuoted id list)]] _) = checkForInQuoted _ (T_ForIn _ f [T_NormalWord _ [word@(T_DoubleQuoted id list)]] _) =
when (any (\x -> willSplit x && not (isMagicInQuotes x)) list when (any (\x -> willSplit x && not (isMagicInQuotes x)) list
|| (getLiteralString word >>= (return . wouldHaveBeenGlob)) == Just True) $ || (liftM wouldHaveBeenGlob (getLiteralString word) == Just True)) $
err id 2066 $ "Since you double quoted this, it will not word split, and the loop will only run once." err id 2066 $ "Since you double quoted this, it will not word split, and the loop will only run once."
checkForInQuoted _ (T_ForIn _ f [T_NormalWord _ [T_SingleQuoted id s]] _) = checkForInQuoted _ (T_ForIn _ f [T_NormalWord _ [T_SingleQuoted id s]] _) =
warn id 2041 $ "This is a literal string. To run as a command, use $(" ++ s ++ ")." warn id 2041 $ "This is a literal string. To run as a command, use $(" ++ s ++ ")."
checkForInQuoted _ (T_ForIn _ f [T_NormalWord _ [T_Literal id s]] _) = checkForInQuoted _ (T_ForIn _ f [T_NormalWord _ [T_Literal id s]] _) =
if ',' `elem` s if ',' `elem` s
then when (not $ '{' `elem` s) $ then unless ('{' `elem` s) $
warn id 2042 $ "Use spaces, not commas, to separate loop elements." warn id 2042 $ "Use spaces, not commas, to separate loop elements."
else warn id 2043 $ "This loop will only run once, with " ++ f ++ "='" ++ s ++ "'." else warn id 2043 $ "This loop will only run once, with " ++ f ++ "='" ++ s ++ "'."
checkForInQuoted _ _ = return () checkForInQuoted _ _ = return ()
@ -646,9 +645,8 @@ checkFindExec _ cmd@(T_SimpleCommand _ _ t@(h:r)) | cmd `isCommand` "find" = do
_ -> False _ -> False
warnFor x = warnFor x =
if shouldWarn x when(shouldWarn x) $
then info (getId x) 2014 "This will expand once before find runs, not per file found." info (getId x) 2014 "This will expand once before find runs, not per file found."
else return ()
fromWord (T_NormalWord _ l) = l fromWord (T_NormalWord _ l) = l
fromWord _ = [] fromWord _ = []
@ -1850,7 +1848,7 @@ prop_checkQuotesInLiterals7 = verifyTree checkQuotesInLiterals "param='my\\ file
checkQuotesInLiterals params t = checkQuotesInLiterals params t =
doVariableFlowAnalysis readF writeF Map.empty (variableFlow params) doVariableFlowAnalysis readF writeF Map.empty (variableFlow params)
where where
getQuotes name = get >>= (return . Map.lookup name) getQuotes name = liftM (Map.lookup name) get
setQuotes name ref = modify $ Map.insert name ref setQuotes name ref = modify $ Map.insert name ref
deleteQuotes = modify . Map.delete deleteQuotes = modify . Map.delete
parents = parentMap params parents = parentMap params
@ -2004,7 +2002,7 @@ checkWhileReadPitfalls _ (T_WhileExpression id [command] contents)
isStdinReadCommand (T_Pipeline _ [T_Redirecting id redirs cmd]) = isStdinReadCommand (T_Pipeline _ [T_Redirecting id redirs cmd]) =
let plaintext = deadSimple cmd let plaintext = deadSimple cmd
in head (plaintext ++ [""]) == "read" in head (plaintext ++ [""]) == "read"
&& (not $ "-u" `elem` plaintext) && ("-u" `notElem` plaintext)
&& all (not . stdinRedirect) redirs && all (not . stdinRedirect) redirs
isStdinReadCommand _ = False isStdinReadCommand _ = False
@ -2038,7 +2036,7 @@ checkPrefixAssignmentReference params t@(T_DollarBraced id value) =
T_SimpleCommand _ vars (_:_) -> mapM_ checkVar vars T_SimpleCommand _ vars (_:_) -> mapM_ checkVar vars
otherwise -> check rest otherwise -> check rest
checkVar (T_Assignment aId mode aName Nothing value) | checkVar (T_Assignment aId mode aName Nothing value) |
aName == name && (not $ aId `elem` idPath) = do aName == name && (aId `notElem` idPath) = do
warn aId 2097 "This assignment is only seen by the forked process." warn aId 2097 "This assignment is only seen by the forked process."
warn id 2098 "This expansion will not see the mentioned assignment." warn id 2098 "This expansion will not see the mentioned assignment."
checkVar _ = return () checkVar _ = return ()
@ -2055,7 +2053,7 @@ checkCharRangeGlob _ (T_Glob id str) | isCharClass str =
&& contents /= ":" && contents /= ":"
then warn id 2101 "Named class needs outer [], e.g. [[:digit:]]." then warn id 2101 "Named class needs outer [], e.g. [[:digit:]]."
else else
if (not $ '[' `elem` contents) && hasDupes if ('[' `notElem` contents) && hasDupes
then info id 2102 "Ranges can only match single chars (mentioned due to duplicates)." then info id 2102 "Ranges can only match single chars (mentioned due to duplicates)."
else return () else return ()
where where

37
shellcheck.hs
View File

@ -69,7 +69,7 @@ parseArguments argv =
return $ Just (opts, files) return $ Just (opts, files)
(_, _, errors) -> do (_, _, errors) -> do
printErr $ (concat errors) ++ "\n" ++ usageInfo header options printErr $ concat errors ++ "\n" ++ usageInfo header options
exitWith syntaxFailure exitWith syntaxFailure
formats = Map.fromList [ formats = Map.fromList [
@ -84,7 +84,7 @@ forTty options files = do
return $ and output return $ and output
where where
clear = ansi 0 clear = ansi 0
ansi n = "\x1B[" ++ (show n) ++ "m" ansi n = "\x1B[" ++ show n ++ "m"
colorForLevel "error" = 31 -- red colorForLevel "error" = 31 -- red
colorForLevel "warning" = 33 -- yellow colorForLevel "warning" = 33 -- yellow
@ -94,7 +94,8 @@ forTty options files = do
colorForLevel "source" = 0 -- none colorForLevel "source" = 0 -- none
colorForLevel _ = 0 -- none colorForLevel _ = 0 -- none
colorComment level comment = (ansi $ colorForLevel level) ++ comment ++ clear colorComment level comment =
ansi (colorForLevel level) ++ comment ++ clear
doFile path = do doFile path = do
contents <- readContents path contents <- readContents path
@ -112,15 +113,17 @@ forTty options files = do
then "" then ""
else fileLines !! (lineNum - 1) else fileLines !! (lineNum - 1)
putStrLn "" putStrLn ""
putStrLn $ colorFunc "message" ("In " ++ filename ++" line " ++ (show $ lineNum) ++ ":") putStrLn $ colorFunc "message"
("In " ++ filename ++" line " ++ show lineNum ++ ":")
putStrLn (colorFunc "source" line) putStrLn (colorFunc "source" line)
mapM (\c -> putStrLn (colorFunc (scSeverity c) $ cuteIndent c)) x mapM_ (\c -> putStrLn (colorFunc (scSeverity c) $ cuteIndent c)) x
putStrLn "" putStrLn ""
) groups ) groups
return $ null comments return $ null comments
cuteIndent comment = cuteIndent comment =
(replicate ((scColumn comment) - 1) ' ') ++ "^-- " ++ (code $ scCode comment) ++ ": " ++ (scMessage comment) replicate (scColumn comment - 1) ' ' ++
"^-- " ++ code (scCode comment) ++ ": " ++ scMessage comment
code code = "SC" ++ (show code) code code = "SC" ++ (show code)
@ -131,7 +134,7 @@ forTty options files = do
-- This totally ignores the filenames. Fixme? -- This totally ignores the filenames. Fixme?
forJson options files = do forJson options files = do
comments <- liftM concat $ mapM (commentsFor options) files comments <- liftM concat $ mapM (commentsFor options) files
putStrLn $ encodeStrict $ comments putStrLn $ encodeStrict comments
return . null $ comments return . null $ comments
-- Mimic GCC "file:line:col: (error|warning|note): message" format -- Mimic GCC "file:line:col: (error|warning|note): message" format
@ -178,8 +181,8 @@ forCheckstyle options files = do
severity "warning" = "warning" severity "warning" = "warning"
severity _ = "info" severity _ = "info"
attr s v = concat [ s, "='", escape v, "' " ] attr s v = concat [ s, "='", escape v, "' " ]
escape msg = concatMap escape' msg escape = concatMap escape'
escape' c = if isOk c then [c] else "&#" ++ (show $ ord c) ++ ";" escape' c = if isOk c then [c] else "&#" ++ show (ord c) ++ ";"
isOk x = any ($x) [isAsciiUpper, isAsciiLower, isDigit, (`elem` " ./")] isOk x = any ($x) [isAsciiUpper, isAsciiLower, isDigit, (`elem` " ./")]
formatFile name comments = concat [ formatFile name comments = concat [
@ -226,7 +229,7 @@ makeNonVirtual comments contents =
real (_:rest) r v target = real rest (r+1) (v+1) target real (_:rest) r v target = real rest (r+1) (v+1) target
getOption [] _ = Nothing getOption [] _ = Nothing
getOption ((Flag var val):_) name | name == var = return val getOption (Flag var val:_) name | name == var = return val
getOption (_:rest) flag = getOption rest flag getOption (_:rest) flag = getOption rest flag
getOptions options name = getOptions options name =
@ -247,8 +250,8 @@ getExclusions options =
in in
map (Prelude.read . clean) elements :: [Int] map (Prelude.read . clean) elements :: [Int]
excludeCodes codes comments = excludeCodes codes =
filter (not . hasCode) comments filter (not . hasCode)
where where
hasCode c = scCode c `elem` codes hasCode c = scCode c `elem` codes
@ -265,7 +268,7 @@ main = do
exitWith code exitWith code
process Nothing = return False process Nothing = return False
process (Just (options, files)) = do process (Just (options, files)) =
let format = fromMaybe "tty" $ getOption options "format" in let format = fromMaybe "tty" $ getOption options "format" in
case Map.lookup format formats of case Map.lookup format formats of
Nothing -> do Nothing -> do
@ -281,11 +284,9 @@ verifyOptions opts files = do
when (isJust $ getOption opts "version") printVersionAndExit when (isJust $ getOption opts "version") printVersionAndExit
let shell = getOption opts "shell" in let shell = getOption opts "shell" in
if isNothing shell when (isJust shell && isNothing (shell >>= shellForExecutable)) $ do
then return () printErr $ "Unknown shell: " ++ (fromJust shell)
else when (isNothing $ shell >>= shellForExecutable) $ do exitWith supportFailure
printErr $ "Unknown shell: " ++ (fromJust shell)
exitWith supportFailure
when (null files) $ do when (null files) $ do
printErr "No files specified.\n" printErr "No files specified.\n"