From e5e08df1d980723e4f24d3b6667706633902bb28 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 10 Nov 2013 10:55:46 -0800 Subject: [PATCH] Numbered messages --- ShellCheck/Analytics.hs | 198 ++++++++++++++++++++-------------------- ShellCheck/Parser.hs | 181 ++++++++++++++++++------------------ ShellCheck/Simple.hs | 7 +- 3 files changed, 192 insertions(+), 194 deletions(-) diff --git a/ShellCheck/Analytics.hs b/ShellCheck/Analytics.hs index 7e511a3..8a0bcbe 100644 --- a/ShellCheck/Analytics.hs +++ b/ShellCheck/Analytics.hs @@ -148,10 +148,10 @@ runBasicTreeAnalysis checks token = runTree f t = runBasicAnalysis (flip f $ parentTree) t addNoteFor id note = modify ((id, note):) -warn id note = addNoteFor id $ Note WarningC $ note -err id note = addNoteFor id $ Note ErrorC $ note -info id note = addNoteFor id $ Note InfoC $ note -style id note = addNoteFor id $ Note StyleC $ note +warn id code note = addNoteFor id $ Note WarningC code $ note +err id code note = addNoteFor id $ Note ErrorC code $ note +info id code note = addNoteFor id $ Note InfoC code $ note +style id code note = addNoteFor id $ Note StyleC code $ note isVariableStartChar x = x == '_' || x >= 'a' && x <= 'z' || x >= 'A' && x <= 'Z' isVariableChar x = isVariableStartChar x || x >= '0' && x <= '9' @@ -253,7 +253,7 @@ checkEchoWc (T_Pipeline id [a, b]) = where acmd = deadSimple a bcmd = deadSimple b - countMsg = style id $ "See if you can use ${#variable} instead." + countMsg = style id 2000 $ "See if you can use ${#variable} instead." checkEchoWc _ = return () prop_checkEchoSed1 = verify checkEchoSed "FOO=$(echo \"$cow\" | sed 's/foo/bar/g')" @@ -270,7 +270,7 @@ checkEchoSed (T_Pipeline id [a, b]) = bcmd = deadSimple b checkIn s = case matchRegex sedRe s of - Just _ -> style id $ "See if you can use ${variable//search/replace} instead." + Just _ -> style id 2001 $ "See if you can use ${variable//search/replace} instead." _ -> return () checkEchoSed _ = return () @@ -278,7 +278,7 @@ prop_checkPipedAssignment1 = verify checkPipedAssignment "A=ls | grep foo" prop_checkPipedAssignment2 = verifyNot checkPipedAssignment "A=foo cmd | grep foo" prop_checkPipedAssignment3 = verifyNot checkPipedAssignment "A=foo" checkPipedAssignment (T_Pipeline _ (T_Redirecting _ _ (T_SimpleCommand id (_:_) []):_:_)) = - warn id "If you wanted to assign the output of the pipeline, use a=$(b | c) ." + warn id 2036 "If you wanted to assign the output of the pipeline, use a=$(b | c) ." checkPipedAssignment _ = return () prop_checkAssignAteCommand1 = verify checkAssignAteCommand "A=ls -l" @@ -289,7 +289,7 @@ prop_checkAssignAteCommand5 = verifyNot checkAssignAteCommand "PAGER=cat grep ba checkAssignAteCommand (T_SimpleCommand id ((T_Assignment _ _ _ _ assignmentTerm):[]) (firstWord:_)) = when ("-" `isPrefixOf` (concat $ deadSimple firstWord) || (isCommonCommand (getLiteralString assignmentTerm) && not (isCommonCommand (getLiteralString firstWord)))) $ - warn id "To assign the output of a command, use var=$(cmd) ." + warn id 2037 "To assign the output of a command, use var=$(cmd) ." where isCommonCommand (Just s) = s `elem` commonCommands isCommonCommand _ = False @@ -303,7 +303,7 @@ prop_checkUuoc4 = verifyNot checkUuoc "cat $var" checkUuoc (T_Pipeline _ ((T_Redirecting _ _ cmd):_:_)) = checkCommand "cat" f cmd where f [word] = when (isSimple word) $ - style (getId word) "Useless cat. Consider 'cmd < file | ..' or 'cmd file | ..' instead." + style (getId word) 2002 "Useless cat. Consider 'cmd < file | ..' or 'cmd file | ..' instead." f _ = return () isSimple (T_NormalWord _ parts) = all isSimple parts isSimple (T_DollarBraced _ _) = True @@ -315,7 +315,7 @@ prop_checkNeedlessCommands2 = verify checkNeedlessCommands "foo=`echo \\`expr 3 prop_checkNeedlessCommands3 = verifyNot checkNeedlessCommands "foo=$(expr foo : regex)" checkNeedlessCommands cmd@(T_SimpleCommand id _ (w:_)) | w `isCommand` "expr" && (not $ ":" `elem` deadSimple cmd) = - style id "expr is antiquated. Consider rewriting this using $((..)), ${} or [[ ]]." + style id 2003 "expr is antiquated. Consider rewriting this using $((..)), ${} or [[ ]]." checkNeedlessCommands _ = return () prop_checkPipePitfalls3 = verify checkPipePitfalls "ls | grep -v mp3" @@ -326,24 +326,24 @@ checkPipePitfalls (T_Pipeline id commands) = do for ["find", "xargs"] $ \(find:xargs:_) -> let args = deadSimple xargs in when (not $ hasShortParameter args '0') $ - warn (getId find) "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"] $ - \(_:echo:_) -> info (getId echo) "echo doesn't read from stdin, are you sure you should be piping to it?" + \(_:echo:_) -> info (getId echo) 2008 "echo doesn't read from stdin, are you sure you should be piping to it?" for' ["ps", "grep"] $ - flip info "Consider using pgrep instead of grepping ps output." + \x -> info x 2009 "Consider using pgrep instead of grepping ps output." didLs <- liftM or . sequence $ [ for' ["ls", "grep"] $ - flip warn "Don't use ls | grep. Use a glob or a for loop with a condition to allow non-alphanumeric filenames.", + \x -> warn x 2010 "Don't use ls | grep. Use a glob or a for loop with a condition to allow non-alphanumeric filenames.", for' ["ls", "xargs"] $ - flip warn "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 for ["ls", "?"] $ \(ls:_) -> (when (not $ hasShortParameter (deadSimple ls) 'N') $ - info (getId ls) "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 () where for l f = @@ -379,7 +379,7 @@ prop_checkShebang1 = verifyFull checkShebang "#!/usr/bin/env bash -x\necho cow" prop_checkShebang2 = verifyNotFull checkShebang "#! /bin/sh -l " checkShebang (T_Script id sb _) = if (length $ words sb) > 2 then - let note = Note ErrorC $ "On most OS, shebangs can only specify a single parameter." + let note = Note ErrorC 2096 $ "On most OS, shebangs can only specify a single parameter." in [(id, note)] else [] @@ -403,8 +403,8 @@ prop_checkBashisms17= verify checkBashisms "echo $((RANDOM%6+1))" prop_checkBashisms18= verify checkBashisms "foo &> /dev/null" checkBashisms = bashism where - errMsg id s = err id $ "#!/bin/sh was specified, so " ++ s ++ " is not supported, even when sh is actually bash." - warnMsg id s = warn id $ "#!/bin/sh was specified, but " ++ s ++ " is not standard." + errMsg id s = err id 2040 $ "#!/bin/sh was specified, so " ++ s ++ " is not supported, even when sh is actually bash." + warnMsg id s = warn id 2039 $ "#!/bin/sh was specified, but " ++ s ++ " is not standard." bashism (T_ProcSub id _ _) = errMsg id "process substitution" bashism (T_Extglob id _ _) = warnMsg id "extglob" bashism (T_DollarSingleQuoted id _) = warnMsg id "$'..'" @@ -468,13 +468,13 @@ prop_checkForInQuoted5 = verify checkForInQuoted "for f in ls; do true; done" checkForInQuoted (T_ForIn _ f [T_NormalWord _ [word@(T_DoubleQuoted id list)]] _) = when (any (\x -> willSplit x && not (isMagicInQuotes x)) list || (getLiteralString word >>= (return . wouldHaveBeenGlob)) == Just True) $ - err id $ "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]] _) = - warn id $ "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]] _) = if ',' `elem` s - then warn id $ "Use spaces, not commas, to separate loop elements." - else warn id $ "This loop will only run once, with " ++ f ++ "='" ++ s ++ "'." + then warn id 2042 $ "Use spaces, not commas, to separate loop elements." + else warn id 2043 $ "This loop will only run once, with " ++ f ++ "='" ++ s ++ "'." checkForInQuoted _ = return () prop_checkForInCat1 = verify checkForInCat "for f in $(cat foo); do stuff; done" @@ -486,7 +486,7 @@ checkForInCat (T_ForIn _ f [T_NormalWord _ w] _) = mapM_ checkF w where checkF (T_DollarExpansion id [T_Pipeline _ r]) | all isLineBased r = - info id $ "To read lines rather than words, pipe/redirect to a 'while read' loop." + info id 2013 "To read lines rather than words, pipe/redirect to a 'while read' loop." checkF (T_Backticked id cmds) = checkF (T_DollarExpansion id cmds) checkF _ = return () isLineBased cmd = any (cmd `isCommand`) @@ -507,8 +507,8 @@ checkForInLs t = try t case deadSimple x of ("ls":n) -> let warntype = if any ("-" `isPrefixOf`) n then warn else err in - warntype id $ "Iterate over globs whenever possible (e.g. 'for f in */*.wav'), as for loops over ls will fail for filenames like 'my file*.txt'." - ("find":_) -> warn id $ "Use find -exec or a while read loop instead, as for loops over find will fail for filenames like 'my file*.txt'." + warntype id 2045 $ "Iterate over globs whenever possible (e.g. 'for f in */*.wav'), as for loops over ls will fail for filenames like 'my file*.txt'." + ("find":_) -> warn id 2044 $ "Use find -exec or a while read loop instead, as for loops over find will fail for filenames like 'my file*.txt'." _ -> return () @@ -522,7 +522,7 @@ checkFindExec (T_SimpleCommand _ _ t@(h:r)) | h `isCommand` "find" = do c <- broken r False when c $ do let wordId = getId $ last t in - err wordId "Missing ';' or + terminating -exec. You can't use |/||/&&, and ';' has to be a separate, quoted argument." + err wordId 2067 "Missing ';' or + terminating -exec. You can't use |/||/&&, and ';' has to be a separate, quoted argument." where broken [] v = return v @@ -545,7 +545,7 @@ checkFindExec (T_SimpleCommand _ _ t@(h:r)) | h `isCommand` "find" = do warnFor x = if shouldWarn x - then info (getId x) "This will expand once before find runs, not per file found." + then info (getId x) 2014 "This will expand once before find runs, not per file found." else return () fromWord (T_NormalWord _ l) = l @@ -570,7 +570,7 @@ checkUnquotedExpansions t tree = check _ = return () examine t = unless (inUnquotableContext tree t || usedAsCommandName tree t) $ - warn (getId t) "Quote this to prevent word splitting." + warn (getId t) 2046 "Quote this to prevent word splitting." prop_checkRedirectToSame = verify checkRedirectToSame "cat foo > foo" @@ -581,7 +581,7 @@ checkRedirectToSame s@(T_Pipeline _ list) = mapM_ (\l -> (mapM_ (\x -> doAnalysis (checkOccurences x) l) (getAllRedirs list))) list where checkOccurences t@(T_NormalWord exceptId x) (T_NormalWord newId y) = when (x == y && exceptId /= newId && not (special t)) (do - let note = Note InfoC $ "Make sure not to read and write the same file in the same pipeline." + let note = Note InfoC 2094 $ "Make sure not to read and write the same file in the same pipeline." addNoteFor newId $ note addNoteFor exceptId $ note) checkOccurences _ _ = return () @@ -599,13 +599,13 @@ checkRedirectToSame _ = return () prop_checkShorthandIf = verify checkShorthandIf "[[ ! -z file ]] && scp file host || rm file" prop_checkShorthandIf2 = verifyNot checkShorthandIf "[[ ! -z file ]] && { scp file host || echo 'Eek'; }" checkShorthandIf (T_AndIf id _ (T_OrIf _ _ _)) = - info id "Note that A && B || C is not if-then-else. C may run when A is true." + info id 2015 "Note that A && B || C is not if-then-else. C may run when A is true." checkShorthandIf _ = return () prop_checkDollarStar = verify checkDollarStar "for f in $*; do ..; done" checkDollarStar (T_NormalWord _ [(T_DollarBraced id l)]) | (bracedString l) == "*" = - warn id $ "Use \"$@\" (with quotes) to prevent whitespace problems." + warn id 2048 $ "Use \"$@\" (with quotes) to prevent whitespace problems." checkDollarStar _ = return () @@ -617,7 +617,7 @@ prop_checkUnquotedDollarAt4 = verifyNot checkUnquotedDollarAt "ls \"$@\"" prop_checkUnquotedDollarAt5 = verifyNot checkUnquotedDollarAt "ls ${foo/@/ at }" checkUnquotedDollarAt (T_NormalWord _ [T_DollarBraced id l]) = let string = bracedString l - failing = err id $ "Add double quotes around ${" ++ string ++ "}, otherwise it's just like $* and breaks on spaces." + failing = err id 2068 $ "Add double quotes around ${" ++ string ++ "}, otherwise it's just like $* and breaks on spaces." in do when ("@" `isPrefixOf` string) failing when (not ("#" `isPrefixOf` string) && "[@]" `isInfixOf` string) failing @@ -632,7 +632,7 @@ checkStderrRedirect (T_Redirecting _ [ T_Greater _ -> error T_DGREAT _ -> error _ -> return () - where error = err id $ "The order of the 2>&1 and the redirect matters. The 2>&1 has to be last." + where error = err id 2069 $ "The order of the 2>&1 and the redirect matters. The 2>&1 has to be last." checkStderrRedirect _ = return () lt x = trace ("FAILURE " ++ (show x)) x @@ -649,7 +649,7 @@ prop_checkSingleQuotedVariables4 = verifyNotTree checkSingleQuotedVariables "awk prop_checkSingleQuotedVariables5 = verifyNotTree checkSingleQuotedVariables "trap 'echo $SECONDS' EXIT" checkSingleQuotedVariables t@(T_SingleQuoted id s) parents = case matchRegex re s of - Just [] -> unless (probablyOk t) $ info id $ "Expressions don't expand in single quotes, use double quotes for that." + Just [] -> unless (probablyOk t) $ info id 2016 $ "Expressions don't expand in single quotes, use double quotes for that." _ -> return () where probablyOk t = @@ -662,7 +662,7 @@ prop_checkUnquotedN = verify checkUnquotedN "if [ -n $foo ]; then echo cow; fi" prop_checkUnquotedN2 = verify checkUnquotedN "[ -n $cow ]" prop_checkUnquotedN3 = verifyNot checkUnquotedN "[[ -n $foo ]] && echo cow" checkUnquotedN (T_Condition _ SingleBracket (TC_Unary _ SingleBracket "-n" (T_NormalWord id [t]))) | willSplit t = - err id "Always true because you failed to quote. Use [[ ]] instead." + err id 2070 "Always true because you failed to quote. Use [[ ]] instead." checkUnquotedN _ = return () prop_checkNumberComparisons1 = verify checkNumberComparisons "[[ $foo < 3 ]]" @@ -673,14 +673,14 @@ prop_checkNumberComparisons5 = verify checkNumberComparisons "[[ $foo -le 2.72 ] prop_checkNumberComparisons6 = verify checkNumberComparisons "[[ 3.14 = $foo ]]" checkNumberComparisons (TC_Binary id typ op lhs rhs) = do when (op `elem` ["<", ">", "<=", ">=", "\\<", "\\>", "\\<=", "\\>="]) $ do - when (isNum lhs || isNum rhs) $ err id $ "\"" ++ op ++ "\" is for string comparisons. Use " ++ (eqv op) ++" ." + when (isNum lhs || isNum rhs) $ err id 2071 $ "\"" ++ op ++ "\" is for string comparisons. Use " ++ (eqv op) ++" ." mapM_ checkDecimals [lhs, rhs] when (op `elem` ["-lt", "-gt", "-le", "-ge", "-eq", "=", "=="]) $ do mapM_ checkDecimals [lhs, rhs] where - checkDecimals hs = when (isFraction hs) $ err (getId hs) $ decimalError + checkDecimals hs = when (isFraction hs) $ err (getId hs) 2072 $ decimalError decimalError = "Decimals are not supported. Either use integers only, or use bc or awk to compare." isNum t = case deadSimple t of [v] -> all isDigit v _ -> False @@ -701,17 +701,17 @@ prop_checkSingleBracketOperators3 = verifyNot checkSingleBracketOperators "[[ fo prop_checkSingleBracketOperators5 = verify checkSingleBracketOperators "until [ $n <= $z ]; do echo foo; done" checkSingleBracketOperators (TC_Binary id typ op lhs rhs) | typ == SingleBracket && op `elem` ["<", ">", "<=", ">="] = - err id $ "Can't use " ++ op ++" in [ ]. Escape it or use [[..]]." + err id 2073 $ "Can't use " ++ op ++" in [ ]. Escape it or use [[..]]." checkSingleBracketOperators (TC_Binary id typ op lhs rhs) | typ == SingleBracket && op == "=~" = - err id $ "Can't use " ++ op ++" in [ ]. Use [[..]] instead." + err id 2074 $ "Can't use " ++ op ++" in [ ]. Use [[..]] instead." checkSingleBracketOperators _ = return () prop_checkDoubleBracketOperators1 = verify checkDoubleBracketOperators "[[ 3 \\< 4 ]]" prop_checkDoubleBracketOperators3 = verifyNot checkDoubleBracketOperators "[[ foo < bar ]]" checkDoubleBracketOperators x@(TC_Binary id typ op lhs rhs) | typ == DoubleBracket && op `elem` ["\\<", "\\>", "\\<=", "\\>="] = - err id $ "Escaping " ++ op ++" is required in [..], but invalid in [[..]]" + err id 2075 $ "Escaping " ++ op ++" is required in [..], but invalid in [[..]]" checkDoubleBracketOperators _ = return () prop_checkQuotedCondRegex1 = verify checkQuotedCondRegex "[[ $foo =~ \"bar\" ]]" @@ -723,7 +723,7 @@ checkQuotedCondRegex (TC_Binary _ _ "=~" _ rhs) = T_NormalWord id [T_SingleQuoted _ _] -> error id _ -> return () where - error id = err id $ "Don't quote rhs of =~, it'll match literally rather than as a regex." + error id = err id 2076 $ "Don't quote rhs of =~, it'll match literally rather than as a regex." checkQuotedCondRegex _ = return () prop_checkGlobbedRegex1 = verify checkGlobbedRegex "[[ $foo =~ *foo* ]]" @@ -734,7 +734,7 @@ prop_checkGlobbedRegex4 = verifyNot checkGlobbedRegex "[[ $foo =~ ^c.* ]]" checkGlobbedRegex (TC_Binary _ DoubleBracket "=~" _ rhs) = let s = concat $ deadSimple rhs in if isConfusedGlobRegex s - then warn (getId rhs) $ "=~ is for regex. Use == for globs." + then warn (getId rhs) 2049 $ "=~ is for regex. Use == for globs." else return () checkGlobbedRegex _ = return () @@ -746,7 +746,7 @@ prop_checkConstantIfs4 = verifyNot checkConstantIfs "[[ $n -le 3 ]]" prop_checkConstantIfs5 = verifyNot checkConstantIfs "[[ $n -le $n ]]" checkConstantIfs (TC_Binary id typ op lhs rhs) | op `elem` [ "==", "!=", "<=", ">=", "-eq", "-ne", "-lt", "-le", "-gt", "-ge", "=~", ">", "<", "="] = do - when (isJust lLit && isJust rLit) $ warn id $ "This expression is constant. Did you forget the $ on a variable?" + when (isJust lLit && isJust rLit) $ warn id 2050 $ "This expression is constant. Did you forget the $ on a variable?" where lLit = getLiteralString lhs rLit = getLiteralString rhs @@ -757,7 +757,7 @@ prop_checkNoaryWasBinary2 = verify checkNoaryWasBinary "[ $foo=3 ]" prop_checkNoaryWasBinary3 = verify checkNoaryWasBinary "[ $foo!=3 ]" checkNoaryWasBinary (TC_Noary _ _ t@(T_NormalWord id l)) | not $ isConstant t = do let str = concat $ deadSimple t - when ('=' `elem` str) $ err id $ "You need spaces around the comparison operator." + when ('=' `elem` str) $ err id 2077 $ "You need spaces around the comparison operator." checkNoaryWasBinary _ = return () prop_checkConstantNoary = verify checkConstantNoary "[[ '$(foo)' ]]" @@ -765,23 +765,23 @@ prop_checkConstantNoary2 = verify checkConstantNoary "[ \"-f lol\" ]" prop_checkConstantNoary3 = verify checkConstantNoary "[[ cmd ]]" prop_checkConstantNoary4 = verify checkConstantNoary "[[ ! cmd ]]" checkConstantNoary (TC_Noary _ _ t@(T_NormalWord id _)) | isConstant t = do - err id $ "This expression is constant. Did you forget a $ somewhere?" + err id 2078 $ "This expression is constant. Did you forget a $ somewhere?" checkConstantNoary _ = return () prop_checkBraceExpansionVars = verify checkBraceExpansionVars "echo {1..$n}" checkBraceExpansionVars (T_BraceExpansion id s) | '$' `elem` s = - warn id $ "Bash doesn't support variables in brace expansions." + warn id 2051 $ "Bash doesn't support variables in brace expansions." checkBraceExpansionVars _ = return () prop_checkForDecimals = verify checkForDecimals "((3.14*c))" checkForDecimals (TA_Literal id s) | any (== '.') s = do - err id $ "(( )) doesn't support decimals. Use bc or awk." + err id 2079 $ "(( )) doesn't support decimals. Use bc or awk." checkForDecimals _ = return () prop_checkDivBeforeMult = verify checkDivBeforeMult "echo $((c/n*100))" prop_checkDivBeforeMult2 = verifyNot checkDivBeforeMult "echo $((c*100/n))" checkDivBeforeMult (TA_Binary _ "*" (TA_Binary id "/" _ _) _) = do - info id $ "Increase precision by replacing a/b*c with a*c/b." + info id 2017 $ "Increase precision by replacing a/b*c with a*c/b." checkDivBeforeMult _ = return () prop_checkArithmeticDeref = verify checkArithmeticDeref "echo $((3+$foo))" @@ -791,7 +791,7 @@ prop_checkArithmeticDeref4 = verifyNot checkArithmeticDeref "(( ! $? ))" prop_checkArithmeticDeref5 = verifyNot checkArithmeticDeref "(($1))" prop_checkArithmeticDeref6 = verifyNot checkArithmeticDeref "(( ${a[$i]} ))" checkArithmeticDeref (TA_Expansion _ (T_DollarBraced id l)) | not . excepting $ bracedString l = - style id $ "Don't use $ on variables in (( ))." + style id 2004 $ "Don't use $ on variables in (( ))." where excepting [] = True excepting s = (any (`elem` "/.:#%?*@[]") s) || (isDigit $ head s) @@ -801,7 +801,7 @@ prop_checkArithmeticBadOctal1 = verify checkArithmeticBadOctal "(( 0192 ))" prop_checkArithmeticBadOctal2 = verifyNot checkArithmeticBadOctal "(( 0x192 ))" prop_checkArithmeticBadOctal3 = verifyNot checkArithmeticBadOctal "(( 1 ^ 0777 ))" checkArithmeticBadOctal (TA_Base id "0" (TA_Literal _ str)) | '9' `elem` str || '8' `elem` str = - err id $ "Numbers with leading 0 are considered octal." + err id 2080 $ "Numbers with leading 0 are considered octal." checkArithmeticBadOctal _ = return () prop_checkComparisonAgainstGlob = verify checkComparisonAgainstGlob "[[ $cow == $bar ]]" @@ -809,10 +809,10 @@ prop_checkComparisonAgainstGlob2 = verifyNot checkComparisonAgainstGlob "[[ $cow prop_checkComparisonAgainstGlob3 = verify checkComparisonAgainstGlob "[ $cow = *foo* ]" prop_checkComparisonAgainstGlob4 = verifyNot checkComparisonAgainstGlob "[ $cow = foo ]" checkComparisonAgainstGlob (TC_Binary _ DoubleBracket op _ (T_NormalWord id [T_DollarBraced _ _])) | op == "=" || op == "==" = - warn id $ "Quote the rhs of = in [[ ]] to prevent glob interpretation." + warn id 2053 $ "Quote the rhs of = in [[ ]] to prevent glob interpretation." checkComparisonAgainstGlob (TC_Binary _ SingleBracket op _ word) | (op == "=" || op == "==") && isGlob word = - err (getId word) $ "[ .. ] can't match globs. Use [[ .. ]] or grep." + err (getId word) 2081 $ "[ .. ] can't match globs. Use [[ .. ]] or grep." checkComparisonAgainstGlob _ = return () prop_checkCommarrays1 = verify checkCommarrays "a=(1, 2)" @@ -820,7 +820,7 @@ prop_checkCommarrays2 = verify checkCommarrays "a+=(1,2,3)" prop_checkCommarrays3 = verifyNot checkCommarrays "cow=(1 \"foo,bar\" 3)" checkCommarrays (T_Array id l) = if any ("," `isSuffixOf`) (concatMap deadSimple l) || (length $ filter (==',') (concat $ concatMap deadSimple l)) > 1 - then warn id "Use spaces, not commas, to separate array elements." + then warn id 2054 "Use spaces, not commas, to separate array elements." else return () checkCommarrays _ = return () @@ -831,10 +831,10 @@ prop_checkOrNeq4 = verifyNot checkOrNeq "[ a != $cow || b != $foo ]" -- This only catches the most idiomatic cases. Fixme? checkOrNeq (TC_Or id typ op (TC_Binary _ _ op1 word1 _) (TC_Binary _ _ op2 word2 _)) | word1 == word2 && (op1 == op2 && (op1 == "-ne" || op1 == "!=")) = - warn id $ "You probably wanted " ++ (if typ == SingleBracket then "-a" else "&&") ++ " here." + warn id 2055 $ "You probably wanted " ++ (if typ == SingleBracket then "-a" else "&&") ++ " here." checkOrNeq (TA_Binary id "||" (TA_Binary _ "!=" word1 _) (TA_Binary _ "!=" word2 _)) | word1 == word2 = - warn id "You probably wanted && here." + warn id 2056 "You probably wanted && here." checkOrNeq _ = return () @@ -847,10 +847,10 @@ prop_checkValidCondOps3 = verifyNot checkValidCondOps "[ 1 = 2 -a 3 -ge 4 ]" prop_checkValidCondOps4 = verifyNot checkValidCondOps "[[ ! -v foo ]]" checkValidCondOps (TC_Binary id _ s _ _) | not (s `elem` ["-nt", "-ot", "-ef", "==", "!=", "<=", ">=", "-eq", "-ne", "-lt", "-le", "-gt", "-ge", "=~", ">", "<", "=", "\\<", "\\>", "\\<=", "\\>="]) = - warn id "Unknown binary operator." + warn id 2057 "Unknown binary operator." checkValidCondOps (TC_Unary id _ s _) | not (s `elem` [ "!", "-a", "-b", "-c", "-d", "-e", "-f", "-g", "-h", "-L", "-k", "-p", "-r", "-s", "-S", "-t", "-u", "-w", "-x", "-O", "-G", "-N", "-z", "-n", "-o", "-v", "-R"]) = - warn id "Unknown unary operator." + warn id 2058 "Unknown unary operator." checkValidCondOps _ = return () --- Context seeking @@ -973,7 +973,7 @@ checkPrintfVar = checkUnqualifiedCommand "printf" f where f _ = return () check format = if not $ isLiteral format - then warn (getId format) $ "Don't use variables in the printf format string. Use printf \"..%s..\" \"$foo\"." + then warn (getId format) 2059 $ "Don't use variables in the printf format string. Use printf \"..%s..\" \"$foo\"." else return () prop_checkUuoe1 = verify checkUuoe "echo $(date)" @@ -982,7 +982,7 @@ prop_checkUuoe2 = verify checkUuoe "echo \"$(date)\"" prop_checkUuoe2a= verify checkUuoe "echo \"`date`\"" prop_checkUuoe3 = verifyNot checkUuoe "echo \"The time is $(date)\"" checkUuoe = checkUnqualifiedCommand "echo" f where - msg id = style id "Useless echo? Instead of 'echo $(cmd)', just use 'cmd'." + msg id = style id 2005 "Useless echo? Instead of 'echo $(cmd)', just use 'cmd'." f [T_NormalWord id [(T_DollarExpansion _ _)]] = msg id f [T_NormalWord id [T_DoubleQuoted _ [(T_DollarExpansion _ _)]]] = msg id f [T_NormalWord id [(T_Backticked _ _)]] = msg id @@ -1005,18 +1005,18 @@ prop_checkTr11= verifyNot checkTr "tr abc '[d*]'" checkTr = checkCommand "tr" (mapM_ f) where f w | isGlob w = do -- The user will go [ab] -> '[ab]' -> 'ab'. Fixme? - warn (getId w) $ "Quote parameters to tr to prevent glob expansion." + warn (getId w) 2060 $ "Quote parameters to tr to prevent glob expansion." f word = case getLiteralString word of - Just "a-z" -> info (getId word) "Use '[:lower:]' to support accents and foreign alphabets." - Just "A-Z" -> info (getId word) "Use '[:upper:]' to support accents and foreign alphabets." + Just "a-z" -> info (getId word) 2018 "Use '[:lower:]' to support accents and foreign alphabets." + Just "A-Z" -> info (getId word) 2019 "Use '[:upper:]' to support accents and foreign alphabets." Just s -> do -- Eliminate false positives by only looking for dupes in SET2? when ((not $ "-" `isPrefixOf` s || "[:" `isInfixOf` s) && duplicated s) $ - info (getId word) "tr replaces sets of chars, not words (mentioned due to duplicates)." + info (getId word) 2020 "tr replaces sets of chars, not words (mentioned due to duplicates)." unless ("[:" `isPrefixOf` s) $ when ("[" `isPrefixOf` s && "]" `isSuffixOf` s && (length s > 2) && (not $ '*' `elem` s)) $ - info (getId word) "Don't use [] around ranges in tr, it replaces literal square brackets." + info (getId word) 2021 "Don't use [] around ranges in tr, it replaces literal square brackets." Nothing -> return () duplicated s = @@ -1035,7 +1035,7 @@ checkFindNameGlob = checkCommand "find" f where f (a:b:r) = do when (acceptsGlob (getLiteralString a) && isGlob b) $ do let (Just s) = getLiteralString a - warn (getId b) $ "Quote the parameter to " ++ s ++ " so the shell won't interpret it." + warn (getId b) 2061 $ "Quote the parameter to " ++ s ++ " so the shell won't interpret it." f (b:r) @@ -1057,13 +1057,13 @@ checkGrepRe = checkCommand "grep" f where f (x:r) | skippable (getLiteralString x) = f r f (re:_) = do when (isGlob re) $ do - warn (getId re) $ "Quote the grep pattern so the shell won't interpret it." + warn (getId re) 2062 $ "Quote the grep pattern so the shell won't interpret it." let string = concat $ deadSimple re if isConfusedGlobRegex string then - warn (getId re) $ "Grep uses regex, but this looks like a glob." + warn (getId re) 2063 $ "Grep uses regex, but this looks like a glob." else if (isPotentiallyConfusedGlobRegex string) - then info (getId re) "Note that c* does not mean \"c followed by anything\" in regex." + then info (getId re) 2022 "Note that c* does not mean \"c followed by anything\" in regex." else return () @@ -1076,7 +1076,7 @@ checkTrapQuotes = checkCommand "trap" f where f _ = return () checkTrap (T_NormalWord _ [T_DoubleQuoted _ rs]) = mapM_ checkExpansions rs checkTrap _ = return () - warning id = warn id $ "Use single quotes, otherwise this expands now rather than when signalled." + warning id = warn id 2064 $ "Use single quotes, otherwise this expands now rather than when signalled." checkExpansions (T_DollarExpansion id _) = warning id checkExpansions (T_Backticked id _) = warning id checkExpansions (T_DollarBraced id _) = warning id @@ -1089,7 +1089,7 @@ prop_checkTimeParameters3 = verifyNot checkTimeParameters "time -p foo" checkTimeParameters = checkUnqualifiedCommand "time" f where f (x:_) = let s = concat $ deadSimple x in if "-" `isPrefixOf` s && s /= "-p" then - info (getId x) "The shell may override 'time' as seen in man time(1). Use 'command time ..' for that one." + info (getId x) 2023 "The shell may override 'time' as seen in man time(1). Use 'command time ..' for that one." else return () f _ = return () @@ -1097,7 +1097,7 @@ prop_checkTestRedirects1 = verify checkTestRedirects "test 3 > 1" prop_checkTestRedirects2 = verifyNot checkTestRedirects "test 3 \\> 1" prop_checkTestRedirects3 = verify checkTestRedirects "/usr/bin/test $var > $foo" checkTestRedirects (T_Redirecting id redirs@(redir:_) cmd) | cmd `isCommand` "test" = - warn (getId redir) $ "This is interpretted as a shell file redirection, not a comparison." + warn (getId redir) 2065 $ "This is interpretted as a shell file redirection, not a comparison." checkTestRedirects _ = return () prop_checkSudoRedirect1 = verify checkSudoRedirect "sudo echo 3 > /proc/file" @@ -1114,13 +1114,13 @@ checkSudoRedirect (T_Redirecting _ redirs cmd) | cmd `isCommand` "sudo" = | (s == "" || s == "&") && (not $ special file) = case op of T_Less _ -> - info (getId op) $ + info (getId op) 2024 $ "sudo doesn't affect redirects. Use sudo cat file | .." T_Greater _ -> - warn (getId op) $ + warn (getId op) 2024 $ "sudo doesn't affect redirects. Use ..| sudo tee file" T_DGREAT _ -> - warn (getId op) $ + warn (getId op) 2024 $ "sudo doesn't affect redirects. Use .. | sudo tee -a file" _ -> return () warnAbout _ = return () @@ -1142,7 +1142,7 @@ checkPS1Assignments (T_Assignment _ _ "PS1" _ word) = warnFor word warnFor word = let contents = concat $ deadSimple word in when (containsUnescaped contents) $ - info (getId word) "Make sure all escape sequences are enclosed in \\[..\\] to prevent line wrapping issues" + info (getId word) 2025 "Make sure all escape sequences are enclosed in \\[..\\] to prevent line wrapping issues" containsUnescaped s = let unenclosed = subRegex enclosedRegex s "" in isJust $ matchRegex escapeRegex unenclosed @@ -1153,7 +1153,7 @@ checkPS1Assignments _ = return () prop_checkBackticks1 = verify checkBackticks "echo `foo`" prop_checkBackticks2 = verifyNot checkBackticks "echo $(foo)" checkBackticks (T_Backticked id _) = - style id "Use $(..) instead of deprecated `..`" + style id 2006 "Use $(..) instead of deprecated `..`" checkBackticks _ = return () prop_checkIndirectExpansion1 = verify checkIndirectExpansion "${foo$n}" @@ -1163,7 +1163,7 @@ prop_checkIndirectExpansion4 = verify checkIndirectExpansion "${var${n}_$((i%2)) prop_checkIndirectExpansion5 = verifyNot checkIndirectExpansion "${bar}" checkIndirectExpansion (T_DollarBraced i (T_NormalWord _ contents)) = when (isIndirection contents) $ - err i "To expand via indirection, use name=\"foo$n\"; echo \"${!name}\"." + err i 2082 "To expand via indirection, use name=\"foo$n\"; echo \"${!name}\"." where isIndirection vars = let list = catMaybes (map isIndirectionPart vars) in @@ -1187,7 +1187,7 @@ checkInexplicablyUnquoted (T_NormalWord id tokens) = mapM_ check (tails tokens) where check ((T_SingleQuoted _ _):(T_Literal id str):_) | all isAlphaNum str = - info id $ "This word is outside of quotes. Did you intend to 'nest '\"'single quotes'\"' instead'? " + info id 2026 $ "This word is outside of quotes. Did you intend to 'nest '\"'single quotes'\"' instead'? " check ((T_DoubleQuoted _ _):trapped:(T_DoubleQuoted _ _):_) = case trapped of @@ -1197,7 +1197,7 @@ checkInexplicablyUnquoted (T_NormalWord id tokens) = mapM_ check (tails tokens) check _ = return () warnAbout id = - info id $ "Surrounding quotes actually unquotes this (\"inside\"$outside\"inside\"). Did you forget your quote level?" + info id 2027 $ "Surrounding quotes actually unquotes this (\"inside\"$outside\"inside\"). Did you forget your quote level?" checkInexplicablyUnquoted _ = return () prop_checkTildeInQuotes1 = verify checkTildeInQuotes "var=\"~/out.txt\"" @@ -1207,7 +1207,7 @@ prop_checkTildeInQuotes5 = verifyNot checkTildeInQuotes "echo '/~foo/cow'" prop_checkTildeInQuotes6 = verifyNot checkTildeInQuotes "awk '$0 ~ /foo/'" checkTildeInQuotes = check where - verify id ('~':_) = warn id "Note that ~ does not expand in quotes." + verify id ('~':_) = warn id 2088 "Note that ~ does not expand in quotes." verify _ _ = return () check (T_NormalWord _ ((T_SingleQuoted id str):_)) = verify id str @@ -1219,7 +1219,7 @@ prop_checkLonelyDotDash1 = verify checkLonelyDotDash "./ file" prop_checkLonelyDotDash2 = verifyNot checkLonelyDotDash "./file" checkLonelyDotDash t@(T_Redirecting id _ _) | isUnqualifiedCommand t "./" = - err id "Don't add spaces after the slash in './file'." + err id 2083 "Don't add spaces after the slash in './file'." checkLonelyDotDash _ = return () @@ -1251,7 +1251,7 @@ checkSpuriousExec = doLists commentIfExec (T_Redirecting _ _ f@( T_SimpleCommand id _ (cmd:arg:_))) = when (f `isUnqualifiedCommand` "exec") $ - warn (id) $ + warn (id) 2093 $ "Remove \"exec \" if script should continue after this command." commentIfExec _ = return () @@ -1264,11 +1264,11 @@ checkSpuriousExpansion (T_SimpleCommand _ _ [T_NormalWord _ [word]]) = check wor where check word = case word of T_DollarExpansion id _ -> - warn id "Remove surrounding $() to avoid executing output." + warn id 2091 "Remove surrounding $() to avoid executing output." T_Backticked id _ -> - warn id "Remove backticks to avoid executing output." + warn id 2092 "Remove backticks to avoid executing output." T_DollarArithmetic id _ -> - err id "Remove '$' or use '_=$((expr))' to avoid executing output." + err id 2084 "Remove '$' or use '_=$((expr))' to avoid executing output." T_DoubleQuoted id [subword] -> check subword _ -> return () checkSpuriousExpansion _ = return () @@ -1295,13 +1295,13 @@ checkUnusedEchoEscapes = checkCommand "echo" f examine id str = when (str `matches` hasEscapes) $ - info id "echo won't expand escape sequences. Consider printf." + info id 2028 "echo won't expand escape sequences. Consider printf." prop_checkDollarBrackets1 = verify checkDollarBrackets "echo $[1+2]" prop_checkDollarBrackets2 = verifyNot checkDollarBrackets "echo $((1+2))" checkDollarBrackets (T_DollarBracket id _) = - style id "Use $((..)) instead of deprecated $[..]" + style id 2007 "Use $((..)) instead of deprecated $[..]" checkDollarBrackets _ = return () prop_checkSshHereDoc1 = verify checkSshHereDoc "ssh host << foo\necho $PATH\nfoo" @@ -1313,7 +1313,7 @@ checkSshHereDoc (T_Redirecting _ redirs cmd) hasVariables = mkRegex "[`$]" checkHereDoc (T_FdRedirect _ _ (T_HereDoc id _ Unquoted token tokens)) | not (all isConstant tokens) = - warn id $ "Quote '" ++ token ++ "' to make here document expansions happen on the server side rather than on the client." + warn id 2087 $ "Quote '" ++ token ++ "' to make here document expansions happen on the server side rather than on the client." checkHereDoc _ = return () checkSshHereDoc _ = return () @@ -1332,7 +1332,7 @@ checkSshCommandString = checkCommand "ssh" f checkArg (T_NormalWord _ [T_DoubleQuoted id parts]) = case filter (not . isConstant) parts of [] -> return () - (x:_) -> info (getId x) $ + (x:_) -> info (getId x) 2029 $ "Note that, unescaped, this expands on the client side." checkArg _ = return () @@ -1502,8 +1502,8 @@ findSubshelled ((Reference (_, readToken, str)):rest) scopes deadVars = do case Map.findWithDefault Alive str deadVars of Alive -> return () Dead writeToken reason -> do - info (getId writeToken) $ "Modification of " ++ str ++ " is local (to subshell caused by "++ reason ++")." - info (getId readToken) $ str ++ " was modified in a subshell. That change might be lost." + info (getId writeToken) 2030 $ "Modification of " ++ str ++ " is local (to subshell caused by "++ reason ++")." + info (getId readToken) 2031 $ str ++ " was modified in a subshell. That change might be lost." findSubshelled rest scopes deadVars findSubshelled ((StackScope (SubshellScope reason)):rest) scopes deadVars = @@ -1566,7 +1566,7 @@ checkSpacefulness t = if spaced && (not $ inUnquotableContext parents token) && (not $ usedAsCommandName parents token) - then return [(getId token, Note InfoC warning)] + then return [(getId token, Note InfoC 2086 warning)] else return [] where warning = "Double quote to prevent globbing and word splitting." @@ -1632,9 +1632,9 @@ checkQuotesInLiterals t = if isJust assignment && not (inUnquotableContext parents expr) then return [ (fromJust assignment, - Note WarningC "Word splitting will treat quotes as literals. Use an array."), + Note WarningC 2089 "Word splitting will treat quotes as literals. Use an array."), (getId expr, - Note WarningC "Embedded quotes in this variable will not be respected.") + Note WarningC 2090 "Embedded quotes in this variable will not be respected.") ] else return [] @@ -1676,9 +1676,9 @@ checkFunctionsUsedExternally t = case Map.lookup (concat $ deadSimple arg) functions of Nothing -> return () Just id -> do - warn (getId arg) $ + warn (getId arg) 2033 $ "Shell functions can't be passed to external commands." - info id $ + info id 2032 $ "Use own script or sh -c '..' to run this from " ++ cmd ++ "." prop_checkUnused0 = verifyNotFull checkUnusedAssignments "var=foo; echo $var" @@ -1705,7 +1705,7 @@ checkUnusedAssignments t = snd $ runState (mapM_ checkAssignment flow) [] case Map.lookup name references of Just _ -> return () Nothing -> do - info (getId token) $ + info (getId token) 2034 $ name ++ " appears unused. Verify it or export it." checkAssignment _ = return () @@ -1718,7 +1718,7 @@ checkGlobsAsOptions (T_SimpleCommand _ _ args) = mapM_ check $ takeWhile (not . isEndOfArgs) args where check v@(T_NormalWord _ ((T_Glob id s):_)) | s == "*" || s == "?" = - info id $ + info id 2035 $ "Use ./" ++ (concat $ deadSimple v) ++ " so names with dashes won't become options." check _ = return () diff --git a/ShellCheck/Parser.hs b/ShellCheck/Parser.hs index 9b4b3b7..36edf3a 100644 --- a/ShellCheck/Parser.hs +++ b/ShellCheck/Parser.hs @@ -77,29 +77,30 @@ allspacingOrFail = do unicodeDoubleQuote = do pos <- getPosition char '\x201C' <|> char '\x201D' - parseProblemAt pos WarningC "This is a unicode double quote. Delete and retype it." + parseProblemAt pos WarningC 1015 "This is a unicode double quote. Delete and retype it." return '"' unicodeSingleQuote = do pos <- getPosition char '\x2018' <|> char '\x2019' - parseProblemAt pos WarningC "This is a unicode single quote. Delete and retype it." + parseProblemAt pos WarningC 1016 "This is a unicode single quote. Delete and retype it." return '"' carriageReturn = do - parseNote ErrorC "Literal carriage return. Run script through tr -d '\\r' ." + parseNote ErrorC 1017 "Literal carriage return. Run script through tr -d '\\r' ." char '\r' nbsp = do - parseNote ErrorC "This is a  . Delete it and retype as space." + parseNote ErrorC 1018 "This is a  . Delete it and retype as space." char '\xA0' return ' ' --------- Message/position annotation on top of user state -data Note = Note Severity String deriving (Show, Eq) -data ParseNote = ParseNote SourcePos Severity String deriving (Show, Eq) +data Note = Note Severity Code String deriving (Show, Eq) +data ParseNote = ParseNote SourcePos Severity Code String deriving (Show, Eq) data Metadata = Metadata SourcePos [Note] deriving (Show) data Severity = ErrorC | WarningC | InfoC | StyleC deriving (Show, Eq, Ord) +type Code = Integer initialState = (Id $ -1, Map.empty, []) @@ -139,9 +140,9 @@ addParseNote n = do -- Store potential parse problems outside of parsec -parseProblem level msg = do +parseProblem level code msg = do pos <- getPosition - parseProblemAt pos level msg + parseProblemAt pos level code msg setCurrentContexts c = do Ms.modify (\(list, _) -> (list, c)) @@ -164,8 +165,8 @@ pushContext c = do v <- getCurrentContexts setCurrentContexts (c:v) -parseProblemAt pos level msg = do - Ms.modify (\(list, current) -> ((ParseNote pos level msg):list, current)) +parseProblemAt pos level code msg = do + Ms.modify (\(list, current) -> ((ParseNote pos level code msg):list, current)) -- Store non-parse problems inside addNoteFor id note = modifyMap $ Map.adjust (\(Metadata pos notes) -> Metadata pos (note:notes)) id @@ -174,11 +175,11 @@ addNote note = do id <- getLastId addNoteFor id note -parseNote l a = do +parseNote c l a = do pos <- getPosition - parseNoteAt pos l a + parseNoteAt pos c l a -parseNoteAt pos l a = addParseNote $ ParseNote pos l a +parseNoteAt pos c l a = addParseNote $ ParseNote pos c l a --------- Convenient combinators thenSkip main follow = do @@ -214,11 +215,11 @@ orFail parser stuff = do wasIncluded p = option False (p >> return True) -acceptButWarn parser level note = do +acceptButWarn parser level code note = do optional $ try (do pos <- getPosition parser - parseProblemAt pos level note + parseProblemAt pos level code note ) called s p = do @@ -237,7 +238,7 @@ readConditionContents single = do pos <- getPosition s <- many1 letter when (s `elem` commonCommands) $ - parseProblemAt pos WarningC "Use 'if cmd; then ..' to check exit code, or 'if [[ $(cmd) == .. ]]' to check output.") + parseProblemAt pos WarningC 1009 "Use 'if cmd; then ..' to check exit code, or 'if [[ $(cmd) == .. ]]' to check output.") where typ = if single then SingleBracket else DoubleBracket @@ -263,7 +264,7 @@ readConditionContents single = do arg <- readCondWord return $ op arg) <|> (do - parseProblemAt pos ErrorC $ "Expected this to be an argument to the unary condition." + parseProblemAt pos ErrorC 1019 $ "Expected this to be an argument to the unary condition." fail "oops") readCondUnaryOp = try $ do @@ -282,10 +283,10 @@ readConditionContents single = do x <- readNormalWord pos <- getPosition when (endedWith "]" x) $ do - parseProblemAt pos ErrorC $ + parseProblemAt pos ErrorC 1020 $ "You need a space before the " ++ (if single then "]" else "]]") ++ "." when (single && endedWith ")" x) $ do - parseProblemAt pos ErrorC $ + parseProblemAt pos ErrorC 1021 $ "You need a space before the \\)" disregard spacing return x @@ -297,8 +298,8 @@ readConditionContents single = do readCondAndOp = do id <- getNextId x <- try (string "&&" <|> string "-a") - when (single && x == "&&") $ addNoteFor id $ Note ErrorC "You can't use && inside [..]. Use [[..]] instead." - when (not single && x == "-a") $ addNoteFor id $ Note ErrorC "In [[..]], use && instead of -a." + when (single && x == "&&") $ addNoteFor id $ Note ErrorC 1022 "You can't use && inside [..]. Use [[..]] instead." + when (not single && x == "-a") $ addNoteFor id $ Note ErrorC 1023 "In [[..]], use && instead of -a." softCondSpacing return $ TC_And id typ x @@ -306,8 +307,8 @@ readConditionContents single = do readCondOrOp = do id <- getNextId x <- try (string "||" <|> string "-o") - when (single && x == "||") $ addNoteFor id $ Note ErrorC "You can't use || inside [..]. Use [[..]] instead." - when (not single && x == "-o") $ addNoteFor id $ Note ErrorC "In [[..]], use && instead of -o." + when (single && x == "||") $ addNoteFor id $ Note ErrorC 1024 "You can't use || inside [..]. Use [[..]] instead." + when (not single && x == "-o") $ addNoteFor id $ Note ErrorC 1025 "In [[..]], use && instead of -o." softCondSpacing return $ TC_Or id typ x @@ -316,7 +317,7 @@ readConditionContents single = do x <- readCondWord `attempting` (do pos <- getPosition lookAhead (char '[') - parseProblemAt pos ErrorC $ if single + parseProblemAt pos ErrorC 1026 $ if single then "If grouping expressions inside [..], use \\( ..\\)." else "If grouping expressions inside [[..]], use ( .. )." ) @@ -326,7 +327,7 @@ readConditionContents single = do op <- readCondBinaryOp y <- if isRegex then readRegex - else readCondWord <|> ( (parseProblemAt pos ErrorC $ "Expected another argument for this operator.") >> mzero) + else readCondWord <|> ( (parseProblemAt pos ErrorC 1027 $ "Expected another argument for this operator.") >> mzero) return (x `op` y) ) <|> (return $ TC_Noary id typ x) @@ -334,16 +335,16 @@ readConditionContents single = do id <- getNextId pos <- getPosition lparen <- try $ string "(" <|> string "\\(" - when (single && lparen == "(") $ parseProblemAt pos ErrorC "In [..] you have to escape (). Use [[..]] instead." - when (not single && lparen == "\\(") $ parseProblemAt pos ErrorC "In [[..]] you shouldn't escape ()." + when (single && lparen == "(") $ parseProblemAt pos ErrorC 1028 "In [..] you have to escape (). Use [[..]] instead." + when (not single && lparen == "\\(") $ parseProblemAt pos ErrorC 1029 "In [[..]] you shouldn't escape ()." if single then hardCondSpacing else disregard spacing x <- readCondContents cpos <- getPosition rparen <- string ")" <|> string "\\)" if single then hardCondSpacing else disregard spacing - when (single && rparen == ")") $ parseProblemAt cpos ErrorC "In [..] you have to escape (). Use [[..]] instead." - when (not single && rparen == "\\)") $ parseProblemAt cpos ErrorC "In [[..]] you shouldn't escape ()." - when (isEscaped lparen `xor` isEscaped rparen) $ parseProblemAt pos ErrorC "Did you just escape one half of () but not the other?" + when (single && rparen == ")") $ parseProblemAt cpos ErrorC 1030 "In [..] you have to escape (). Use [[..]] instead." + when (not single && rparen == "\\)") $ parseProblemAt cpos ErrorC 1031 "In [[..]] you shouldn't escape ()." + when (isEscaped lparen `xor` isEscaped rparen) $ parseProblemAt pos ErrorC 1032 "Did you just escape one half of () but not the other?" return $ TC_Group id typ x where isEscaped ('\\':_) = True @@ -595,8 +596,8 @@ readCondition = called "test expression" $ do cpos <- getPosition close <- (try $ string "]]") <|> (string "]") - when (open == "[[" && close /= "]]") $ parseProblemAt cpos ErrorC "Did you mean ]] ?" - when (open == "[" && close /= "]" ) $ parseProblemAt opos ErrorC "Did you mean [[ ?" + when (open == "[[" && close /= "]]") $ parseProblemAt cpos ErrorC 1033 "Did you mean ]] ?" + when (open == "[" && close /= "]" ) $ parseProblemAt opos ErrorC 1034 "Did you mean [[ ?" spacing many readCmdWord -- Read and throw away remainders to get then/do warnings. Fixme? return $ T_Condition id (if single then SingleBracket else DoubleBracket) condition @@ -607,7 +608,7 @@ softCondSpacing = condSpacingMsg True "You need a space here." condSpacingMsg soft msg = do pos <- getPosition space <- spacing - when (null space) $ (if soft then parseNoteAt else parseProblemAt) pos ErrorC msg + when (null space) $ (if soft then parseNoteAt else parseProblemAt) pos ErrorC 1035 msg readComment = do char '#' @@ -628,7 +629,7 @@ readNormalishWord end = do checkPossibleTermination pos [T_Literal _ x] = if x `elem` ["do", "done", "then", "fi", "esac", "}"] - then parseProblemAt pos WarningC $ "Use semicolon or linefeed before '" ++ x ++ "' (or quote to make it literal)." + then parseProblemAt pos WarningC 1010 $ "Use semicolon or linefeed before '" ++ x ++ "' (or quote to make it literal)." else return () checkPossibleTermination _ _ = return () @@ -640,7 +641,7 @@ readNormalWordPart end = do return () `attempting` do pos <- getPosition lookAhead $ char '(' - parseProblemAt pos ErrorC "'(' is invalid here. Did you forget to escape it?" + parseProblemAt pos ErrorC 1036 "'(' is invalid here. Did you forget to escape it?" readSpacePart = do @@ -687,7 +688,7 @@ readSingleQuoted = called "single quoted string" $ do let string = concat s return (T_SingleQuoted id string) `attempting` do x <- lookAhead anyChar - when (isAlpha x && not (null string) && isAlpha (last string)) $ parseProblemAt pos WarningC "This apostrophe terminated the single quoted string!" + when (isAlpha x && not (null string) && isAlpha (last string)) $ parseProblemAt pos WarningC 1011 "This apostrophe terminated the single quoted string!" readSingleQuotedLiteral = do singleQuote @@ -802,8 +803,8 @@ readNormalEscaped = called "escaped char" $ do do next <- anyChar case escapedChar next of - Just name -> parseNoteAt pos WarningC $ "\\" ++ [next] ++ " is just literal '" ++ [next] ++ "' here. For " ++ name ++ ", use \"$(printf \"\\" ++ [next] ++ "\")\"." - Nothing -> parseNoteAt pos InfoC $ "This \\" ++ [next] ++ " will be a regular '" ++ [next] ++ "' in this context." + Just name -> parseNoteAt pos WarningC 1012 $ "\\" ++ [next] ++ " is just literal '" ++ [next] ++ "' here. For " ++ name ++ ", use \"$(printf \"\\" ++ [next] ++ "\")\"." + Nothing -> parseNoteAt pos InfoC 1001 $ "This \\" ++ [next] ++ " will be a regular '" ++ [next] ++ "' in this context." return [next] where escapedChar 'n' = Just "line feed" @@ -848,14 +849,14 @@ readExtglobPart = do readSingleEscaped = do s <- backslash - let attempt level p msg = do { try $ parseNote level msg; x <- p; return [s,x]; } + let attempt level code p msg = do { try $ parseNote level code msg; x <- p; return [s,x]; } do { x <- lookAhead singleQuote; - parseProblem InfoC "Are you trying to escape that single quote? echo 'You'\\''re doing it wrong'."; + parseProblem InfoC 1003 "Are you trying to escape that single quote? echo 'You'\\''re doing it wrong'."; return [s]; } - <|> attempt InfoC linefeed "You don't break lines with \\ in single quotes, it results in literal backslash-linefeed." + <|> attempt InfoC 1004 linefeed "You don't break lines with \\ in single quotes, it results in literal backslash-linefeed." <|> do x <- anyChar return [s,x] @@ -971,7 +972,7 @@ readDollarVariable = do return (T_DollarBraced id value) `attempting` do pos <- getPosition num <- lookAhead $ many1 p - parseNoteAt pos ErrorC $ "$" ++ (n:num) ++ " is equivalent to ${" ++ [n] ++ "}"++ num ++"." + parseNoteAt pos ErrorC 1037 $ "$" ++ (n:num) ++ " is equivalent to ${" ++ [n] ++ "}"++ num ++"." let positional = singleCharred digit let special = singleCharred specialVariable @@ -999,7 +1000,7 @@ readDollarLonely = do pos <- getPosition char '$' n <- lookAhead (anyChar <|> (eof >> return '_')) - when (n /= '\'') $ parseNoteAt pos StyleC "$ is not used specially and should therefore be escaped." + when (n /= '\'') $ parseNoteAt pos StyleC 1000 "$ is not used specially and should therefore be escaped." return $ T_Literal id "$" prop_readHereDoc = isOk readHereDoc "<< foo\nlol\ncow\nfoo" @@ -1018,7 +1019,7 @@ readHereDoc = called "here document" $ do optional $ do try . lookAhead $ char '(' let message = "Shells are space sensitive. Use '< <(cmd)', not '<<" ++ sp ++ "(cmd)'." - parseProblemAt pos ErrorC message + parseProblemAt pos ErrorC 1038 message hid <- getNextId (quoted, endToken) <- (readNormalLiteral "" >>= (\x -> return (Unquoted, stripLiteral x)) ) <|> (readDoubleQuotedLiteral >>= return . (\x -> (Quoted, stripLiteral x))) @@ -1058,22 +1059,22 @@ readHereDoc = called "here document" $ do verifyHereDoc dashed quoted spacing hereInfo = do when (dashed == Undashed && spacing /= "") $ - parseNote ErrorC "Use <<- instead of << if you want to indent the end token." + parseNote ErrorC 1039 "Use <<- instead of << if you want to indent the end token." when (dashed == Dashed && filter (/= '\t') spacing /= "" ) $ - parseNote ErrorC "When using <<-, you can only indent with tabs." + parseNote ErrorC 1040 "When using <<-, you can only indent with tabs." return () debugHereDoc pos endToken doc = if endToken `isInfixOf` doc then let lookAt line = when (endToken `isInfixOf` line) $ - parseProblemAt pos ErrorC ("Close matches include '" ++ line ++ "' (!= '" ++ endToken ++ "').") + parseProblemAt pos ErrorC 1041 ("Close matches include '" ++ line ++ "' (!= '" ++ endToken ++ "').") in do - parseProblemAt pos ErrorC ("Found '" ++ endToken ++ "' further down, but not entirely by itself.") + parseProblemAt pos ErrorC 1042 ("Found '" ++ endToken ++ "' further down, but not entirely by itself.") mapM_ lookAt (lines doc) else if (map toLower endToken) `isInfixOf` (map toLower doc) - then parseProblemAt pos ErrorC ("Found " ++ endToken ++ " further down, but with wrong casing.") - else parseProblemAt pos ErrorC ("Couldn't find end token `" ++ endToken ++ "' in the here document.") + then parseProblemAt pos ErrorC 1043 ("Found " ++ endToken ++ " further down, but with wrong casing.") + else parseProblemAt pos ErrorC 1044 ("Couldn't find end token `" ++ endToken ++ "' in the here document.") readFilename = readNormalWord @@ -1130,7 +1131,7 @@ readSeparatorOp = do spacing pos <- getPosition char ';' - parseProblemAt pos ErrorC "It's not 'foo &; bar', just 'foo & bar'." + parseProblemAt pos ErrorC 1045 "It's not 'foo &; bar', just 'foo & bar'." return '&' ) <|> char ';' <|> char '&' spacing @@ -1260,8 +1261,8 @@ readIfClause = called "if expression" $ do elses <- option [] readElsePart g_Fi `orFail` do - parseProblemAt pos ErrorC "Couldn't find 'fi' for this 'if'." - parseProblem ErrorC "Expected 'fi' matching previously mentioned 'if'." + parseProblemAt pos ErrorC 1046 "Couldn't find 'fi' for this 'if'." + parseProblem ErrorC 1047 "Expected 'fi' matching previously mentioned 'if'." return $ T_IfExpression id ((condition, action):elifs) elses @@ -1270,7 +1271,7 @@ verifyNotEmptyIf s = optional (do emptyPos <- getPosition try . lookAhead $ (g_Fi <|> g_Elif <|> g_Else) - parseProblemAt emptyPos ErrorC $ "Can't have empty " ++ s ++ " clauses (use 'true' as a no-op).") + parseProblemAt emptyPos ErrorC 1048 $ "Can't have empty " ++ s ++ " clauses (use 'true' as a no-op).") readIfPart = do pos <- getPosition g_If @@ -1279,12 +1280,12 @@ readIfPart = do optional (do try . lookAhead $ g_Fi - parseProblemAt pos ErrorC "Did you forget the 'then' for this 'if'?") + parseProblemAt pos ErrorC 1049 "Did you forget the 'then' for this 'if'?") called "then clause" $ do - g_Then `orFail` parseProblem ErrorC "Expected 'then'." + g_Then `orFail` parseProblem ErrorC 1050 "Expected 'then'." - acceptButWarn g_Semi ErrorC "No semicolons directly after 'then'." + acceptButWarn g_Semi ErrorC 1051 "No semicolons directly after 'then'." allspacing verifyNotEmptyIf "then" @@ -1297,7 +1298,7 @@ readElifPart = called "elif clause" $ do allspacing condition <- readTerm g_Then - acceptButWarn g_Semi ErrorC "No semicolons directly after 'then'." + acceptButWarn g_Semi ErrorC 1052 "No semicolons directly after 'then'." allspacing verifyNotEmptyIf "then" action <- readTerm @@ -1305,7 +1306,7 @@ readElifPart = called "elif clause" $ do readElsePart = called "else clause" $ do g_Else - acceptButWarn g_Semi ErrorC "No semicolons directly after 'else'." + acceptButWarn g_Semi ErrorC 1053 "No semicolons directly after 'else'." allspacing verifyNotEmptyIf "else" readTerm @@ -1325,14 +1326,14 @@ prop_readBraceGroup2 = isWarning readBraceGroup "{foo;}" readBraceGroup = called "brace group" $ do id <- getNextId char '{' - allspacingOrFail <|> parseProblem ErrorC "You need a space after the '{'." + allspacingOrFail <|> parseProblem ErrorC 1054 "You need a space after the '{'." optional $ do pos <- getPosition lookAhead $ char '}' - parseProblemAt pos ErrorC "You need at least one command here. Use 'true;' as a no-op." + parseProblemAt pos ErrorC 1055 "You need at least one command here. Use 'true;' as a no-op." list <- readTerm char '}' <|> do - parseProblem ErrorC "Expected a '}'. If you have one, try a ; or \\n in front of it." + parseProblem ErrorC 1056 "Expected a '}'. If you have one, try a ; or \\n in front of it." fail "Unable to parse" return $ T_BraceGroup id list @@ -1356,21 +1357,21 @@ readDoGroup loopPos = do pos <- getPosition optional (do try . lookAhead $ g_Done - parseProblemAt loopPos ErrorC "Did you forget the 'do' for this loop?") + parseProblemAt loopPos ErrorC 1057 "Did you forget the 'do' for this loop?") - g_Do `orFail` parseProblem ErrorC "Expected 'do'." + g_Do `orFail` parseProblem ErrorC 1058 "Expected 'do'." - acceptButWarn g_Semi ErrorC "No semicolons directly after 'do'." + acceptButWarn g_Semi ErrorC 1059 "No semicolons directly after 'do'." allspacing optional (do try . lookAhead $ g_Done - parseProblemAt loopPos ErrorC "Can't have empty do clauses (use 'true' as a no-op).") + parseProblemAt loopPos ErrorC 1060 "Can't have empty do clauses (use 'true' as a no-op).") commands <- readCompoundList g_Done `orFail` do - parseProblemAt pos ErrorC "Couldn't find 'done' for this 'do'." - parseProblem ErrorC "Expected 'done' matching previously mentioned 'do'." + parseProblemAt pos ErrorC 1061 "Couldn't find 'done' for this 'do'." + parseProblem ErrorC 1062 "Expected 'done' matching previously mentioned 'do'." return commands @@ -1431,7 +1432,7 @@ readInClause = do do { lookAhead (g_Do); - parseNote ErrorC "You need a line feed or semicolon before the 'do'."; + parseNote ErrorC 1063 "You need a line feed or semicolon before the 'do'."; } <|> do { optional $ g_Semi; disregard allspacing; @@ -1478,7 +1479,7 @@ readFunctionDefinition = called "function" $ do id <- getNextId name <- try readFunctionSignature allspacing - (disregard (lookAhead $ char '{') <|> parseProblem ErrorC "Expected a { to open the function definition.") + (disregard (lookAhead $ char '{') <|> parseProblem ErrorC 1064 "Expected a { to open the function definition.") group <- readBraceGroup return $ T_Function id name group @@ -1491,13 +1492,13 @@ readFunctionSignature = do try $ do string "function" whitespace - parseProblemAt pos InfoC "Drop the keyword 'function'. It's optional in Bash but invalid in other shells." + parseProblemAt pos InfoC 1005 "Drop the keyword 'function'. It's optional in Bash but invalid in other shells." spacing name <- readFunctionName optional spacing pos <- getPosition readParens <|> do - parseProblemAt pos InfoC "Include '()' after the function name (in addition to dropping 'function')." + parseProblemAt pos InfoC 1006 "Include '()' after the function name (in addition to dropping 'function')." return name readWithoutFunction = try $ do @@ -1510,7 +1511,7 @@ readFunctionSignature = do g_Lparen optional spacing g_Rparen <|> do - parseProblem ErrorC "Trying to declare parameters? Don't. Use () and refer to params as $1, $2.." + parseProblem ErrorC 1065 "Trying to declare parameters? Don't. Use () and refer to params as $1, $2.." anyChar `reluctantlyTill` oneOf "\n){" g_Rparen return () @@ -1530,7 +1531,7 @@ readCompoundCommand = do redirs <- many readIoRedirect when (not . null $ redirs) $ optional $ do lookAhead $ try (spacing >> needsSeparator) - parseProblem WarningC "Bash requires ; or \\n here, after redirecting nested compound commands." + parseProblem WarningC 1013 "Bash requires ; or \\n here, after redirecting nested compound commands." return $ T_Redirecting id redirs $ cmd where needsSeparator = choice [ g_Then, g_Else, g_Elif, g_Fi, g_Do, g_Done, g_Esac, g_Rbrace ] @@ -1555,10 +1556,10 @@ prop_readAssignmentWord0 = isWarning readAssignmentWord "foo$n=42" readAssignmentWord = try $ do id <- getNextId pos <- getPosition - optional (char '$' >> parseNote ErrorC "Don't use $ on the left side of assignments.") + optional (char '$' >> parseNote ErrorC 1066 "Don't use $ on the left side of assignments.") variable <- readVariableName optional (readNormalDollar >> parseNoteAt pos ErrorC - "For indirection, use (associative) arrays or 'read \"var$n\" <<< \"value\"'") + 1067 "For indirection, use (associative) arrays or 'read \"var$n\" <<< \"value\"'") index <- optionMaybe readArrayIndex space <- spacing pos <- getPosition @@ -1567,12 +1568,12 @@ readAssignmentWord = try $ do if space == "" && space2 /= "" then do when (variable /= "IFS") $ - parseNoteAt pos InfoC $ "Note that 'var= value' (with space after equals sign) is similar to 'var=\"\"; value'." + parseNoteAt pos InfoC 1007 $ "Note that 'var= value' (with space after equals sign) is similar to 'var=\"\"; value'." value <- readEmptyLiteral return $ T_Assignment id op variable index value else do when (space /= "" || space2 /= "") $ - parseNoteAt pos ErrorC "Don't put spaces around the = in assignments." + parseNoteAt pos ErrorC 1068 "Don't put spaces around the = in assignments." value <- readArray <|> readNormalWord spacing return $ T_Assignment id op variable index value @@ -1620,7 +1621,7 @@ tryParseWordToken parser t = try $ do parser optional (do try . lookAhead $ char '[' - parseProblem ErrorC "You need a space before the [.") + parseProblem ErrorC 1069 "You need a space before the [.") try $ lookAhead (keywordSeparator) return $ t id @@ -1674,10 +1675,6 @@ readKeyword = choice [ g_Then, g_Else, g_Elif, g_Fi, g_Do, g_Done, g_Esac, g_Rbr ifParse p t f = do (lookAhead (try p) >> t) <|> f -wtf = do - x <- many anyChar - parseProblem ErrorC x - readShebang = do try $ string "#!" str <- anyChar `reluctantlyTill` oneOf "\r\n" @@ -1699,10 +1696,10 @@ readScript = do do { allspacing; commands <- readTerm; - eof <|> (parseProblem ErrorC "Parsing stopped here because of parsing errors."); + eof <|> (parseProblem ErrorC 1070 "Parsing stopped here because of parsing errors."); return $ T_Script id sb commands; } <|> do { - parseProblem WarningC "Couldn't read any commands."; + parseProblem WarningC 1014 "Couldn't read any commands."; return $ T_Script id sb $ [T_EOF id]; } else do @@ -1723,8 +1720,8 @@ readScript = do verifyShell pos s = case isValidShell s of Just True -> return () - Just False -> parseProblemAt pos ErrorC "ShellCheck only supports Bourne based shell scripts, sorry!" - Nothing -> parseProblemAt pos InfoC "This shebang was unrecognized. Note that ShellCheck only handles Bourne based shells." + Just False -> parseProblemAt pos ErrorC 1071 "ShellCheck only supports Bourne based shell scripts, sorry!" + Nothing -> parseProblemAt pos InfoC 1008 "This shebang was unrecognized. Note that ShellCheck only handles Bourne based shells." isValidShell s = let good = s == "" || any (`isPrefixOf` s) goodShells @@ -1767,19 +1764,19 @@ parseWithNotes parser = do parseNotes <- getParseNotes return (item, map, nub . sortNotes $ parseNotes) -toParseNotes (Metadata pos list) = map (\(Note level note) -> ParseNote pos level note) list +toParseNotes (Metadata pos list) = map (\(Note level code note) -> ParseNote pos level code note) list notesFromMap map = Map.fold (\x -> (++) (toParseNotes x)) [] map getAllNotes result = (concatMap (notesFromMap . snd) (maybeToList . parseResult $ result)) ++ (parseNotes result) -compareNotes (ParseNote pos1 level1 s1) (ParseNote pos2 level2 s2) = compare (pos1, level1) (pos2, level2) +compareNotes (ParseNote pos1 level1 _ s1) (ParseNote pos2 level2 _ s2) = compare (pos1, level1) (pos2, level2) sortNotes = sortBy compareNotes data ParseResult = ParseResult { parseResult :: Maybe (Token, Map.Map Id Metadata), parseNotes :: [ParseNote] } deriving (Show) makeErrorFor parsecError = - ParseNote (errorPos parsecError) ErrorC $ getStringFromParsec $ errorMessages parsecError + ParseNote (errorPos parsecError) ErrorC 1072 $ getStringFromParsec $ errorMessages parsecError getStringFromParsec errors = case map snd $ sortWith fst $ map f errors of @@ -1801,9 +1798,9 @@ parseShell filename contents = do where notesForContext list = zipWith ($) [first, second] list - first (pos, str) = ParseNote pos ErrorC $ + first (pos, str) = ParseNote pos ErrorC 1073 $ "Couldn't parse this " ++ str ++ "." - second (pos, str) = ParseNote pos InfoC $ + second (pos, str) = ParseNote pos InfoC 1009 $ "The mentioned parser error was in this " ++ str ++ "." lt x = trace (show x) x diff --git a/ShellCheck/Simple.hs b/ShellCheck/Simple.hs index f09c6cf..7c7a5ff 100644 --- a/ShellCheck/Simple.hs +++ b/ShellCheck/Simple.hs @@ -34,10 +34,10 @@ shellCheck script = in map formatNote $ nub $ sortNotes allNotes -data ShellCheckComment = ShellCheckComment { scLine :: Int, scColumn :: Int, scSeverity :: String, scMessage :: String } +data ShellCheckComment = ShellCheckComment { scLine :: Int, scColumn :: Int, scSeverity :: String, scCode :: Int, scMessage :: String } instance Show ShellCheckComment where - show c = concat ["(", show $ scLine c, ",", show $ scColumn c, ") ", scSeverity c, ": ", scMessage c] + show c = concat ["(", show $ scLine c, ",", show $ scColumn c, ") ", scSeverity c, ": ", show (scCode c), " ", scMessage c] severityToString s = case s of @@ -46,4 +46,5 @@ severityToString s = InfoC -> "info" StyleC -> "style" -formatNote (ParseNote pos severity text) = ShellCheckComment (sourceLine pos) (sourceColumn pos) (severityToString severity) text +formatNote (ParseNote pos severity code text) = + ShellCheckComment (sourceLine pos) (sourceColumn pos) (severityToString severity) (fromIntegral code) text