Merge pull request #1900 from josephcsible/analyzerlib
Clean up AnalyzerLib
This commit is contained in:
commit
1eac0d7340
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue