Merge pull request #1900 from josephcsible/analyzerlib

Clean up AnalyzerLib
This commit is contained in:
Vidar Holen 2020-04-11 16:21:20 -07:00 committed by GitHub
commit 1eac0d7340
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 55 additions and 69 deletions

View File

@ -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) ->
findFirst p = foldr go Nothing
where
go x acc =
case p x of
Just True -> return x
Just False -> Nothing
Nothing -> findFirst p xs
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,11 +669,9 @@ 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
isArrayFlag x = case getLiteralString x of
Just ('-':'-':_) -> False
Just ('-':str) -> 'a' `elem` str
_ -> False
-- get the FLAGS_ variable created by a shflags DEFINE_ call
@ -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
(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 $ (flag1, token2) : more
else do
more <- process rest2
return $ (flag1, token1) : more
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