Merge pull request #1900 from josephcsible/analyzerlib

Clean up AnalyzerLib

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) ->
+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