Merge pull request #2119 from josephcsible/refactors

Various refactorings
This commit is contained in:
Vidar Holen 2021-02-02 18:14:27 -08:00 committed by GitHub
commit 15ff87cf80
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 28 additions and 35 deletions

View File

@ -507,7 +507,7 @@ ioInterface options files = do
where where
find filename deflt = do find filename deflt = do
sources <- findM ((allowable inputs) `andM` doesFileExist) $ sources <- findM ((allowable inputs) `andM` doesFileExist) $
(adjustPath filename):(map (</> filename) $ map adjustPath $ sourcePathFlag ++ sourcePathAnnotation) (adjustPath filename):(map ((</> filename) . adjustPath) $ sourcePathFlag ++ sourcePathAnnotation)
case sources of case sources of
Nothing -> return deflt Nothing -> return deflt
Just first -> return first Just first -> return first

View File

@ -178,7 +178,7 @@ getOpts (gnu, arbitraryLongOpts) string longopts args = process args
process [] = return [] process [] = return []
process (token:rest) = do process (token:rest) = do
case getLiteralStringDef "\0" token of case getLiteralStringDef "\0" token of
'-':'-':[] -> return $ listToArgs rest "--" -> return $ listToArgs rest
'-':'-':word -> do '-':'-':word -> do
let (name, arg) = span (/= '=') word let (name, arg) = span (/= '=') word
needsArg <- needsArg <-
@ -466,7 +466,7 @@ getCommandNameAndToken direct t = fromMaybe (Nothing, t) $ do
"run" -> firstArg -- Used by bats "run" -> firstArg -- Used by bats
"exec" -> do "exec" -> do
opts <- getBsdOpts "cla:" args opts <- getBsdOpts "cla:" args
(_, (t, _)) <- listToMaybe $ filter (null . fst) opts (_, (t, _)) <- find (null . fst) opts
return t return t
_ -> fail "" _ -> fail ""

View File

@ -417,7 +417,7 @@ prop_checkAssignAteCommand4 = verifyNot checkAssignAteCommand "A=foo ls -l"
prop_checkAssignAteCommand5 = verify checkAssignAteCommand "PAGER=cat grep bar" prop_checkAssignAteCommand5 = verify checkAssignAteCommand "PAGER=cat grep bar"
prop_checkAssignAteCommand6 = verifyNot checkAssignAteCommand "PAGER=\"cat\" grep bar" prop_checkAssignAteCommand6 = verifyNot checkAssignAteCommand "PAGER=\"cat\" grep bar"
prop_checkAssignAteCommand7 = verify checkAssignAteCommand "here=pwd" prop_checkAssignAteCommand7 = verify checkAssignAteCommand "here=pwd"
checkAssignAteCommand _ (T_SimpleCommand id (T_Assignment _ _ _ _ assignmentTerm:[]) list) = checkAssignAteCommand _ (T_SimpleCommand id [T_Assignment _ _ _ _ assignmentTerm] list) =
-- Check if first word is intended as an argument (flag or glob). -- Check if first word is intended as an argument (flag or glob).
if firstWordIsArg list if firstWordIsArg list
then then
@ -449,7 +449,7 @@ checkArithmeticOpCommand _ _ = return ()
prop_checkWrongArit = verify checkWrongArithmeticAssignment "i=i+1" prop_checkWrongArit = verify checkWrongArithmeticAssignment "i=i+1"
prop_checkWrongArit2 = verify checkWrongArithmeticAssignment "n=2; i=n*2" prop_checkWrongArit2 = verify checkWrongArithmeticAssignment "n=2; i=n*2"
checkWrongArithmeticAssignment params (T_SimpleCommand id (T_Assignment _ _ _ _ val:[]) []) = checkWrongArithmeticAssignment params (T_SimpleCommand id [T_Assignment _ _ _ _ val] []) =
sequence_ $ do sequence_ $ do
str <- getNormalString val str <- getNormalString val
match <- matchRegex regex str match <- matchRegex regex str
@ -2518,7 +2518,7 @@ checkCharRangeGlob p t@(T_Glob id str) |
where where
isCharClass str = "[" `isPrefixOf` str && "]" `isSuffixOf` str isCharClass str = "[" `isPrefixOf` str && "]" `isSuffixOf` str
contents = dropNegation . drop 1 . take (length str - 1) $ str contents = dropNegation . drop 1 . take (length str - 1) $ str
hasDupes = any (>1) . map length . group . sort . filter (/= '-') $ contents hasDupes = any ((>1) . length) . group . sort . filter (/= '-') $ contents
dropNegation s = dropNegation s =
case s of case s of
'!':rest -> rest '!':rest -> rest
@ -2881,7 +2881,7 @@ checkTestArgumentSplitting params t =
then then
-- Ksh appears to stop processing after unrecognized tokens, so operators -- Ksh appears to stop processing after unrecognized tokens, so operators
-- will effectively work with globs, but only the first match. -- will effectively work with globs, but only the first match.
when (op `elem` ['-':c:[] | c <- "bcdfgkprsuwxLhNOGRS" ]) $ when (op `elem` [['-', c] | c <- "bcdfgkprsuwxLhNOGRS" ]) $
warn (getId token) 2245 $ warn (getId token) 2245 $
op ++ " only applies to the first expansion of this glob. Use a loop to check any/all." op ++ " only applies to the first expansion of this glob. Use a loop to check any/all."
else else
@ -3408,7 +3408,7 @@ checkPipeToNowhere params t =
sequence_ $ do sequence_ $ do
T_Redirecting _ redirs cmd <- return stage T_Redirecting _ redirs cmd <- return stage
fds <- sequence $ map getRedirectionFds redirs fds <- mapM getRedirectionFds redirs
let fdAndToken :: [(Integer, Token)] let fdAndToken :: [(Integer, Token)]
fdAndToken = fdAndToken =
@ -3441,7 +3441,7 @@ checkPipeToNowhere params t =
commandSpecificException name cmd = commandSpecificException name cmd =
case name of case name of
"du" -> any (`elem` ["exclude-from", "files0-from"]) $ map snd $ getAllFlags cmd "du" -> any ((`elem` ["exclude-from", "files0-from"]) . snd) $ getAllFlags cmd
_ -> False _ -> False
warnAboutDupes (n, list@(_:_:_)) = warnAboutDupes (n, list@(_:_:_)) =
@ -3845,7 +3845,7 @@ checkAliasUsedInSameParsingUnit params root =
-- Group them by whether they start on the same line where the previous one ended -- Group them by whether they start on the same line where the previous one ended
units = groupByLink followsOnLine commands units = groupByLink followsOnLine commands
in in
execWriter $ sequence_ $ map checkUnit units execWriter $ mapM_ checkUnit units
where where
lineSpan t = lineSpan t =
let m = tokenPositions params in do let m = tokenPositions params in do
@ -3895,13 +3895,13 @@ groupByLink :: (a -> a -> Bool) -> [a] -> [[a]]
groupByLink f list = groupByLink f list =
case list of case list of
[] -> [] [] -> []
(x:xs) -> g x [] xs (x:xs) -> foldr c n xs x []
where where
g current span (next:rest) = c next rest current span =
if f current next if f current next
then g next (current:span) rest then rest next (current:span)
else (reverse $ current:span) : g next [] rest else (reverse $ current:span) : rest next []
g current span [] = [reverse (current:span)] n current span = [reverse (current:span)]
prop_checkBlatantRecursion1 = verify checkBlatantRecursion ":(){ :|:& };:" prop_checkBlatantRecursion1 = verify checkBlatantRecursion ":(){ :|:& };:"

View File

@ -258,9 +258,9 @@ determineShell fallbackShell t = fromMaybe Bash $
executableFromShebang :: String -> String executableFromShebang :: String -> String
executableFromShebang = shellFor executableFromShebang = shellFor
where where
shellFor s | "/env " `isInfixOf` s = fromMaybe "" $ do shellFor s | "/env " `isInfixOf` s = case matchRegex re s of
[flag, shell] <- matchRegex re s Just [flag, shell] -> shell
return shell _ -> ""
shellFor s | ' ' `elem` s = shellFor $ takeWhile (/= ' ') s shellFor s | ' ' `elem` s = shellFor $ takeWhile (/= ' ') s
shellFor s = reverse . takeWhile (/= '/') . reverse $ s shellFor s = reverse . takeWhile (/= '/') . reverse $ s
re = mkRegex "/env +(-S|--split-string=?)? *([^ ]*)" re = mkRegex "/env +(-S|--split-string=?)? *([^ ]*)"
@ -270,7 +270,7 @@ executableFromShebang = shellFor
-- This is used to populate parentMap in Parameters -- This is used to populate parentMap in Parameters
getParentTree :: Token -> Map.Map Id Token getParentTree :: Token -> Map.Map Id Token
getParentTree t = getParentTree t =
snd . snd $ runState (doStackAnalysis pre post t) ([], Map.empty) snd $ execState (doStackAnalysis pre post t) ([], Map.empty)
where where
pre t = modify (first ((:) t)) pre t = modify (first ((:) t))
post t = do post t = do
@ -687,12 +687,10 @@ getModifiedVariableCommand base@(T_SimpleCommand id cmdPrefix (T_NormalWord _ (T
parseArgs :: Maybe (Token, Token, String, DataType) parseArgs :: Maybe (Token, Token, String, DataType)
parseArgs = do parseArgs = do
args <- getGnuOpts "d:n:O:s:u:C:c:t" rest args <- getGnuOpts "d:n:O:s:u:C:c:t" rest
let names = map snd $ filter (\(x,y) -> null x) args case [y | ("",(_,y)) <- args] of
if null names [] ->
then
return (base, base, "MAPFILE", DataArray SourceExternal) return (base, base, "MAPFILE", DataArray SourceExternal)
else do first:_ -> do
(_, first) <- listToMaybe names
name <- getLiteralString first name <- getLiteralString first
guard $ isVariableName name guard $ isVariableName name
return (base, first, name, DataArray SourceExternal) return (base, first, name, DataArray SourceExternal)

View File

@ -122,7 +122,7 @@ checkGetOpts str flags args f =
toTokens = map (T_Literal (Id 0)) . words toTokens = map (T_Literal (Id 0)) . words
opts = fromMaybe [] $ f (toTokens str) opts = fromMaybe [] $ f (toTokens str)
actualFlags = filter (not . null) $ map fst opts actualFlags = filter (not . null) $ map fst opts
actualArgs = map (\(_, (_, x)) -> onlyLiteralString x) $ filter (null . fst) opts actualArgs = [onlyLiteralString x | ("", (_, x)) <- opts]
-- Short options -- Short options
prop_checkGetOptsS1 = checkGetOpts "-f x" ["f"] [] $ getOpts (True, True) "f:" [] prop_checkGetOptsS1 = checkGetOpts "-f x" ["f"] [] $ getOpts (True, True) "f:" []
@ -916,7 +916,7 @@ checkWhileGetoptsCase = CommandCheck (Exactly "getopts") f
fromGlob t = fromGlob t =
case t of case t of
T_Glob _ ('[':c:']':[]) -> return [c] T_Glob _ ['[', c, ']'] -> return [c]
T_Glob _ "*" -> return "*" T_Glob _ "*" -> return "*"
T_Glob _ "?" -> return "?" T_Glob _ "?" -> return "?"
_ -> Nothing _ -> Nothing
@ -951,7 +951,7 @@ checkCatastrophicRm = CommandCheck (Basename "rm") $ \t ->
when (isRecursive t) $ when (isRecursive t) $
mapM_ (mapM_ checkWord . braceExpand) $ arguments t mapM_ (mapM_ checkWord . braceExpand) $ arguments t
where where
isRecursive = any (`elem` ["r", "R", "recursive"]) . map snd . getAllFlags isRecursive = any ((`elem` ["r", "R", "recursive"]) . snd) . getAllFlags
checkWord token = checkWord token =
case getLiteralString token of case getLiteralString token of

View File

@ -211,8 +211,7 @@ startSpan = IncompleteInterval <$> getPosition
endSpan (IncompleteInterval start) = do endSpan (IncompleteInterval start) = do
endPos <- getPosition endPos <- getPosition
id <- getNextIdBetween start endPos getNextIdBetween start endPos
return id
getSpanPositionsFor m = do getSpanPositionsFor m = do
start <- getPosition start <- getPosition
@ -394,7 +393,7 @@ unexpecting s p = try $
notFollowedBy2 = unexpecting "" notFollowedBy2 = unexpecting ""
isFollowedBy p = (lookAhead . try $ p *> return True) <|> return False isFollowedBy p = (lookAhead . try $ p $> True) <|> return False
reluctantlyTill p end = reluctantlyTill p end =
(lookAhead (void (try end) <|> eof) >> return []) <|> do (lookAhead (void (try end) <|> eof) >> return []) <|> do
@ -2095,10 +2094,6 @@ readSimpleCommand = called "simple command" $ do
then action then action
else getParser def cmd rest else getParser def cmd rest
cStyleComment cmd =
case cmd of
_ -> False
validateCommand cmd = validateCommand cmd =
case cmd of case cmd of
(T_NormalWord _ [T_Literal _ "//"]) -> commentWarning (getId cmd) (T_NormalWord _ [T_Literal _ "//"]) -> commentWarning (getId cmd)
@ -2721,7 +2716,7 @@ readConditionCommand = do
pos <- getPosition pos <- getPosition
hasDashAo <- isFollowedBy $ do hasDashAo <- isFollowedBy $ do
c <- choice $ map (\s -> try $ string s) ["-o", "-a", "or", "and"] c <- choice $ try . string <$> ["-o", "-a", "or", "and"]
posEnd <- getPosition posEnd <- getPosition
parseProblemAtWithEnd pos posEnd ErrorC 1139 $ parseProblemAtWithEnd pos posEnd ErrorC 1139 $
"Use " ++ alt c ++ " instead of '" ++ c ++ "' between test commands." "Use " ++ alt c ++ " instead of '" ++ c ++ "' between test commands."