From 7e6a556ef155bb50f554235b93097928145dc74e Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 9 Feb 2020 20:10:09 -0500 Subject: [PATCH] Get rid of potentially This already exists as sequence_. --- src/ShellCheck/Analytics.hs | 38 +++++++++++++-------------- src/ShellCheck/AnalyzerLib.hs | 9 ------- src/ShellCheck/Checks/Commands.hs | 18 ++++++------- src/ShellCheck/Checks/ShellSupport.hs | 8 +++--- 4 files changed, 32 insertions(+), 41 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 91345ed..4100b2d 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1209,7 +1209,7 @@ prop_checkLiteralBreakingTest6 = verify checkLiteralBreakingTest "[ -z $(true)z prop_checkLiteralBreakingTest7 = verifyNot checkLiteralBreakingTest "[ -z $(true) ]" prop_checkLiteralBreakingTest8 = verifyNot checkLiteralBreakingTest "[ $(true)$(true) ]" prop_checkLiteralBreakingTest10 = verify checkLiteralBreakingTest "[ -z foo ]" -checkLiteralBreakingTest _ t = potentially $ +checkLiteralBreakingTest _ t = sequence_ $ case t of (TC_Nullary _ _ w@(T_NormalWord _ l)) -> do guard . not $ isConstant w -- Covered by SC2078 @@ -1257,7 +1257,7 @@ checkConstantNullary _ _ = return () prop_checkForDecimals1 = verify checkForDecimals "((3.14*c))" prop_checkForDecimals2 = verify checkForDecimals "foo[1.2]=bar" prop_checkForDecimals3 = verifyNot checkForDecimals "declare -A foo; foo[1.2]=bar" -checkForDecimals params t@(TA_Expansion id _) = potentially $ do +checkForDecimals params t@(TA_Expansion id _) = sequence_ $ do guard $ not (hasFloatingPoint params) str <- getLiteralString t first <- str !!! 0 @@ -1310,7 +1310,7 @@ checkArithmeticDeref _ _ = return () prop_checkArithmeticBadOctal1 = verify checkArithmeticBadOctal "(( 0192 ))" prop_checkArithmeticBadOctal2 = verifyNot checkArithmeticBadOctal "(( 0x192 ))" prop_checkArithmeticBadOctal3 = verifyNot checkArithmeticBadOctal "(( 1 ^ 0777 ))" -checkArithmeticBadOctal _ t@(TA_Expansion id _) = potentially $ do +checkArithmeticBadOctal _ t@(TA_Expansion id _) = sequence_ $ do str <- getLiteralString t guard $ str `matches` octalRE return $ err id 2080 "Numbers with leading 0 are considered octal." @@ -1392,7 +1392,7 @@ checkOrNeq _ (TA_Binary id "||" (TA_Binary _ "!=" word1 _) (TA_Binary _ "!=" wor warn id 2056 "You probably wanted && here, otherwise it's always true." -- For command level "or": [ x != y ] || [ x != z ] -checkOrNeq _ (T_OrIf id lhs rhs) = potentially $ do +checkOrNeq _ (T_OrIf id lhs rhs) = sequence_ $ do (lhs1, op1, rhs1) <- getExpr lhs (lhs2, op2, rhs2) <- getExpr rhs guard $ op1 == op2 && op1 `elem` ["-ne", "!="] @@ -1407,7 +1407,7 @@ checkOrNeq _ (T_OrIf id lhs rhs) = potentially $ do T_Redirecting _ _ c -> getExpr c T_Condition _ _ c -> getExpr c TC_Binary _ _ op lhs rhs -> return (lhs, op, rhs) - _ -> fail "" + _ -> Nothing checkOrNeq _ _ = return () @@ -2068,7 +2068,7 @@ checkFunctionsUsedExternally params t = in when ('=' `elem` string) $ modify ((takeWhile (/= '=') string, getId arg):) - checkArg cmd (_, arg) = potentially $ do + checkArg cmd (_, arg) = sequence_ $ do literalArg <- getUnquotedLiteral arg -- only consider unquoted literals definitionId <- Map.lookup literalArg functions return $ do @@ -2312,7 +2312,7 @@ checkWhileReadPitfalls _ (T_WhileExpression id [command] contents) (T_IfExpression _ thens elses) -> mapM_ checkMuncher . concat $ map fst thens ++ map snd thens ++ [elses] - _ -> potentially $ do + _ -> sequence_ $ do name <- getCommandBasename cmd guard $ name `elem` munchers @@ -2410,7 +2410,7 @@ checkCdAndBack params t = else findCdPair (b:rest) _ -> Nothing - doList list = potentially $ do + doList list = sequence_ $ do cd <- findCdPair $ mapMaybe getCandidate list return $ info cd 2103 "Use a ( subshell ) to avoid having to cd back." @@ -2673,7 +2673,7 @@ prop_checkGrepQ4= verifyNot checkShouldUseGrepQ "[ -z $(grep bar | cmd) ]" prop_checkGrepQ5= verifyNot checkShouldUseGrepQ "rm $(ls | grep file)" prop_checkGrepQ6= verifyNot checkShouldUseGrepQ "[[ -n $(pgrep foo) ]]" checkShouldUseGrepQ params t = - potentially $ case t of + sequence_ $ case t of TC_Nullary id _ token -> check id True token TC_Unary id _ "-n" token -> check id True token TC_Unary id _ "-z" token -> check id False token @@ -2807,7 +2807,7 @@ prop_checkMaskedReturns2 = verify checkMaskedReturns "declare a=$(false)" prop_checkMaskedReturns3 = verify checkMaskedReturns "declare a=\"`false`\"" prop_checkMaskedReturns4 = verifyNot checkMaskedReturns "declare a; a=$(false)" prop_checkMaskedReturns5 = verifyNot checkMaskedReturns "f() { local -r a=$(false); }" -checkMaskedReturns _ t@(T_SimpleCommand id _ (cmd:rest)) = potentially $ do +checkMaskedReturns _ t@(T_SimpleCommand id _ (cmd:rest)) = sequence_ $ do name <- getCommandName t guard $ name `elem` ["declare", "export"] || name == "local" && "r" `notElem` map snd (getAllFlags t) @@ -2900,7 +2900,7 @@ prop_checkLoopVariableReassignment1 = verify checkLoopVariableReassignment "for prop_checkLoopVariableReassignment2 = verify checkLoopVariableReassignment "for i in *; do for((i=0; i<3; i++)); do true; done; done" prop_checkLoopVariableReassignment3 = verifyNot checkLoopVariableReassignment "for i in *; do for j in *.bar; do true; done; done" checkLoopVariableReassignment params token = - potentially $ case token of + sequence_ $ case token of T_ForIn {} -> check T_ForArithmetic {} -> check _ -> Nothing @@ -2988,12 +2988,12 @@ prop_checkRedirectedNowhere7 = verifyNot checkRedirectedNowhere "var=$(< file)" prop_checkRedirectedNowhere8 = verifyNot checkRedirectedNowhere "var=`< file`" checkRedirectedNowhere params token = case token of - T_Pipeline _ _ [single] -> potentially $ do + T_Pipeline _ _ [single] -> sequence_ $ do redir <- getDanglingRedirect single guard . not $ isInExpansion token return $ warn (getId redir) 2188 "This redirection doesn't have a command. Move to its command (or use 'true' as no-op)." - T_Pipeline _ _ list -> forM_ list $ \x -> potentially $ do + T_Pipeline _ _ list -> forM_ list $ \x -> sequence_ $ do redir <- getDanglingRedirect x return $ err (getId redir) 2189 "You can't have | between this redirection and the command it should apply to." @@ -3080,7 +3080,7 @@ checkUnmatchableCases params t = if isConstant word then warn (getId word) 2194 "This word is constant. Did you forget the $ on a variable?" - else potentially $ do + else sequence_ $ do pg <- wordToPseudoGlob word return $ mapM_ (check pg) allpatterns @@ -3095,7 +3095,7 @@ checkUnmatchableCases params t = fst3 (x,_,_) = x snd3 (_,x,_) = x tp = tokenPositions params - check target candidate = potentially $ do + check target candidate = sequence_ $ do candidateGlob <- wordToPseudoGlob candidate guard . not $ pseudoGlobsCanOverlap target candidateGlob return $ warn (getId candidate) 2195 @@ -3189,7 +3189,7 @@ prop_checkRedirectionToNumber2 = verify checkRedirectionToNumber "foo 1>2" prop_checkRedirectionToNumber3 = verifyNot checkRedirectionToNumber "echo foo > '2'" prop_checkRedirectionToNumber4 = verifyNot checkRedirectionToNumber "foo 1>&2" checkRedirectionToNumber _ t = case t of - T_IoFile id _ word -> potentially $ do + T_IoFile id _ word -> sequence_ $ do file <- getUnquotedLiteral word guard $ all isDigit file return $ warn id 2210 "This is a file redirection. Was it supposed to be a comparison or fd operation?" @@ -3238,7 +3238,7 @@ checkPipeToNowhere _ t = T_Redirecting _ redirects cmd -> when (any redirectsStdin redirects) $ checkRedir cmd _ -> return () where - checkPipe redir = potentially $ do + checkPipe redir = sequence_ $ do cmd <- getCommand redir name <- getCommandBasename cmd guard $ name `elem` nonReadingCommands @@ -3251,7 +3251,7 @@ checkPipeToNowhere _ t = return $ warn (getId cmd) 2216 $ "Piping to '" ++ name ++ "', a command that doesn't read stdin. " ++ suggestion - checkRedir cmd = potentially $ do + checkRedir cmd = sequence_ $ do name <- getCommandBasename cmd guard $ name `elem` nonReadingCommands guard . not $ hasAdditionalConsumers cmd @@ -3299,7 +3299,7 @@ checkUseBeforeDefinition _ t = mapM_ (checkUsage m) $ concatMap recursiveSequences cmds _ -> return () - checkUsage map cmd = potentially $ do + checkUsage map cmd = sequence_ $ do name <- getCommandName cmd def <- Map.lookup name map return $ diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index e4640e7..69eaf63 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -870,15 +870,6 @@ getBracedModifier s = fromMaybe "" . listToMaybe $ do -- Useful generic functions. --- Run an action in a Maybe (or do nothing). --- Example: --- potentially $ do --- s <- getLiteralString cmd --- guard $ s `elem` ["--recursive", "-r"] --- return $ warn .. "Something something recursive" -potentially :: Monad m => Maybe (m ()) -> m () -potentially = fromMaybe (return ()) - -- Get element 0 or a default. Like `head` but safe. headOrDefault _ (a:_) = a headOrDefault def _ = def diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 4842341..97de0f6 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -270,7 +270,7 @@ checkGrepRe = CommandCheck (Basename "grep") check where let string = concat $ oversimplify re if isConfusedGlobRegex string then warn (getId re) 2063 "Grep uses regex, but this looks like a glob." - else potentially $ do + else sequence_ $ do char <- getSuspiciousRegexWildcard string return $ info (getId re) 2022 $ "Note that unlike globs, " ++ [char] ++ "* here matches '" ++ [char, char, char] ++ "' but not '" ++ wordStartingWith char ++ "'." @@ -461,7 +461,7 @@ prop_checkMkdirDashPM20 = verifyNot checkMkdirDashPM "mkdir -p -m 0755 .././bin" prop_checkMkdirDashPM21 = verifyNot checkMkdirDashPM "mkdir -p -m 0755 ../../bin" checkMkdirDashPM = CommandCheck (Basename "mkdir") check where - check t = potentially $ do + check t = sequence_ $ do let flags = getAllFlags t dashP <- find ((\f -> f == "p" || f == "parents") . snd) flags dashM <- find ((\f -> f == "m" || f == "mode") . snd) flags @@ -487,7 +487,7 @@ checkNonportableSignals = CommandCheck (Exactly "trap") (f . arguments) first:rest -> unless (isFlag first) $ mapM_ check rest _ -> return () - check param = potentially $ do + check param = sequence_ $ do str <- getLiteralString param let id = getId param return $ sequence_ $ mapMaybe (\f -> f id str) [ @@ -687,7 +687,7 @@ prop_checkExportedExpansions3 = verifyNot checkExportedExpansions "export foo" prop_checkExportedExpansions4 = verifyNot checkExportedExpansions "export ${foo?}" checkExportedExpansions = CommandCheck (Exactly "export") (mapM_ check . arguments) where - check t = potentially $ do + check t = sequence_ $ do var <- getSingleUnmodifiedVariable t let name = bracedString var return . warn (getId t) 2163 $ @@ -709,7 +709,7 @@ checkReadExpansions = CommandCheck (Exactly "read") check return [y | (x,y) <- opts, null x || x == "a"] check cmd = mapM_ warning $ getVars cmd - warning t = potentially $ do + warning t = sequence_ $ do var <- getSingleUnmodifiedVariable t let name = bracedString var guard $ isVariableName name -- e.g. not $1 @@ -859,7 +859,7 @@ checkWhileGetoptsCase = CommandCheck (Exactly "getopts") f f :: Token -> Analysis f t@(T_SimpleCommand _ _ (cmd:arg1:_)) = do path <- getPathM t - potentially $ do + sequence_ $ do options <- getLiteralString arg1 (T_WhileExpression _ _ body) <- findFirst whileLoop path caseCmd <- mapMaybe findCase body !!! 0 @@ -886,7 +886,7 @@ checkWhileGetoptsCase = CommandCheck (Exactly "getopts") f warnUnhandled optId caseId str = warn caseId 2213 $ "getopts specified -" ++ str ++ ", but it's not handled by this 'case'." - warnRedundant (key, expr) = potentially $ do + warnRedundant (key, expr) = sequence_ $ do str <- key guard $ str `notElem` ["*", ":", "?"] return $ warn (getId expr) 2214 "This case is not specified by getopts." @@ -1081,7 +1081,7 @@ prop_checkSudoArgs6 = verifyNot checkSudoArgs "sudo -n -u export ls" prop_checkSudoArgs7 = verifyNot checkSudoArgs "sudo docker export foo" checkSudoArgs = CommandCheck (Basename "sudo") f where - f t = potentially $ do + f t = sequence_ $ do opts <- parseOpts t let nonFlags = [x | ("",x) <- opts] commandArg <- nonFlags !!! 0 @@ -1109,7 +1109,7 @@ prop_checkChmodDashr3 = verifyNot checkChmodDashr "chmod a-r dir" checkChmodDashr = CommandCheck (Basename "chmod") f where f t = mapM_ check $ arguments t - check t = potentially $ do + check t = sequence_ $ do flag <- getLiteralString t guard $ flag == "-r" return $ warn (getId t) 2253 "Use -R to recurse, or explicitly a-r to remove read permissions." diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index b643525..4e0655d 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -73,7 +73,7 @@ prop_checkForDecimals2 = verify checkForDecimals "foo[1.2]=bar" prop_checkForDecimals3 = verifyNot checkForDecimals "declare -A foo; foo[1.2]=bar" checkForDecimals = ForShell [Sh, Dash, Bash] f where - f t@(TA_Expansion id _) = potentially $ do + f t@(TA_Expansion id _) = sequence_ $ do str <- getLiteralString t first <- str !!! 0 guard $ isDigit first && '.' `elem` str @@ -337,7 +337,7 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do in do when (name `elem` unsupportedCommands) $ warnMsg id $ "'" ++ name ++ "' is" - potentially $ do + sequence_ $ do allowed' <- Map.lookup name allowedFlags allowed <- allowed' (word, flag) <- find @@ -347,7 +347,7 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do when (name == "source") $ warnMsg id "'source' in place of '.' is" when (name == "trap") $ let - check token = potentially $ do + check token = sequence_ $ do str <- getLiteralString token let upper = map toUpper str return $ do @@ -362,7 +362,7 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do in mapM_ check (drop 1 rest) - when (name == "printf") $ potentially $ do + when (name == "printf") $ sequence_ $ do format <- rest !!! 0 -- flags are covered by allowedFlags let literal = onlyLiteralString format guard $ "%q" `isInfixOf` literal