Merge pull request #2119 from josephcsible/refactors
Various refactorings
This commit is contained in:
commit
15ff87cf80
|
@ -507,7 +507,7 @@ ioInterface options files = do
|
|||
where
|
||||
find filename deflt = do
|
||||
sources <- findM ((allowable inputs) `andM` doesFileExist) $
|
||||
(adjustPath filename):(map (</> filename) $ map adjustPath $ sourcePathFlag ++ sourcePathAnnotation)
|
||||
(adjustPath filename):(map ((</> filename) . adjustPath) $ sourcePathFlag ++ sourcePathAnnotation)
|
||||
case sources of
|
||||
Nothing -> return deflt
|
||||
Just first -> return first
|
||||
|
|
|
@ -178,7 +178,7 @@ getOpts (gnu, arbitraryLongOpts) string longopts args = process args
|
|||
process [] = return []
|
||||
process (token:rest) = do
|
||||
case getLiteralStringDef "\0" token of
|
||||
'-':'-':[] -> return $ listToArgs rest
|
||||
"--" -> return $ listToArgs rest
|
||||
'-':'-':word -> do
|
||||
let (name, arg) = span (/= '=') word
|
||||
needsArg <-
|
||||
|
@ -466,7 +466,7 @@ getCommandNameAndToken direct t = fromMaybe (Nothing, t) $ do
|
|||
"run" -> firstArg -- Used by bats
|
||||
"exec" -> do
|
||||
opts <- getBsdOpts "cla:" args
|
||||
(_, (t, _)) <- listToMaybe $ filter (null . fst) opts
|
||||
(_, (t, _)) <- find (null . fst) opts
|
||||
return t
|
||||
_ -> fail ""
|
||||
|
||||
|
|
|
@ -417,7 +417,7 @@ prop_checkAssignAteCommand4 = verifyNot checkAssignAteCommand "A=foo ls -l"
|
|||
prop_checkAssignAteCommand5 = verify checkAssignAteCommand "PAGER=cat grep bar"
|
||||
prop_checkAssignAteCommand6 = verifyNot checkAssignAteCommand "PAGER=\"cat\" grep bar"
|
||||
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).
|
||||
if firstWordIsArg list
|
||||
then
|
||||
|
@ -449,7 +449,7 @@ checkArithmeticOpCommand _ _ = return ()
|
|||
|
||||
prop_checkWrongArit = verify checkWrongArithmeticAssignment "i=i+1"
|
||||
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
|
||||
str <- getNormalString val
|
||||
match <- matchRegex regex str
|
||||
|
@ -2518,7 +2518,7 @@ checkCharRangeGlob p t@(T_Glob id str) |
|
|||
where
|
||||
isCharClass str = "[" `isPrefixOf` str && "]" `isSuffixOf` 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 =
|
||||
case s of
|
||||
'!':rest -> rest
|
||||
|
@ -2881,7 +2881,7 @@ checkTestArgumentSplitting params t =
|
|||
then
|
||||
-- Ksh appears to stop processing after unrecognized tokens, so operators
|
||||
-- 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 $
|
||||
op ++ " only applies to the first expansion of this glob. Use a loop to check any/all."
|
||||
else
|
||||
|
@ -3408,7 +3408,7 @@ checkPipeToNowhere params t =
|
|||
|
||||
sequence_ $ do
|
||||
T_Redirecting _ redirs cmd <- return stage
|
||||
fds <- sequence $ map getRedirectionFds redirs
|
||||
fds <- mapM getRedirectionFds redirs
|
||||
|
||||
let fdAndToken :: [(Integer, Token)]
|
||||
fdAndToken =
|
||||
|
@ -3441,7 +3441,7 @@ checkPipeToNowhere params t =
|
|||
|
||||
commandSpecificException name cmd =
|
||||
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
|
||||
|
||||
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
|
||||
units = groupByLink followsOnLine commands
|
||||
in
|
||||
execWriter $ sequence_ $ map checkUnit units
|
||||
execWriter $ mapM_ checkUnit units
|
||||
where
|
||||
lineSpan t =
|
||||
let m = tokenPositions params in do
|
||||
|
@ -3895,13 +3895,13 @@ groupByLink :: (a -> a -> Bool) -> [a] -> [[a]]
|
|||
groupByLink f list =
|
||||
case list of
|
||||
[] -> []
|
||||
(x:xs) -> g x [] xs
|
||||
(x:xs) -> foldr c n xs x []
|
||||
where
|
||||
g current span (next:rest) =
|
||||
c next rest current span =
|
||||
if f current next
|
||||
then g next (current:span) rest
|
||||
else (reverse $ current:span) : g next [] rest
|
||||
g current span [] = [reverse (current:span)]
|
||||
then rest next (current:span)
|
||||
else (reverse $ current:span) : rest next []
|
||||
n current span = [reverse (current:span)]
|
||||
|
||||
|
||||
prop_checkBlatantRecursion1 = verify checkBlatantRecursion ":(){ :|:& };:"
|
||||
|
|
|
@ -258,9 +258,9 @@ determineShell fallbackShell t = fromMaybe Bash $
|
|||
executableFromShebang :: String -> String
|
||||
executableFromShebang = shellFor
|
||||
where
|
||||
shellFor s | "/env " `isInfixOf` s = fromMaybe "" $ do
|
||||
[flag, shell] <- matchRegex re s
|
||||
return shell
|
||||
shellFor s | "/env " `isInfixOf` s = case matchRegex re s of
|
||||
Just [flag, shell] -> shell
|
||||
_ -> ""
|
||||
shellFor s | ' ' `elem` s = shellFor $ takeWhile (/= ' ') s
|
||||
shellFor s = reverse . takeWhile (/= '/') . reverse $ s
|
||||
re = mkRegex "/env +(-S|--split-string=?)? *([^ ]*)"
|
||||
|
@ -270,7 +270,7 @@ executableFromShebang = shellFor
|
|||
-- This is used to populate parentMap in Parameters
|
||||
getParentTree :: Token -> Map.Map Id Token
|
||||
getParentTree t =
|
||||
snd . snd $ runState (doStackAnalysis pre post t) ([], Map.empty)
|
||||
snd $ execState (doStackAnalysis pre post t) ([], Map.empty)
|
||||
where
|
||||
pre t = modify (first ((:) t))
|
||||
post t = do
|
||||
|
@ -687,12 +687,10 @@ getModifiedVariableCommand base@(T_SimpleCommand id cmdPrefix (T_NormalWord _ (T
|
|||
parseArgs :: Maybe (Token, Token, String, DataType)
|
||||
parseArgs = do
|
||||
args <- getGnuOpts "d:n:O:s:u:C:c:t" rest
|
||||
let names = map snd $ filter (\(x,y) -> null x) args
|
||||
if null names
|
||||
then
|
||||
case [y | ("",(_,y)) <- args] of
|
||||
[] ->
|
||||
return (base, base, "MAPFILE", DataArray SourceExternal)
|
||||
else do
|
||||
(_, first) <- listToMaybe names
|
||||
first:_ -> do
|
||||
name <- getLiteralString first
|
||||
guard $ isVariableName name
|
||||
return (base, first, name, DataArray SourceExternal)
|
||||
|
|
|
@ -122,7 +122,7 @@ checkGetOpts str flags args f =
|
|||
toTokens = map (T_Literal (Id 0)) . words
|
||||
opts = fromMaybe [] $ f (toTokens str)
|
||||
actualFlags = filter (not . null) $ map fst opts
|
||||
actualArgs = map (\(_, (_, x)) -> onlyLiteralString x) $ filter (null . fst) opts
|
||||
actualArgs = [onlyLiteralString x | ("", (_, x)) <- opts]
|
||||
|
||||
-- Short options
|
||||
prop_checkGetOptsS1 = checkGetOpts "-f x" ["f"] [] $ getOpts (True, True) "f:" []
|
||||
|
@ -916,7 +916,7 @@ checkWhileGetoptsCase = CommandCheck (Exactly "getopts") f
|
|||
|
||||
fromGlob t =
|
||||
case t of
|
||||
T_Glob _ ('[':c:']':[]) -> return [c]
|
||||
T_Glob _ ['[', c, ']'] -> return [c]
|
||||
T_Glob _ "*" -> return "*"
|
||||
T_Glob _ "?" -> return "?"
|
||||
_ -> Nothing
|
||||
|
@ -951,7 +951,7 @@ checkCatastrophicRm = CommandCheck (Basename "rm") $ \t ->
|
|||
when (isRecursive t) $
|
||||
mapM_ (mapM_ checkWord . braceExpand) $ arguments t
|
||||
where
|
||||
isRecursive = any (`elem` ["r", "R", "recursive"]) . map snd . getAllFlags
|
||||
isRecursive = any ((`elem` ["r", "R", "recursive"]) . snd) . getAllFlags
|
||||
|
||||
checkWord token =
|
||||
case getLiteralString token of
|
||||
|
|
|
@ -211,8 +211,7 @@ startSpan = IncompleteInterval <$> getPosition
|
|||
|
||||
endSpan (IncompleteInterval start) = do
|
||||
endPos <- getPosition
|
||||
id <- getNextIdBetween start endPos
|
||||
return id
|
||||
getNextIdBetween start endPos
|
||||
|
||||
getSpanPositionsFor m = do
|
||||
start <- getPosition
|
||||
|
@ -394,7 +393,7 @@ unexpecting s p = try $
|
|||
|
||||
notFollowedBy2 = unexpecting ""
|
||||
|
||||
isFollowedBy p = (lookAhead . try $ p *> return True) <|> return False
|
||||
isFollowedBy p = (lookAhead . try $ p $> True) <|> return False
|
||||
|
||||
reluctantlyTill p end =
|
||||
(lookAhead (void (try end) <|> eof) >> return []) <|> do
|
||||
|
@ -2095,10 +2094,6 @@ readSimpleCommand = called "simple command" $ do
|
|||
then action
|
||||
else getParser def cmd rest
|
||||
|
||||
cStyleComment cmd =
|
||||
case cmd of
|
||||
_ -> False
|
||||
|
||||
validateCommand cmd =
|
||||
case cmd of
|
||||
(T_NormalWord _ [T_Literal _ "//"]) -> commentWarning (getId cmd)
|
||||
|
@ -2721,7 +2716,7 @@ readConditionCommand = do
|
|||
|
||||
pos <- getPosition
|
||||
hasDashAo <- isFollowedBy $ do
|
||||
c <- choice $ map (\s -> try $ string s) ["-o", "-a", "or", "and"]
|
||||
c <- choice $ try . string <$> ["-o", "-a", "or", "and"]
|
||||
posEnd <- getPosition
|
||||
parseProblemAtWithEnd pos posEnd ErrorC 1139 $
|
||||
"Use " ++ alt c ++ " instead of '" ++ c ++ "' between test commands."
|
||||
|
|
Loading…
Reference in New Issue