diff --git a/ShellCheck.cabal b/ShellCheck.cabal index 74c4d2c..e0f0615 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -43,6 +43,9 @@ source-repository head library hs-source-dirs: src + if impl(ghc < 8.0) + build-depends: + semigroups build-depends: -- GHC 7.6.3 (base 4.6.0.1) is buggy (#1131, #1119) in optimized mode. -- Just disable that version entirely to fail fast. @@ -78,6 +81,9 @@ library Paths_ShellCheck executable shellcheck + if impl(ghc < 8.0) + build-depends: + semigroups build-depends: base >= 4 && < 5, ShellCheck, diff --git a/shellcheck.hs b/shellcheck.hs index 542bd32..f56dbcc 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -17,35 +17,36 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . -} -import ShellCheck.Data -import ShellCheck.Checker -import ShellCheck.Interface -import ShellCheck.Regex +import ShellCheck.Checker +import ShellCheck.Data +import ShellCheck.Interface +import ShellCheck.Regex -import ShellCheck.Formatter.Format import qualified ShellCheck.Formatter.CheckStyle +import ShellCheck.Formatter.Format import qualified ShellCheck.Formatter.GCC import qualified ShellCheck.Formatter.JSON import qualified ShellCheck.Formatter.TTY -import Control.Exception -import Control.Monad -import Control.Monad.Except -import Data.Bits -import Data.Char -import Data.Either -import Data.Functor -import Data.IORef -import Data.List -import qualified Data.Map as Map -import Data.Maybe -import Data.Monoid -import Prelude hiding (catch) -import System.Console.GetOpt -import System.Directory -import System.Environment -import System.Exit -import System.IO +import Control.Exception +import Control.Monad +import Control.Monad.Except +import Data.Bits +import Data.Char +import Data.Either +import Data.Functor +import Data.IORef +import Data.List +import qualified Data.Map as Map +import Data.Maybe +import Data.Monoid +import Data.Semigroup (Semigroup (..)) +import Prelude hiding (catch) +import System.Console.GetOpt +import System.Directory +import System.Environment +import System.Exit +import System.IO data Flag = Flag String String data Status = @@ -56,13 +57,16 @@ data Status = | RuntimeException deriving (Ord, Eq, Show) +instance Semigroup Status where + (<>) = max + instance Monoid Status where mempty = NoProblems - mappend = max + mappend = (Data.Semigroup.<>) data Options = Options { - checkSpec :: CheckSpec, - externalSources :: Bool, + checkSpec :: CheckSpec, + externalSources :: Bool, formatterOptions :: FormatterOptions } @@ -117,9 +121,9 @@ formatList = intercalate ", " names where names = Map.keys $ formats (formatterOptions defaultOptions) -getOption [] _ = Nothing +getOption [] _ = Nothing getOption (Flag var val:_) name | name == var = return val -getOption (_:rest) flag = getOption rest flag +getOption (_:rest) flag = getOption rest flag getOptions options name = map (\(Flag _ val) -> val) . filter (\(Flag var _) -> var == name) $ options @@ -159,10 +163,10 @@ main = do statusToCode status = case status of - NoProblems -> ExitSuccess - SomeProblems -> ExitFailure 1 - SyntaxFailure -> ExitFailure 3 - SupportFailure -> ExitFailure 4 + NoProblems -> ExitSuccess + SomeProblems -> ExitFailure 1 + SyntaxFailure -> ExitFailure 3 + SupportFailure -> ExitFailure 4 RuntimeException -> ExitFailure 2 process :: [Flag] -> [FilePath] -> ExceptT Status IO Status @@ -203,7 +207,7 @@ runFormatter sys format options files = do process :: FilePath -> IO Status process filename = do - input <- (siReadFile sys) filename + input <- siReadFile sys filename either (reportFailure filename) check input where check contents = do @@ -220,10 +224,10 @@ runFormatter sys format options files = do parseColorOption colorOption = case colorOption of - "auto" -> ColorAuto + "auto" -> ColorAuto "always" -> ColorAlways - "never" -> ColorNever - _ -> error $ "Bad value for --color `" ++ colorOption ++ "'" + "never" -> ColorNever + _ -> error $ "Bad value for --color `" ++ colorOption ++ "'" parseOption flag options = case flag of @@ -292,7 +296,7 @@ ioInterface options files = do get cache inputs file = do map <- readIORef cache case Map.lookup file map of - Just x -> return $ Right x + Just x -> return $ Right x Nothing -> fetch cache inputs file fetch cache inputs file = do @@ -355,7 +359,7 @@ decodeString = decode in case next of Just (n, remainder) -> chr n : decode remainder - Nothing -> c : decode rest + Nothing -> c : decode rest construct x 0 rest = do guard $ x <= 0x10FFFF diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index bc4ad5e..d59cef0 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -17,28 +17,30 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . -} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} module ShellCheck.AnalyzerLib where -import ShellCheck.AST -import ShellCheck.ASTLib -import ShellCheck.Data -import ShellCheck.Interface -import ShellCheck.Parser -import ShellCheck.Regex +import ShellCheck.AST +import ShellCheck.ASTLib +import ShellCheck.Data +import ShellCheck.Interface +import ShellCheck.Parser +import ShellCheck.Regex -import Control.Arrow (first) -import Control.Monad.Identity -import Control.Monad.RWS -import Control.Monad.State -import Control.Monad.Writer -import Data.Char -import Data.List -import Data.Maybe -import qualified Data.Map as Map +import Control.Arrow (first) +import Control.Monad.Identity +import Control.Monad.RWS +import Control.Monad.State +import Control.Monad.Writer +import Data.Char +import Data.List +import qualified Data.Map as Map +import Data.Maybe +import Data.Semigroup -import Test.QuickCheck.All (forAllProperties) -import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess) +import Test.QuickCheck.All (forAllProperties) +import Test.QuickCheck.Test (maxSuccess, quickCheckWithResult, + stdArgs) type Analysis = AnalyzerM () type AnalyzerM a = RWS Parameters [TokenComment] Cache a @@ -47,7 +49,7 @@ nullCheck = const $ return () data Checker = Checker { perScript :: Root -> Analysis, - perToken :: Token -> Analysis + perToken :: Token -> Analysis } runChecker :: Parameters -> Checker -> [TokenComment] @@ -57,28 +59,30 @@ runChecker params checker = notes check = perScript checker `composeAnalyzers` (\(Root x) -> void $ doAnalysis (perToken checker) x) notes = snd $ evalRWS (check $ Root root) params Cache +instance Semigroup Checker where + (<>) x y = Checker { + perScript = perScript x `composeAnalyzers` perScript y, + perToken = perToken x `composeAnalyzers` perToken y + } + instance Monoid Checker where mempty = Checker { perScript = nullCheck, perToken = nullCheck } - mappend x y = Checker { - perScript = perScript x `composeAnalyzers` perScript y, - perToken = perToken x `composeAnalyzers` perToken y - } - + mappend = (Data.Semigroup.<>) composeAnalyzers :: (a -> Analysis) -> (a -> Analysis) -> a -> Analysis composeAnalyzers f g x = f x >> g x data Parameters = Parameters { - hasLastpipe :: Bool, -- Whether this script has the 'lastpipe' option set/default. - hasSetE :: Bool, -- Whether this script has 'set -e' anywhere. - variableFlow :: [StackData], -- A linear (bad) analysis of data flow - parentMap :: Map.Map Id Token, -- A map from Id to parent Token - shellType :: Shell, -- The shell type, such as Bash or Ksh + hasLastpipe :: Bool, -- Whether this script has the 'lastpipe' option set/default. + hasSetE :: Bool, -- Whether this script has 'set -e' anywhere. + variableFlow :: [StackData], -- A linear (bad) analysis of data flow + parentMap :: Map.Map Id Token, -- A map from Id to parent Token + shellType :: Shell, -- The shell type, such as Bash or Ksh shellTypeSpecified :: Bool, -- True if shell type was forced via flags - rootNode :: Token -- The root node of the AST + rootNode :: Token -- The root node of the AST } -- TODO: Cache results of common AST ops here @@ -151,8 +155,8 @@ makeParameters spec = case shellType params of Bash -> containsLastpipe root Dash -> False - Sh -> False - Ksh -> True, + Sh -> False + Ksh -> True, shellTypeSpecified = isJust $ asShellType spec, parentMap = getParentTree root, @@ -205,7 +209,7 @@ determineShell t = fromMaybe Bash $ do forAnnotation t = case t of (ShellOverride s) -> return s - _ -> fail "" + _ -> fail "" getCandidates :: Token -> [Maybe String] getCandidates t@T_Script {} = [Just $ fromShebang t] getCandidates (T_Annotation _ annotations s) = @@ -233,7 +237,7 @@ getParentTree t = pre t = modify (first ((:) t)) post t = do (_:rest, map) <- get - case rest of [] -> put (rest, map) + case rest of [] -> put (rest, map) (x:_) -> put (rest, Map.insert (getId t) x map) -- Given a root node, make a map from Id to Token @@ -264,27 +268,27 @@ isQuoteFreeNode strict tree t = case t of T_Assignment {} -> return True T_FdRedirect {} -> return True - _ -> Nothing + _ -> Nothing -- Are any subnodes inherently self-quoting? isQuoteFreeContext t = case t of - TC_Nullary _ DoubleBracket _ -> return True - TC_Unary _ DoubleBracket _ _ -> return True + TC_Nullary _ DoubleBracket _ -> return True + TC_Unary _ DoubleBracket _ _ -> return True TC_Binary _ DoubleBracket _ _ _ -> return True - TA_Sequence {} -> return True - T_Arithmetic {} -> return True - T_Assignment {} -> return True - T_Redirecting {} -> return False - T_DoubleQuoted _ _ -> return True - T_DollarDoubleQuoted _ _ -> return True - T_CaseExpression {} -> return True - T_HereDoc {} -> return True - T_DollarBraced {} -> return True + TA_Sequence {} -> return True + T_Arithmetic {} -> return True + T_Assignment {} -> return True + T_Redirecting {} -> return False + T_DoubleQuoted _ _ -> return True + T_DollarDoubleQuoted _ _ -> return True + T_CaseExpression {} -> return True + T_HereDoc {} -> return True + T_DollarBraced {} -> return True -- When non-strict, pragmatically assume it's desirable to split here - T_ForIn {} -> return (not strict) - T_SelectIn {} -> return (not strict) - _ -> Nothing + T_ForIn {} -> return (not strict) + T_SelectIn {} -> return (not strict) + _ -> Nothing -- Check if a token is a parameter to a certain command by name: -- Example: isParamTo (parentMap params) "sed" t @@ -293,16 +297,16 @@ isParamTo tree cmd = go where go x = case Map.lookup (getId x) tree of - Nothing -> False + Nothing -> False Just parent -> check parent check t = case t of T_SingleQuoted _ _ -> go t T_DoubleQuoted _ _ -> go t - T_NormalWord _ _ -> go t + T_NormalWord _ _ -> go t T_SimpleCommand {} -> isCommand t cmd - T_Redirecting {} -> isCommand t cmd - _ -> False + T_Redirecting {} -> isCommand t cmd + _ -> False -- Get the parent command (T_Redirecting) of a Token, if any. getClosestCommand :: Map.Map Id Token -> Token -> Maybe Token @@ -312,8 +316,8 @@ getClosestCommand tree t = findCommand t = case t of T_Redirecting {} -> return True - T_Script {} -> return False - _ -> Nothing + T_Script {} -> return False + _ -> Nothing -- Like above, if koala_man knew Haskell when starting this project. getClosestCommandM t = do @@ -334,7 +338,7 @@ usedAsCommandName tree token = go (getId token) (tail $ getPath tree token) -- A list of the element and all its parents up to the root node. getPath tree t = t : case Map.lookup (getId t) tree of - Nothing -> [] + Nothing -> [] Just parent -> getPath tree parent -- Version of the above taking the map from the current context @@ -360,9 +364,9 @@ findFirst p l = [] -> Nothing (x:xs) -> case p x of - Just True -> return x + Just True -> return x Just False -> Nothing - Nothing -> findFirst p xs + Nothing -> findFirst p xs -- Check whether a word is entirely output from a single command tokenIsJustCommandOutput t = case t of @@ -373,7 +377,7 @@ tokenIsJustCommandOutput t = case t of _ -> False where check [x] = not $ isOnlyRedirection x - check _ = False + check _ = False -- TODO: Replace this with a proper Control Flow Graph getVariableFlow params t = @@ -393,9 +397,9 @@ getVariableFlow params t = unless (assignFirst t) $ setWritten t when (scopeType /= NoneScope) $ modify (StackScopeEnd:) - assignFirst T_ForIn {} = True + assignFirst T_ForIn {} = True assignFirst T_SelectIn {} = True - assignFirst _ = False + assignFirst _ = False setRead t = let read = getReferencedVariables (parentMap params) t @@ -423,7 +427,7 @@ leadType params t = parent <- Map.lookup (getId t) (parentMap params) case parent of T_Pipeline {} -> return parent - _ -> Nothing + _ -> Nothing causesSubshell = do (T_Pipeline _ _ list) <- parentPipeline @@ -459,10 +463,10 @@ getModifiedVariables t = flip getLiteralStringExt token $ \x -> case x of T_Glob _ s -> return s -- Unquoted index - _ -> Nothing + _ -> Nothing guard . not . null $ str - return (t, token, str, DataString $ SourceChecked) + return (t, token, str, DataString SourceChecked) T_DollarBraced _ l -> maybeToList $ do let string = bracedString t @@ -486,7 +490,7 @@ isClosingFileOp op = case op of T_IoDuplicate _ (T_GREATAND _) "-" -> True T_IoDuplicate _ (T_LESSAND _) "-" -> True - _ -> False + _ -> False -- Consider 'export/declare -x' a reference, since it makes the var available @@ -524,7 +528,7 @@ getModifiedVariableCommand base@(T_SimpleCommand _ _ (T_NormalWord _ (T_Literal "getopts" -> case rest of opts:var:_ -> maybeToList $ getLiteral var - _ -> [] + _ -> [] "let" -> concatMap letParamToLiteral rest @@ -588,9 +592,9 @@ getModifiedVariableCommand base@(T_SimpleCommand _ _ (T_NormalWord _ (T_Literal getSetParams (t:rest) = let s = getLiteralString t in case s of - Just "--" -> return rest + Just "--" -> return rest Just ('-':_) -> getSetParams rest - _ -> return (t:fromMaybe [] (getSetParams rest)) + _ -> return (t:fromMaybe [] (getSetParams rest)) getSetParams [] = Nothing getPrintfVariable list = f $ map (\x -> (x, getLiteralString x)) list @@ -662,7 +666,7 @@ getReferencedVariables parents t = literalizer t = case t of T_Glob _ s -> return s -- Also when parsed as globs - _ -> Nothing + _ -> Nothing getIfReference context token = maybeToList $ do str <- getLiteralStringExt literalizer token @@ -674,7 +678,7 @@ getReferencedVariables parents t = isArithmeticAssignment t = case getPath parents t of this: TA_Assignment _ "=" lhs _ :_ -> lhs == t - _ -> False + _ -> False dataTypeFrom defaultType v = (case v of T_Array {} -> DataArray; _ -> defaultType) $ SourceFrom [v] @@ -687,9 +691,8 @@ isCommand token str = isCommandMatch token (\cmd -> cmd == str || ('/' : str) ` -- Compare a command to a literal. Like above, but checks full path. isUnqualifiedCommand token str = isCommandMatch token (== str) -isCommandMatch token matcher = fromMaybe False $ do - cmd <- getCommandName token - return $ matcher cmd +isCommandMatch token matcher = fromMaybe False $ + fmap matcher (getCommandName token) -- Does this regex look like it was intended as a glob? -- True: *foo* @@ -697,7 +700,7 @@ isCommandMatch token matcher = fromMaybe False $ do isConfusedGlobRegex :: String -> Bool isConfusedGlobRegex ('*':_) = True isConfusedGlobRegex [x,'*'] | x /= '\\' = True -isConfusedGlobRegex _ = False +isConfusedGlobRegex _ = False isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x isVariableChar x = isVariableStartChar x || isDigit x @@ -707,7 +710,7 @@ prop_isVariableName1 = isVariableName "_fo123" prop_isVariableName2 = not $ isVariableName "4" prop_isVariableName3 = not $ isVariableName "test: " isVariableName (x:r) = isVariableStartChar x && all isVariableChar r -isVariableName _ = False +isVariableName _ = False getVariablesFromLiteralToken token = getVariablesFromLiteral (fromJust $ getLiteralStringExt (const $ return " ") token) @@ -740,7 +743,7 @@ getBracedReference s = fromMaybe s $ where noPrefix = dropPrefix s dropPrefix (c:rest) = if c `elem` "!#" then rest else c:rest - dropPrefix "" = "" + dropPrefix "" = "" takeName s = do let name = takeWhile isVariableChar s guard . not $ null name @@ -765,12 +768,12 @@ getBracedModifier s = fromMaybe "" . listToMaybe $ do a <- dropModifier s dropPrefix var a where - dropPrefix [] t = return t + dropPrefix [] t = return t dropPrefix (a:b) (c:d) | a == c = dropPrefix b d - dropPrefix _ _ = [] + dropPrefix _ _ = [] dropModifier (c:rest) | c `elem` "#!" = [rest, c:rest] - dropModifier x = [x] + dropModifier x = [x] -- Useful generic functions. @@ -785,12 +788,12 @@ potentially = fromMaybe (return ()) -- Get element 0 or a default. Like `head` but safe. headOrDefault _ (a:_) = a -headOrDefault def _ = def +headOrDefault def _ = def --- Get element n of a list, or Nothing. Like `!!` but safe. (!!!) list i = case drop i list of - [] -> Nothing + [] -> Nothing (r:_) -> Just r -- Run a command if the shell is in the given list @@ -811,7 +814,7 @@ filterByAnnotation asSpec params = any hasNum anns where hasNum (DisableComment ts) = num == ts - hasNum _ = False + hasNum _ = False shouldIgnoreFor _ T_Include {} = not $ asCheckSourced asSpec shouldIgnoreFor _ _ = False parents = parentMap params @@ -821,7 +824,7 @@ filterByAnnotation asSpec params = isCountingReference (T_DollarBraced id token) = case concat $ oversimplify token of '#':_ -> True - _ -> False + _ -> False isCountingReference _ = False -- FIXME: doesn't handle ${a:+$var} vs ${a:+"$var"} @@ -844,8 +847,8 @@ getOpts string cmd = process flags where flags = getAllFlags cmd flagList (c:':':rest) = ([c], True) : flagList rest - flagList (c:rest) = ([c], False) : flagList rest - flagList [] = [] + flagList (c:rest) = ([c], False) : flagList rest + flagList [] = [] flagMap = Map.fromList $ ("", False) : flagList string process [] = return []