diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 73449d7..3a7f7da 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -178,7 +178,7 @@ makeCommentWithFix severity id code str fix = withFix = comment { tcFix = Just fix } - in withFix `deepseq` withFix + in force withFix makeParameters spec = let params = Parameters { @@ -293,15 +293,15 @@ isQuoteFree = isQuoteFreeNode False isQuoteFreeNode strict tree t = - (isQuoteFreeElement t == Just True) || + isQuoteFreeElement t || headOrDefault False (mapMaybe isQuoteFreeContext (drop 1 $ getPath tree t)) where -- Is this node self-quoting in itself? isQuoteFreeElement t = case t of - T_Assignment {} -> return True - T_FdRedirect {} -> return True - _ -> Nothing + T_Assignment {} -> True + T_FdRedirect {} -> True + _ -> False -- Are any subnodes inherently self-quoting? isQuoteFreeContext t = @@ -354,8 +354,8 @@ getClosestCommand tree t = -- Like above, if koala_man knew Haskell when starting this project. getClosestCommandM t = do - tree <- asks parentMap - return $ getClosestCommand tree t + params <- ask + return $ getClosestCommand (parentMap params) t -- Is the token used as a command name (the first word in a T_SimpleCommand)? usedAsCommandName tree token = go (getId token) (tail $ getPath tree token) @@ -377,8 +377,8 @@ getPath tree t = t : -- Version of the above taking the map from the current context -- Todo: give this the name "getPath" getPathM t = do - map <- asks parentMap - return $ getPath map t + params <- ask + return $ getPath (parentMap params) t isParentOf tree parent child = elem (getId parent) . map getId $ getPath tree child @@ -388,14 +388,13 @@ parents params = getPath (parentMap params) -- Find the first match in a list where the predicate is Just True. -- Stops if it's Just False and ignores Nothing. findFirst :: (a -> Maybe Bool) -> [a] -> Maybe a -findFirst p l = - case l of - [] -> Nothing - (x:xs) -> - case p x of - Just True -> return x - Just False -> Nothing - Nothing -> findFirst p xs +findFirst p = foldr go Nothing + where + go x acc = + case p x of + Just True -> return x + Just False -> Nothing + Nothing -> acc -- Check whether a word is entirely output from a single command tokenIsJustCommandOutput t = case t of @@ -410,8 +409,7 @@ tokenIsJustCommandOutput t = case t of -- TODO: Replace this with a proper Control Flow Graph getVariableFlow params t = - let (_, stack) = runState (doStackAnalysis startScope endScope t) [] - in reverse stack + reverse $ execState (doStackAnalysis startScope endScope t) [] where startScope t = let scopeType = leadType params t @@ -462,28 +460,22 @@ leadType params t = causesSubshell = do (T_Pipeline _ _ list) <- parentPipeline - if length list <= 1 - then return False - else if not $ hasLastpipe params - then return True - else return . not $ (getId . head $ reverse list) == getId t + return $ case list of + _:_:_ -> not (hasLastpipe params) || getId (last list) /= getId t + _ -> False getModifiedVariables t = case t of T_SimpleCommand _ vars [] -> - concatMap (\x -> case x of - T_Assignment id _ name _ w -> - [(x, x, name, dataTypeFrom DataString w)] - _ -> [] - ) vars - c@T_SimpleCommand {} -> - getModifiedVariableCommand c + [(x, x, name, dataTypeFrom DataString w) | x@(T_Assignment id _ name _ w) <- vars] + T_SimpleCommand {} -> + getModifiedVariableCommand t TA_Unary _ "++|" v@(TA_Variable _ name _) -> [(t, v, name, DataString $ SourceFrom [v])] TA_Unary _ "|++" v@(TA_Variable _ name _) -> [(t, v, name, DataString $ SourceFrom [v])] - TA_Assignment _ op (TA_Variable _ name _) rhs -> maybeToList $ do + TA_Assignment _ op (TA_Variable _ name _) rhs -> do guard $ op `elem` ["=", "*=", "/=", "%=", "+=", "-=", "<<=", ">>=", "&=", "^=", "|="] return (t, t, name, DataString $ SourceFrom [rhs]) @@ -495,26 +487,26 @@ getModifiedVariables t = -- Count [[ -v foo ]] as an "assignment". -- This is to prevent [ -v foo ] being unassigned or unused. - TC_Unary id _ "-v" token -> maybeToList $ do + TC_Unary id _ "-v" token -> do str <- fmap (takeWhile (/= '[')) $ -- Quoted index flip getLiteralStringExt token $ \x -> case x of T_Glob _ s -> return s -- Unquoted index - _ -> Nothing + _ -> [] guard . not . null $ str return (t, token, str, DataString SourceChecked) - T_DollarBraced _ _ l -> maybeToList $ do + T_DollarBraced _ _ l -> do let string = bracedString t let modifier = getBracedModifier string guard $ any (`isPrefixOf` modifier) ["=", ":="] return (t, t, getBracedReference string, DataString $ SourceFrom [l]) - t@(T_FdRedirect _ ('{':var) op) -> -- {foo}>&2 modifies foo + T_FdRedirect _ ('{':var) op -> -- {foo}>&2 modifies foo [(t, t, takeWhile (/= '}') var, DataString SourceInteger) | not $ isClosingFileOp op] - t@(T_CoProc _ name _) -> + T_CoProc _ name _ -> [(t, t, fromMaybe "COPROC" name, DataArray SourceInteger)] --Points to 'for' rather than variable @@ -572,7 +564,7 @@ getModifiedVariableCommand base@(T_SimpleCommand id cmdPrefix (T_NormalWord _ (T let params = map getLiteral rest readArrayVars = getReadArrayVariables rest in - catMaybes . (++ readArrayVars) . takeWhile isJust . reverse $ params + catMaybes $ takeWhile isJust (reverse params) ++ readArrayVars "getopts" -> case rest of opts:var:_ -> maybeToList $ getLiteral var @@ -677,12 +669,10 @@ getModifiedVariableCommand base@(T_SimpleCommand id cmdPrefix (T_NormalWord _ (T map (getLiteralArray . snd) (filter (isArrayFlag . fst) (zip args (tail args))) - isArrayFlag x = fromMaybe False $ do - str <- getLiteralString x - return $ case str of - '-':'-':_ -> False - '-':str -> 'a' `elem` str - _ -> False + isArrayFlag x = case getLiteralString x of + Just ('-':'-':_) -> False + Just ('-':str) -> 'a' `elem` str + _ -> False -- get the FLAGS_ variable created by a shflags DEFINE_ call getFlagVariable (n:v:_) = do @@ -738,7 +728,7 @@ getReferencedVariables parents t = (t, t, "output") ] - t@(T_FdRedirect _ ('{':var) op) -> -- {foo}>&- references and closes foo + T_FdRedirect _ ('{':var) op -> -- {foo}>&- references and closes foo [(t, t, takeWhile (/= '}') var) | isClosingFileOp op] x -> getReferencedVariableCommand x where @@ -755,9 +745,9 @@ getReferencedVariables parents t = literalizer t = case t of T_Glob _ s -> return s -- Also when parsed as globs - _ -> Nothing + _ -> [] - getIfReference context token = maybeToList $ do + getIfReference context token = do str@(h:_) <- getLiteralStringExt literalizer token when (isDigit h) $ fail "is a number" return (context, token, getBracedReference str) @@ -808,7 +798,7 @@ getVariablesFromLiteralToken token = prop_getVariablesFromLiteral1 = getVariablesFromLiteral "$foo${bar//a/b}$BAZ" == ["foo", "bar", "BAZ"] getVariablesFromLiteral string = - map (!! 0) $ matchAllSubgroups variableRegex string + map head $ matchAllSubgroups variableRegex string where variableRegex = mkRegex "\\$\\{?([A-Za-z0-9_]+)" @@ -830,15 +820,14 @@ getBracedReference s = fromMaybe s $ nameExpansion s `mplus` takeName noPrefix `mplus` getSpecial noPrefix `mplus` getSpecial s where noPrefix = dropPrefix s - dropPrefix (c:rest) = if c `elem` "!#" then rest else c:rest - dropPrefix "" = "" + dropPrefix (c:rest) | c `elem` "!#" = rest + dropPrefix cs = cs takeName s = do let name = takeWhile isVariableChar s guard . not $ null name return name - getSpecial (c:_) = - if c `elem` "*@#?-$!" then return [c] else fail "not special" - getSpecial _ = fail "empty" + getSpecial (c:_) | c `elem` "*@#?-$!" = return [c] + getSpecial _ = fail "empty or not special" nameExpansion ('!':next:rest) = do -- e.g. ${!foo*bar*} guard $ isVariableChar next -- e.g. ${!@} @@ -876,8 +865,8 @@ headOrDefault def _ = def -- Run a command if the shell is in the given list whenShell l c = do - shell <- asks shellType - when (shell `elem` l ) c + params <- ask + when (shellType params `elem` l ) c filterByAnnotation asSpec params = @@ -929,22 +918,19 @@ getOpts string flags = process flags flagMap = Map.fromList $ ("", False) : flagList string process [] = return [] - process [(token, flag)] = do + process ((token1, flag):rest1) = do takesArg <- Map.lookup flag flagMap - guard $ not takesArg - return [(flag, token)] - process ((token1, flag1):rest2@((token2, flag2):rest)) = do - takesArg <- Map.lookup flag1 flagMap - if takesArg - then do - guard $ null flag2 - more <- process rest - return $ (flag1, token2) : more - else do - more <- process rest2 - return $ (flag1, token1) : more + (token, rest) <- if takesArg + then case rest1 of + (token2, ""):rest2 -> return (token2, rest2) + _ -> fail "takesArg without valid arg" + else return (token1, rest1) + more <- process rest + return $ (flag, token) : more -supportsArrays shell = shell == Bash || shell == Ksh +supportsArrays Bash = True +supportsArrays Ksh = True +supportsArrays _ = False -- Returns true if the shell is Bash or Ksh (sorry for the name, Ksh) isBashLike :: Parameters -> Bool